hol88-2.02.19940316/0000750000212700021270000000000010517174512011726 5ustar cammcammhol88-2.02.19940316/Makefile0000640000212700021270000012616105533117246013401 0ustar cammcamm#===================================================================== # # MAKEFILE FOR THE HOL SYSTEM # # ===================================================================== # ===================================================================== # INSTRUCTIONS: # # (1) Site dependent macros: # # There are two flags and four site-dependent pathnames used in # this makefile which you may have to change to rebuild hol at # your site. # # They are given by the six macros: # # LispType, Obj, Lisp, Liszt, LisztComm and HOLdir # # To use this makefile at your site, you may have to edit these # macros to reflect local lisp setups and local pathnames. See the # note below under MACROS for a description of these macros. # # (2) To build hol. # # To build hol, just type: "make hol". This will build the hol # system, and create an executable version of hol in the form # of a file called "hol" in this directory. # # Typing "make hol" will recompile any source code that needs # to be recompiled. So if you make changes to any of the system's # source code files, just type "make hol" to recompile and # rebuild the system. Only the code that needs to be recompiled # to reflect the changes will be compiled. # # Note: typing "make hol" will NOT, in general, rebuild any of the # built-in theories. In particular, a theory .th will # be recreated only if: # # a) the corresponding ml source: mk_.ml has # been changed, or # # b) a parent of the theory .th has been changed. # # This means that if the executable code used to create a # theory changes (e.g. hol-lcf), the theory will not be rebuilt. # This is done to avoid unnecessary and time-consuming rebuilding # of the built-in theories. # # To force a theory to be rebuilt, remove the theory file. # Or "touch" the corresponding file: mk_.ml. This is worth # doing, to check if the built-in theories can be rebuilt. # # (3) To completely rebuild hol from scratch. # # To do a total rebuild of the system, including theory files, # type "make clobber" before rebuilding hol. This will remove all # object code and all theory files. It is worth trying this at some # point to make sure that it's possible to do a total rebuild. # ===================================================================== # ===================================================================== # SUMMARY OF MAIN ENTRIES: # # make all : builds hol and all libraries # # make hol : builds hol, compiling sources whenever necessary # # make clean : removes object code from hol system and lisp # # make clobber : removes all object code and theories (incl. libraries) # # make library : rebuilds the library # # make clean-library : removes object code and theories in the library # ===================================================================== # ===================================================================== # MACROS: # # LispType = the type of the lisp system used to build HOL. # Possibilities are cl (for Common Lisp) or franz # (for Franz Lisp). # # Obj = the default filename extension for compiled lisp files. # for Franz Lisp this is o; for Common Lisp this depends on # the implementation. Some implementations and values are: # # Lucid CL lbin # KCL, AKCL o # Allegro CL fasl # # Lisp = the lisp system used to build HOL. This can be # an absolute pathname, a relative pathname, or simply # the name of the appropriate shell command (e.g. "lisp") # provided this can be found by following the builder's # unix search path. # # Liszt = the franz lisp complier used to build HOL. This can be # an absolute pathname, a relative pathname, or simply # the name of the appropriate shell command (e.g. "liszt") # provided this can be found by following the builder's # unix search path. This macro is relevant only for # building a Franz Lisp version of HOL. # # LisztComm = the command issued (internally) by HOL to call the # lisp compiler when compiling ML. This can be just # "liszt", if liszt will be found by following the HOL # user's search path. An absolute pathname can also be # nused for LisztComm. This macro is relevant onlt # for building a Franz Lisp version of HOL. # # Allegro = Option for case-sensitivity in any version of Allegro # common lisp. # # AllegroV4.0 = Allegro 4.0 specials # # AllegroV4.1 = Allegro 4.1 specials # # # AllegroStuff = Combinations of options for any given version of # Allegro common lisp. # # HOLdir = the absolute pathname of the top-level HOL directory # # Theory = the directory where built-in .th files will be put. # # Library = the absolute pathname of the library directory # # Help = the absolute pathnames to the HOL help directories # # Hol = the HOL system to be used for building libraries # (normally hol) # # LispDir = the directory where the Lisp sources are # (used for Library/eval and Library/prog_logic88) # # Version = the version number of HOL. This is incremented by # 0.01 whenever a change is made, and incremented by # 1.0 for a major new release. # ExeName = the executable file name to be built # ===================================================================== # ********************************************************************* # To install HOL, edit the following definitions of: # LispType, Obj, Lisp, Liszt, LisztComm, and HOLdir # ********************************************************************* SHELL=/bin/sh LispType=cl Obj=o Lisp=akcl Liszt= LisztComm= Allegro=(set-case-mode :case-insensitive-upper) AllegroV4.0= $(Allegro) (setq *cltl1-in-package-compatibility-p* t) (setq comp:*cltl1-compile-file-toplevel-compatibility-p* t) AllegroV4.1= $(AllegroV4.0) (setq *enable-package-locked-errors* nil) AllegroStuff= (progn () $(AllegroV4.1)) HOLdir=/usr/local/hol Theory=$(HOLdir)/theories Library=$(HOLdir)/Library Help=$(HOLdir)/help/ENTRIES/ Hol=hol LispDir=${HOLdir}/lisp ExeName = hol Version = 2.02 (SUN4/AKCL) # ===================================================================== # Default (from Phil Windley) # ===================================================================== default: @echo "Type \"make all\" to make hol and the Library, @echo "\"make hol\" to just make hol, or \"make clean\" @echo "to delete object files." # ===================================================================== # Cleaning functions # ===================================================================== clean: /bin/rm -f ml/*_ml.o ml/*_ml.l ml/site.ml lisp/*.$(Obj) /bin/rm -f hol-lcf basic-hol hol $(MAKE) clean-library @echo "=======> all hol and lisp object code deleted" clobber: /bin/rm -f ml/*_ml.o ml/*_ml.l ml/site.ml lisp/*.$(Obj) /bin/rm -f ${Theory}/*.th hol-lcf basic-hol hol $(MAKE) clobber-library @echo "=======> all object code and theory files deleted" clean-library: (cd ${Library}; $(MAKE) Obj=${Obj} clean; cd ..) clobber-library: (cd ${Library}; $(MAKE) Obj=${Obj} clobber; cd ..) # ===================================================================== # MAKEFILE ENTRIES FOR HOL # ===================================================================== # --------------------------------------------------------------------- # Macros: # # HolMl = the ml object code that hol depends on # --------------------------------------------------------------------- HolMl=ml/load_thms.ml ml/numconv_ml.o ml/tydefs_ml.o ml/ind_ml.o\ ml/prim_rec_ml.o ml/tyfns_ml.o ml/num_ml.o ml/list_ml.o\ ml/lib_loader_ml.o # --------------------------------------------------------------------- # main entry for hol # --------------------------------------------------------------------- hol: basic-hol ${Theory}/HOL.th $(HolMl) lisp/banner.$(Obj) lisp/akcl.l echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `HOL`;;'\ 'loadf `ml/load_thms`;;'\ 'loadf `ml/lib_loader`;;'\ 'loadf `ml/numconv`;;'\ 'loadf `ml/tydefs`;;'\ 'loadf `ml/ind`;;'\ 'loadf `ml/prim_rec`;;'\ 'loadf `ml/tyfns`;;'\ 'loadf `ml/num`;;'\ 'loadf `ml/list`;;'\ 'map delete_cache [`arithmetic`;`sum`;`list`];;'\ 'map delete_cache [`tree`;`ltree`;`prim_rec`];;'\ 'lisp `(load "lisp/banner")`;;'\ 'lisp `(setq %system-name "HOL")`;;'\ 'lisp `(setq %hol-dir "$(HOLdir)")`;;'\ 'lisp `(setq %lib-dir "$(Library)")`;;'\ 'lisp `(setq %liszt "$(LisztComm)")`;;'\ 'lisp `(setq %version "$(Version)")`;;'\ 'set_flag(`abort_when_fail`,false);;'\ 'set_search_path[``; `~/`; `${Theory}/`];;'\ 'set_help_search_path (words `$(Help)`);;'\ 'set_library_search_path [`${Library}/`];;'\ 'lisp `(load "lisp/akcl.l")`;;'\ 'lisp `(setup)`;;'\ 'save `${ExeName}`;;'\ 'set_thm_count 0;;'\ 'quit();;'\ | basic-hol make permissions @echo "=======> hol88 version $(Version) made" library: $(ExeName) date (cd ${Library}; $(MAKE) LispType=${LispType}\ Obj=${Obj}\ Lisp=${Lisp}\ Liszt=${Liszt}\ LispDir=${LispDir}\ Hol=${HOLdir}/${ExeName} library; cd ..) date all: (date; $(MAKE) hol; date; $(MAKE) library; date) make permissions @echo "=======> hol Version $(Version) and libraries made" # --------------------------------------------------------------------- # Entry for changing permissions. # # Macros: # # directories: Dperm = drwxrwxr-x = 775 # text files: Tperm = -rw-rw-r-- = 664 # executable files: Eperm = -rwxrwxr-x = 775 # # Exec = those files to be "executable" # # --------------------------------------------------------------------- Dperm=775 Tperm=664 Eperm=775 Exec=hol hol-lcf basic-hol Manual/LaTeX/makeindex\ Manual/LaTeX/makeindex.bin/*/makeindex\ Manual/Reference/bin/mktex Manual/Reference/bin/typecheck permissions: find . \( -type d -user $(USER) -exec chmod $(Dperm) {} \; \) -o\ \( -type f -user $(USER) -exec chmod $(Tperm) {} \; \) @for f in $(Exec) ; do\ ( if [ -f $$f ]; then\ find $$f \( -user $(USER) \) -exec chmod $(Eperm) {} \; ;fi) ; \ done # --------------------------------------------------------------------- # makefile entries for hol system ml code # --------------------------------------------------------------------- ml/numconv_ml.o: basic-hol ${Theory}/num.th ml/numconv.ml echo 'load_theory `num`;;'\ 'compilet `ml/numconv`;;'\ 'quit();;'\ | basic-hol ml/lib_loader_ml.o: basic-hol ml/lib_loader.ml echo 'compilet `ml/lib_loader`;;'\ 'quit();;'\ | basic-hol ml/tydefs_ml.o: basic-hol ${Theory}/HOL.th ml/load_thms.ml ml/tydefs.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `HOL`;;'\ 'compilet `ml/tydefs`;;'\ 'quit();;'\ | basic-hol ml/ind_ml.o: basic-hol ml/ind.ml echo 'compilet `ml/ind`;;'\ 'quit();;'\ | basic-hol ml/prim_rec_ml.o: basic-hol ml/prim_rec.ml echo 'compilet `ml/prim_rec`;;'\ 'quit();;'\ | basic-hol ml/tyfns_ml.o: basic-hol ${Theory}/HOL.th ml/prim_rec_ml.o ml/load_thms.ml ml/tyfns.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `HOL`;;'\ 'compilet `ml/tyfns`;;'\ 'quit();;'\ | basic-hol ml/num_ml.o: basic-hol ${Theory}/HOL.th ml/ind_ml.o ml/prim_rec_ml.o\ ml/num.ml ml/numconv_ml.o echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `HOL`;;'\ 'compilet `ml/num`;;'\ 'quit();;'\ | basic-hol ml/list_ml.o: basic-hol ${Theory}/HOL.th ml/ind_ml.o ml/prim_rec_ml.o\ ml/numconv_ml.o ml/list.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `HOL`;;'\ 'compilet `ml/list`;;'\ 'quit();;'\ | basic-hol # --------------------------------------------------------------------- # HOL built-in theories # # Note: the theory files really depend on the code used to make them. # E.g. basic-hol, and various ml code. But these dependencies are not # reflected in the entries below. And only uncompiled ML is used. # --------------------------------------------------------------------- ${Theory}/one.th: theories/mk_one.ml cd ${Theory}; rm -f one.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_one.ml;\ cd ${HOLdir} @echo "=======> theory one built" ${Theory}/combin.th: theories/mk_combin.ml cd ${Theory}; rm -f combin.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_combin.ml;\ cd ${HOLdir} @echo "=======> theory combin built" ${Theory}/fun.th: theories/mk_fun.ml cd ${Theory}; rm -f fun.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_fun.ml;\ cd ${HOLdir} @echo "=======> theory fun built" ${Theory}/sum.th: theories/mk_sum.ml ${Theory}/combin.th cd ${Theory}; rm -f sum.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_sum.ml;\ cd ${HOLdir} @echo "=======> theory sum built" ${Theory}/num.th: theories/mk_num.ml cd ${Theory}; rm -f num.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_num.ml;\ cd ${HOLdir} @echo "=======> theory num built" ${Theory}/prim_rec.th: theories/mk_prim_rec.ml ${Theory}/num.th cd ${Theory}; rm -f prim_rec.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_prim_rec.ml;\ cd ${HOLdir} @echo "=======> theory prim_rec built" ${Theory}/arithmetic.th: ${Theory}/mk_arith.ml ${Theory}/mk_arith_thms.ml\ ${Theory}/prim_rec.th ${Theory}/fun.th cd ${Theory}; rm -f arithmetic.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_arith.ml;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_arith_thms.ml;\ cd ${HOLdir} @echo "=======> theory arithmetic built" ${Theory}/list.th: ${Theory}/mk_list.ml ${Theory}/mk_list_defs.ml \ ${Theory}/mk_list_thms.ml ${Theory}/mk_list_thm2.ml\ ${Theory}/combin.th ${Theory}/arithmetic.th cd ${Theory}; rm -f list.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_list.ml;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_list_defs.ml;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_list_thms.ml;\ cd ${HOLdir} @echo "=======> theory list built" ${Theory}/tree.th: theories/mk_tree.ml ${Theory}/list.th cd ${Theory}; rm -f tree.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_tree.ml;\ cd ${HOLdir} @echo "=======> theory tree built" ${Theory}/ltree.th: theories/mk_ltree.ml ${Theory}/tree.th ${Theory}/combin.th cd ${Theory}; rm -f ltree.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_ltree.ml;\ cd ${HOLdir} @echo "=======> theory ltree built" ${Theory}/tydefs.th: theories/mk_tydefs.ml ${Theory}/ltree.th cd ${Theory}; rm -f tydefs.th;\ ${HOLdir}/basic-hol < ${HOLdir}/theories/mk_tydefs.ml;\ cd ${HOLdir} @echo "=======> theory tydefs built" ${Theory}/HOL.th: ${Theory}/tydefs.th ${Theory}/sum.th ${Theory}/one.th cd ${Theory}; rm -f HOL.th;\ echo 'new_theory `HOL`;;'\ 'map new_parent [`one`;`sum`;`tydefs`];;'\ 'close_theory();;'\ 'quit();;'\ | ${HOLdir}/basic-hol;\ cd ${HOLdir} @echo "=======> theory HOL built" # ===================================================================== # MAKEFILE ENTRIES FOR BASIC-HOL # ===================================================================== # --------------------------------------------------------------------- # Macros: # # BasicHolLisp = all the lisp object code that hol-lcf depends on # # BasicHolMl = the ml object (and source) code that hol-lcf depends on # --------------------------------------------------------------------- # parse_as_binder removed from this list [TFM 92.10.01] BasicHolLisp=lisp/genfns.$(Obj) lisp/gnt.$(Obj)\ lisp/hol-pars.$(Obj) lisp/parslist.$(Obj)\ lisp/parslet.$(Obj) lisp/constp.$(Obj)\ lisp/hol-writ.$(Obj) lisp/mk_pp_thm.$(Obj) BasicHolMl=ml/genfns_ml.o ml/hol-syn_ml.o ml/hol-rule_ml.o\ ml/hol-drule_ml.o ml/drul_ml.o ml/hol-thyfn_ml.o\ ml/tacticals_ml.o ml/tacont_ml.o ml/tactics_ml.o\ ml/conv_ml.o ml/hol-net_ml.o ml/rewrite_ml.o\ ml/resolve_ml.o ml/goals_ml.o ml/stack_ml.o\ ml/abs-rep_ml.o # --------------------------------------------------------------------- # main entry for basic-hol # # NOTE: the order of dependencies here is important. BasicHolLisp must # be compiled before rebuilding BASIC-HOL.th. This is because the # basic-hol theories are not stated in the Makefile made to depend on # code. See the note below about the basic-hol theories. # --------------------------------------------------------------------- basic-hol: hol-lcf $(BasicHolLisp) ${Theory}/BASIC-HOL.th $(BasicHolMl) echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `BASIC-HOL`;;'\ 'loadf `ml/hol-in-out`;;'\ 'loadf `ml/hol-rule`;;'\ 'loadf `ml/hol-drule`;;'\ 'loadf `ml/drul`;;'\ 'loadf `ml/tacticals`;;'\ 'loadf `ml/tacont`;;'\ 'loadf `ml/tactics`;;'\ 'loadf `ml/conv`;;'\ 'loadf `ml/hol-net`;;'\ 'loadf `ml/rewrite`;;'\ 'loadf `ml/resolve`;;'\ 'loadf `ml/hol-thyfn`;;'\ 'loadf `ml/goals`;;'\ 'loadf `ml/stack`;;'\ 'loadf `ml/abs-rep`;;'\ 'activate_binders `bool`;;'\ 'lisp `(setq %liszt "$(LisztComm)")`;;'\ 'lisp `(setq %version "$(Version)")`;;'\ 'lisp `(setq %system-name "BASIC-HOL")`;;'\ 'lisp `(setup)`;;'\ 'save `basic-hol`;;'\ 'quit();;'\ | hol-lcf @echo "=======> basic-hol88 made" # --------------------------------------------------------------------- # makefile entries for compiling the ML code of basic-hol. # --------------------------------------------------------------------- ml/hol-in-out_ml.o: hol-lcf echo 'compilet `ml/hol-in-out`;;'\ 'quit();;'\ | hol-lcf ml/genfns_ml.o: hol-lcf ml/genfns.ml echo 'compilet `ml/genfns`;;'\ 'quit();;'\ | hol-lcf ml/hol-syn_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'lisp `(load "lisp/genfns")`;;'\ 'lisp `(load "lisp/gnt")`;;'\ 'lisp `(load "lisp/hol-pars")`;;'\ 'lisp `(load "lisp/parslist")`;;'\ 'lisp `(load "lisp/parslet")`;;'\ 'lisp `(load "lisp/constp")`;;'\ 'lisp `(load "lisp/hol-writ")`;;'\ 'lisp `(load "lisp/mk_pp_thm")`;;'\ 'compilet `ml/hol-syn`;;'\ 'quit();;'\ | hol-lcf ml/hol-rule_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/hol-rule`;;'\ 'quit();;'\ | hol-lcf ml/hol-drule_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/hol-drule`;;'\ 'quit();;'\ | hol-lcf ml/drul_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/drul`;;'\ 'quit();;'\ | hol-lcf ml/hol-thyfn_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-thyfn.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/hol-thyfn`;;'\ 'quit();;'\ | hol-lcf ml/tacticals_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul_ml.o ml/tacticals.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/tacticals`;;'\ 'quit();;'\ | hol-lcf ml/tacont_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul_ml.o ml/tacticals_ml.o ml/tacont.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/tacont`;;'\ 'quit();;'\ | hol-lcf ml/tactics_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul_ml.o ml/tacticals_ml.o ml/tacont_ml.o\ ml/tactics.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/tactics`;;'\ 'quit();;'\ | hol-lcf ml/conv_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul_ml.o ml/tacticals_ml.o ml/conv.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/conv`;;'\ 'quit();;'\ | hol-lcf ml/hol-net_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-net.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/hol-net`;;'\ 'quit();;'\ | hol-lcf ml/rewrite_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul_ml.o ml/tacticals_ml.o ml/conv_ml.o\ ml/hol-net_ml.o ml/rewrite.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/rewrite`;;'\ 'quit();;'\ | hol-lcf ml/resolve_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-rule_ml.o ml/hol-drule_ml.o\ ml/drul_ml.o ml/tacticals_ml.o ml/tacont_ml.o\ ml/tactics_ml.o ml/conv_ml.o ml/resolve.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/resolve`;;'\ 'quit();;'\ | hol-lcf ml/goals_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-thyfn_ml.o ml/hol-rule_ml.o\ ml/hol-drule_ml.o ml/drul_ml.o ml/tacticals_ml.o ml/goals.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/goals`;;'\ 'quit();;'\ | hol-lcf ml/stack_ml.o: hol-lcf ${Theory}/bool.th $(BasicHolLisp) ml/genfns_ml.o\ ml/hol-syn_ml.o ml/hol-thyfn_ml.o ml/hol-rule_ml.o\ ml/hol-drule_ml.o ml/drul_ml.o ml/tacticals_ml.o\ ml/goals_ml.o ml/stack.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `bool`;;'\ 'compilet `ml/stack`;;'\ 'quit();;'\ | hol-lcf ml/abs-rep_ml.o: hol-lcf ${Theory}/BASIC-HOL.th $(BasicHolLisp)\ ml/genfns_ml.o ml/hol-syn_ml.o ml/hol-rule_ml.o\ ml/hol-drule_ml.o ml/drul_ml.o ml/abs-rep.ml echo 'set_search_path[``; `${Theory}/`];;'\ 'load_theory `BASIC-HOL`;;'\ 'compilet `ml/abs-rep`;;'\ 'quit();;'\ | hol-lcf # --------------------------------------------------------------------- # Makefile entries for the built-in theories of basic-hol. # # NOTE: Strictly speaking, these theories depend on the code that is # used to create them. Thus, for example, they all depend on hol-lcf. # In addition, they depend on BasicHolLisp and (sometimes) BasicHolMl. # But these dependencies are not reflected in the entries below. # This means the theories will not get rebuilt if only hol-lcf # changes, or some BasicHolLisp or BasicHolMl code changes. # But the theories will be recreated if they are missing, or the # files that create the theories are changed, or the parent # theories are changed. Note that BasicHolLisp must be compiled # before these theories are made. # # The entries below ensure that if a BasicHolMl file is used to create # a theory, the SOURCE is loaded rather than the OBJECT. This guards # against the case where one (but not all) object files are missing. # --------------------------------------------------------------------- ${Theory}/PPLAMB.th: theories/mk_PPLAMB.ml cd ${Theory}; rm -f PPLAMB.th;\ ${HOLdir}/hol-lcf < ${HOLdir}/theories/mk_PPLAMB.ml;\ cd ${HOLdir} @echo "=======> theory PPLAMB built" ${Theory}/bool.th: theories/mk_bool.ml ${Theory}/PPLAMB.th -@if [ -f ml/genfns_ml.o ]; then\ mv -f ml/genfns_ml.o ml/genfns_ml.o.save;fi -@if [ -f ml/hol-syn_ml.o ]; then\ mv -f ml/hol-syn_ml.o ml/hol-syn_ml.o.save;fi cd ${Theory}; rm -f bool.th;\ ${HOLdir}/hol-lcf < ${HOLdir}/theories/mk_bool.ml;\ cd ${HOLdir} -@if [ -f ml/genfns_ml.o.save ]; then\ mv -f ml/genfns_ml.o.save ml/genfns_ml.o;fi -@if [ -f ml/hol-syn_ml.o.save ]; then\ mv -f ml/hol-syn_ml.o.save ml/hol-syn_ml.o;fi @echo "=======> theory bool built" ${Theory}/ind.th: theories/mk_ind.ml ${Theory}/bool.th -@if [ -f ml/genfns_ml.o ]; then\ mv -f ml/genfns_ml.o ml/genfns_ml.o.save;fi -@if [ -f ml/hol-syn_ml.o ]; then\ mv -f ml/hol-syn_ml.o ml/hol-syn_ml.o.save;fi cd ${Theory}; rm -f ind.th;\ ${HOLdir}/hol-lcf < ${HOLdir}/theories/mk_ind.ml;\ cd ${HOLdir} -@if [ -f ml/genfns_ml.o.save ]; then\ mv -f ml/genfns_ml.o.save ml/genfns_ml.o;fi -@if [ -f ml/hol-syn_ml.o.save ]; then\ mv -f ml/hol-syn_ml.o.save ml/hol-syn_ml.o;fi @echo "=======> theory ind built" ${Theory}/BASIC-HOL.th: theories/mk_BASIC-HOL.ml ${Theory}/ind.th -@if [ -f ml/genfns_ml.o ]; then\ mv -f ml/genfns_ml.o ml/genfns_ml.o.save;fi -@if [ -f ml/hol-syn_ml.o ]; then\ mv -f ml/hol-syn_ml.o ml/hol-syn_ml.o.save;fi -@if [ -f ml/hol-rule_ml.o ]; then\ mv -f ml/hol-rule_ml.o ml/hol-rule_ml.o.save;fi -@if [ -f ml/hol-drule_ml.o ]; then\ mv -f ml/hol-drule_ml.o ml/hol-drule_ml.o.save;fi -@if [ -f ml/hol-thyfn_ml.o ]; then\ mv -f ml/hol-thyfn_ml.o ml/hol-thyfn_ml.o.save;fi cd ${Theory}; rm -f BASIC-HOL.th;\ ${HOLdir}/hol-lcf < ${HOLdir}/theories/mk_BASIC-HOL.ml;\ cd ${HOLdir} -@if [ -f ml/genfns_ml.o.save ]; then\ mv -f ml/genfns_ml.o.save ml/genfns_ml.o;fi -@if [ -f ml/hol-syn_ml.o.save ]; then\ mv -f ml/hol-syn_ml.o.save ml/hol-syn_ml.o;fi -@if [ -f ml/hol-rule_ml.o.save ]; then\ mv -f ml/hol-rule_ml.o.save ml/hol-rule_ml.o;fi -@if [ -f ml/hol-drule_ml.o.save ]; then\ mv -f ml/hol-drule_ml.o.save ml/hol-drule_ml.o;fi -@if [ -f ml/hol-thyfn_ml.o.save ]; then\ mv -f ml/hol-thyfn_ml.o.save ml/hol-thyfn_ml.o;fi @echo "=======> theory BASIC-HOL built" # ===================================================================== # MAKEFILE ENTRIES FOR HOL-LCF # ===================================================================== # --------------------------------------------------------------------- # Macros: # # HolLcfLisp = all the lisp object code that hol-lcf depends on # # HolLcfMl = the ml object (and source) code that hol-lcf depends on # --------------------------------------------------------------------- HolLcfLisp=lisp/f-$(LispType).$(Obj) lisp/f-system.$(Obj)\ lisp/mk-ml.$(Obj) lisp/mk-hol-lcf.$(Obj)\ lisp/f-site.$(Obj) lisp/f-gp.$(Obj)\ lisp/f-parser.$(Obj) lisp/f-parsml.$(Obj)\ lisp/f-mlprin.$(Obj) lisp/f-typeml.$(Obj)\ lisp/f-dml.$(Obj) lisp/f-format.$(Obj)\ lisp/f-tran.$(Obj) lisp/f-iox-stand.$(Obj)\ lisp/f-writml.$(Obj) lisp/f-tml.$(Obj)\ lisp/f-lis.$(Obj)\ lisp/f-ol-rec.$(Obj) lisp/f-parsol.$(Obj)\ lisp/f-typeol.$(Obj) lisp/f-help.$(Obj)\ lisp/f-writol.$(Obj) lisp/f-thyfns.$(Obj)\ lisp/f-freadth.$(Obj) \ lisp/f-ol-syntax.$(Obj) lisp/f-subst.$(Obj)\ lisp/f-inst.$(Obj) lisp/f-simpl.$(Obj) lisp/f-ol-net.$(Obj) HolLcfMl=ml/ml-curry_ml.o ml/lis_ml.o ml/gen_ml.o ml/site_ml.o ml/killpp.ml # --------------------------------------------------------------------- # main entry for hol-lcf # --------------------------------------------------------------------- hol-lcf: $(HolLcfLisp) $(HolLcfMl) echo '#+allegro $(AllegroStuff)'\ '(load "lisp/mk-ml")'\ '(load "lisp/mk-hol-lcf")'\ '(setq %version "$(Version)")'\ '(set-make)'\ '(tml)'\ 'load(`ml/site`,false);;'\ 'load(`ml/ml-curry`,false);;'\ 'load(`ml/lis`,false);;'\ 'load(`ml/gen`,false);;'\ 'load(`ml/killpp`,false);;'\ 'lisp `(setq %system-name "HOL-LCF")`;;'\ 'lisp `(setq %liszt "$(LisztComm)")`;;'\ 'lisp `(setup)`;;'\ 'save `hol-lcf`;;'\ 'quit();;'\ | $(Lisp) @echo "=======> hol-lcf made" # ===================================================================== # Makefile entries for compiled ml code that is part of hol-lcf # # These depend on the hol-lcf lisp object codes. # ===================================================================== ml/ml-curry_ml.o: ml/ml-curry.ml $(HolLcfLisp) echo '#+allegro $(AllegroStuff)'\ '(load "lisp/mk-ml")'\ '(load "lisp/mk-hol-lcf")'\ '(setq %system-name "HOL-LCF")'\ '(setq %liszt "$(LisztComm)")'\ '(setq %version "$(Version)")'\ '(set-make)'\ '(tml)'\ 'compile(`ml/ml-curry`,true);;'\ 'quit();;'\ | $(Lisp) ml/lis_ml.o: ml/lis.ml ml/ml-curry_ml.o $(HolLcfLisp) echo '#+allegro $(AllegroStuff)'\ '(load "lisp/mk-ml")'\ '(load "lisp/mk-hol-lcf")'\ '(setq %system-name "HOL-LCF")'\ '(setq %liszt "$(LisztComm)")'\ '(setq %version "$(Version)")'\ '(set-make)'\ '(tml)'\ 'load(`ml/ml-curry`,false);;'\ 'compile(`ml/lis`,true);;'\ 'quit();;'\ | $(Lisp) ml/gen_ml.o: ml/gen.ml ml/ml-curry_ml.o ml/lis_ml.o $(HolLcfLisp) echo '#+allegro $(AllegroStuff)'\ '(load "lisp/mk-ml")'\ '(load "lisp/mk-hol-lcf")'\ '(setq %system-name "HOL-LCF")'\ '(setq %liszt "$(LisztComm)")'\ '(setq %version "$(Version)")'\ '(set-make)'\ '(tml)'\ 'load(`ml/ml-curry`,false);;'\ 'load(`ml/lis`,false);;'\ 'compile(`ml/gen`,true);;'\ 'quit();;'\ | $(Lisp) ml/site_ml.o: ml/site.ml $(HolLcfLisp) echo '#+allegro $(AllegroStuff)'\ '(load "lisp/mk-ml")'\ '(load "lisp/mk-hol-lcf")'\ '(setq %system-name "HOL-LCF")'\ '(setq %liszt "$(LisztComm)")'\ '(setq %version "$(Version)")'\ '(set-make)'\ '(tml)'\ 'compile(`ml/site`,true);;'\ 'quit();;'\ | $(Lisp) # note that this is new. ml/site.ml.orig *must* exist # sed substitution for theories_dir_pathname removed [TFM 91.02.24] ml/site.ml: ml/site.ml.orig sed -e "s;ml/;${HOLdir}/ml/;g" \ -e "s;lisp/;${HOLdir}/lisp/;g" ml/site.ml.orig > ml/site.ml # ===================================================================== # MAKEFILE ENTRIES FOR ALL THE LISP CODE # ===================================================================== HolLispBasic=lisp/f-$(LispType).$(Obj) lisp/f-$(LispType).$(Obj): lisp/f-$(LispType).l if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(compile-file "lisp/f-cl.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-franz; fi lisp/f-constants.$(Obj): lisp/f-constants.l $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-constants.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-constants; fi lisp/f-dml.$(Obj): lisp/f-dml.l lisp/f-macro.$(Obj) lisp/f-constants.$(Obj)\ $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-dml.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-dml; fi lisp/f-format.$(Obj): lisp/f-format.l lisp/f-macro.$(Obj)\ lisp/f-constants.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-format.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-format; fi lisp/f-gp.$(Obj): lisp/f-gp.l lisp/f-constants.$(Obj) lisp/f-macro.$(Obj)\ $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-gp.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-gp; fi lisp/f-help.$(Obj): lisp/f-help.l lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-help.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-help; fi lisp/f-inst.$(Obj): lisp/f-inst.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-inst.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-inst; fi lisp/f-iox-stand.$(Obj): lisp/f-iox-stand.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-iox-stand.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-iox-stand; fi lisp/f-lis.$(Obj): lisp/f-lis.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-lis.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-lis; fi lisp/f-macro.$(Obj): lisp/f-macro.l $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-macro.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-macro; fi lisp/f-mlprin.$(Obj): lisp/f-mlprin.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-mlprin.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-mlprin; fi # --------------------------------------------------------------------- #lisp/f-obj.$(Obj): lisp/f-obj.l lisp/f-macro.$(Obj) $(HolLispBasic) # if [ $(LispType) = cl ]; then\ # echo '#+allegro $(AllegroStuff)'\ # '(load "lisp/f-cl") (compile-file "lisp/f-obj.l") (quit)'\ # | $(Lisp); else\ # $(Liszt) lisp/f-obj; fi # --------------------------------------------------------------------- lisp/f-ol-net.$(Obj): lisp/f-ol-net.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-ol-net.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-ol-net; fi lisp/f-ol-rec.$(Obj): lisp/f-ol-rec.l $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-ol-rec.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-ol-rec; fi lisp/f-ol-syntax.$(Obj): lisp/f-ol-syntax.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj)\ $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-ol-syntax.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-ol-syntax; fi lisp/f-parser.$(Obj): lisp/f-parser.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-parser.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-parser; fi lisp/f-parsml.$(Obj): lisp/f-parsml.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-parsml.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-parsml; fi lisp/f-parsol.$(Obj): lisp/f-parsol.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-parsol.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-parsol; fi lisp/f-simpl.$(Obj): lisp/f-simpl.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-simpl.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-simpl; fi lisp/f-site.$(Obj): lisp/f-site.l lisp/f-constants.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-site.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-site; fi lisp/f-subst.$(Obj): lisp/f-subst.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-subst.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-subst; fi lisp/f-thyfns.$(Obj): lisp/f-thyfns.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-thyfns.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-thyfns; fi lisp/f-freadth.$(Obj): lisp/f-freadth.l lisp/f-macro.$(Obj)\ $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-freadth.l") (quit)'\ | $(Lisp); else\ touch lisp/f-freadth.$(Obj); fi lisp/f-tml.$(Obj): lisp/f-tml.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-tml.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-tml; fi lisp/f-tran.$(Obj): lisp/f-tran.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-tran.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-tran; fi lisp/f-typeml.$(Obj): lisp/f-typeml.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-typeml.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-typeml; fi lisp/f-typeol.$(Obj): lisp/f-typeol.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-typeol.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-typeol; fi lisp/f-system.$(Obj): lisp/f-system.l lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-system.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-system; fi lisp/f-writml.$(Obj): lisp/f-writml.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-writml.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-writml; fi lisp/f-writol.$(Obj): lisp/f-writol.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj)\ lisp/genmacs.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/f-writol.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/f-writol; fi lisp/constp.$(Obj): lisp/constp.l $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/constp.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/constp; fi lisp/genfns.$(Obj): lisp/genfns.l lisp/f-macro.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/genfns.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/genfns; fi lisp/genmacs.$(Obj): lisp/genmacs.l lisp/f-macro.$(Obj)\ lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/genmacs.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/genmacs; fi lisp/gnt.$(Obj): lisp/gnt.l lisp/f-constants.$(Obj) lisp/f-macro.$(Obj)\ lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/gnt.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/gnt; fi lisp/hol-pars.$(Obj): lisp/hol-pars.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj)\ lisp/genmacs.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/hol-pars.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/hol-pars; fi lisp/hol-writ.$(Obj): lisp/hol-writ.l lisp/f-constants.$(Obj)\ lisp/f-macro.$(Obj) lisp/f-ol-rec.$(Obj)\ lisp/genmacs.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/hol-writ.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/hol-writ; fi lisp/mk-hol-lcf.$(Obj): lisp/mk-hol-lcf.l $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/mk-hol-lcf.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/mk-hol-lcf; fi lisp/mk-ml.$(Obj): lisp/mk-ml.l lisp/f-macro.$(Obj) lisp/f-help.$(Obj)\ lisp/f-ol-rec.$(Obj) lisp/genmacs.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/mk-ml.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/mk-ml; fi lisp/mk_pp_thm.$(Obj): lisp/mk_pp_thm.l lisp/f-macro.$(Obj)\ lisp/f-ol-rec.$(Obj) lisp/genmacs.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/mk_pp_thm.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/mk_pp_thm; fi # No longer used. [TFM 91.10.01 for HOL88 2.01] # lisp/parse_as_binder.$(Obj): lisp/parse_as_binder.l lisp/f-macro.$(Obj)\ # $(HolLispBasic) # if [ $(LispType) = cl ]; then\ # echo '#+allegro $(AllegroStuff)'\ # '(load "lisp/f-cl") (compile-file "lisp/parse_as_binder.l") (quit)'\ # | $(Lisp); else\ # $(Liszt) lisp/parse_as_binder; fi lisp/parslet.$(Obj): lisp/parslet.l lisp/f-constants.$(Obj) lisp/f-macro.$(Obj)\ lisp/f-ol-rec.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/parslet.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/parslet; fi lisp/parslist.$(Obj): lisp/parslist.l lisp/f-constants.$(Obj) $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/parslist.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/parslist; fi lisp/banner.$(Obj): $(HolLispBasic) if [ $(LispType) = cl ]; then\ echo '#+allegro $(AllegroStuff)'\ '(load "lisp/f-cl") (compile-file "lisp/banner.l") (quit)'\ | $(Lisp); else\ $(Liszt) lisp/banner; fi hol88-2.02.19940316/lisp/0000750000212700021270000000000005533133327012676 5ustar cammcammhol88-2.02.19940316/lisp/f-iox-stand.l0000640000212700021270000003055305353322512015207 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-iox-stand.l ;;; ;;; ;;; ;;; DESCRIPTION: ML I/O and flags ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: din,iox (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V1.4: nextch imported from F-parser, digitp,etc. exported to F-parser ;;; ;;; ;;; ;;; V2.2: part 4 imported from F-tml ;;; ;;; local variables in and lcferror ;;; ;;; ;;; ;;; |%undisch_defs-flag| deleted [TFM 90.12.01] ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (special %flags %search-path |%prompt-flag| |%print_load-flag| %directory %library-search-path |%print_lib-flag|) (*lexpr concat uconcat)) ;;; print on an output file, setting output parameters properly ;;; use channel %outport (defun hol-print-file (x) (let ((*print-level* nil) (*print-length* nil) (*print-escape* t) (*print-pretty* nil) (prinlevel nil) (prinlength nil) (#+franz poport #-franz *standard-output* %outport)) (llprint x) (llterpri))) ; hol-print-file ;;; Part 2: Predicates on tokens (defun idenp (tok) (let ((l (exploden tok))) (and l (letterp (car l)) (forall 'alphanump (cdr l))))) ;idenp (defun nump (tok) (can (function ml-int_of_string) (list tok))) ;nump ;;; Part 3 : terminal input ;;; MJCG 30/11/88 for HOL88 ;;; List of settable flags ;;; |%undisch_defs-flag| deleted [TFM 90.12.01] ;;; |%read_sexpr-flag| added [JVT 90.13.12] ;;; |%print_fasl-flag| added [TFM 91.01.20] (setq %flags '(|%theory_pp-flag| |%prompt-flag| |%show_types-flag| |%type_error-flag| |%timing-flag| |%sticky-flag| |%interface_print-flag| |%abort_when_fail-flag| |%print_top_val-flag| |%print_top_types-flag| |%print_list-flag| |%print_set-flag| |%print_cond-flag| |%print_infix-flag| |%print_load-flag| |%print_quant-flag| |%print_restrict-flag| |%print_let-flag| |%print_uncurry-flag| |%print_lettypes-flag| |%print_lib-flag| |%compile_on_the_fly-flag| |%file_load_msg-flag| |%preterm-flag| |%read_sexpr-flag| |%print_fasl-flag| |%pp_sexpr-flag| |%print_sexpr-flag| |%print_parse_trees-flag|)) (setq |%print_lib-flag| nil) (setq |%print_load-flag| t) ;;; (setq |%undisch_defs-flag| t) deleted [TFM 90.12.01] (setq |%preterm-flag| nil) (setq |%print_fasl-flag| nil) ;;; MJCG 28/11/88 for HOL88 ;;; dml-ed function for setting Lisp flags from ML ;;; special case for print_fasl-flag (defun ml-set_flag (flag val) (let ((pflag (concat '|%| (canonise-case-symbol flag) '|-flag|))) (if (equal pflag '|%print_fasl-flag|) (prog1 (eval pflag) (set-fasl-flag val)) (if (memq pflag %flags) (prog1 (eval pflag) (set pflag val)) (failwith (concat flag " not a settable flag")))))) (dml |set_flag| 2 ml-set_flag ((|string| |#| |bool|) -> |bool|)) ;;; MJCG 13/10/89 for HOL88 ;;; dml-ed function for creating new Lisp flags from ML (defun ml-new_flag (flag val) (let ((pflag (concat '|%| (canonise-case-symbol flag) '|-flag|))) (if(memq pflag %flags) (failwith (concat flag " is already a flag")) (prog () (setq %flags (cons pflag %flags)) (set pflag val) (return nil))))) (dml |new_flag| 2 ml-new_flag ((|string| |#| |bool|) -> |void|)) ;;; MJCG 5/2/89 for HOL88 ;;; dml-ed function for accessing the value of a settable flag from ML (defun ml-get_flag_value (flag) (let ((pflag (concat '|%| (canonise-case-symbol flag) '|-flag|))) (if (memq pflag %flags) (eval pflag) (failwith (concat flag " not a settable flag"))))) (dml |get_flag_value| 1 ml-get_flag_value (|string| -> |bool|)) ;;; MJCG 13/10/89 for HOL88 ;;; dml-ed function for getting list of flags ;;; Bugfix for CL. MJCG 23/11/90: cdddddr expanded out ;;; (since not defined in CL) (defun ml-flags () (reverse (mapcar (function ; (lambda (x) (imploden (reverse(cdddddr(reverse(cdr(exploden x)))))))) (lambda (x) (imploden (reverse(cdr(cdr(cdr(cdr(cdr(reverse(cdr(exploden x)))))))))))) %flags))) (dml |flags| 0 ml-flags (|void| -> (|string| |list|))) ;;; MJCG 29/11/88 for HOL88 ;;; |%prompt-flag| determines whether to output a prompt (setq |%prompt-flag| t) (defun nextcn () (if (null inputstack) (cond (fin-ligne (if |%prompt-flag| (princ %prompt-string)) (setq fin-ligne nil)))) (let ((c (llreadcn))) (if (null c) (throw-from eof nil)) ;; Modification J.Joyce Apr 87 - prompt also on cr character (if (or (= c lf) (= c cr)) (setq fin-ligne t)) ;newline: arm prompt c)) ;nextch ;;; MJCG 28/11/88 for HOL88 ;;; dml-ed function for setting |%prompt-flag| (defun ml-prompt (x) (prog1 |%prompt-flag| (setq |%prompt-flag| x))) (dml |prompt| 1 ml-prompt (|bool| -> |bool|)) ;;; Part 4: file token handling and file opening, closing, etc ;;; MJCG 12/10/88 for HOL88 ;;; %search-path holds the HOL users search path. It is initialized to nil. (setq %search-path nil) ;;; MJCG 13/10/88 for HOL88 ;;; dml-ed function for getting search path from ML (defun ml-search_path () %search-path) (dml |search_path| 0 ml-search_path (|void| -> (|string| |list|))) ;;; MJCG 13/10/88 for HOL88 ;;; dml-ed function for setting search path from ML ;;; (old search path returned) ;;; MJCG 26/9/89 for HOL88 ;;; () returned (defun ml-set_search_path (new-path) (progn %search-path (setq %search-path new-path) nil)) (dml |set_search_path| 1 ml-set_search_path ((|string| |list|) -> |void|)) ;;; ===================================================================== ;;; TFM 23.11.91 for version 2.01 ;;; %library-search-path holds the HOL users library search path. ;;; It is initialized to nil. ;;; ===================================================================== (setq %library-search-path nil) ;;; dml-ed function for getting library search path from ML (defun ml-library_search_path () %library-search-path) (dml |library_search_path| 0 ml-library_search_path (|void| -> (|string| |list|))) ;;; dml-ed function for setting library search path from ML (defun ml-set_library_search_path (new-path) (progn %library-search-path (setq %library-search-path new-path) nil)) (dml |set_library_search_path| 1 ml-set_library_search_path ((|string| |list|) -> |void|)) ;;; MJCG 312/10/88 for HOL88 ;;; Split a file into its name and extension (defun dest-file-name (tok) (prog (chars ext) (setq chars (reverse (exploden tok))) (setq ext nil) loop (if (null chars) (return (cons tok nil))) (cond ((or (not (= (car chars) #/.)) (null (cdr chars))) (setq ext (cons (car chars) ext)) (setq chars (cdr chars)) (go loop)) ((= (cadr chars) #/.) ; we have the unix '..' directory idiom (return (cons tok nil))) (t (return (cons (imploden (reverse (cdr chars))) (imploden ext))))))) (defun file-name (tok) (car (dest-file-name tok))) (defun file-ext (tok) (cdr (dest-file-name tok))) ;;; MJCG 12/10/88 and 31/10/88 for HOL88 ;;; (find-file name) returns name if it exists on the current directory, ;;; otherwise it returns the first piname that exists, where ;;; %search-path = (p1 ... pn). ;;; If no such pi exists then name (prepended with %directory) is returned ;;; (for compatability with old code). ;;; If the file name has the form `name.m*` then find-file ;;; searches each directory first for `name_ml.o` and then `name.ml` ;;; (this hack is for code compatibility). (defun find-file (tok) (let* ((name-and-type (dest-file-name tok)) (name (car name-and-type)) (exts (if (eq (cdr name-and-type) '|m*|) (list "_ml.o" ".ml") (list (if (cdr name-and-type) (catenate "." (cdr name-and-type)) "")))) (found nil) (pre-directory ;; JAC 19.06.92 for pc - prepend empty string if filename ;; is already completely specified (i.e. contains :) - was ;; (or (and (boundp '%directory) (symbol-value '%directory)) "") (or (and (boundp '%directory) #+pc (not (find (schar ":" 0) (string tok))) (symbol-value '%directory)) ""))) (do ((search-path (nconc (if (exploden pre-directory) (list pre-directory)) (or %search-path (list ""))) (cdr search-path))) ((null search-path) (catenate pre-directory tok)) (setq found (find-file1 (car search-path) name exts)) (if found (return found))))) ;;; JVT 11/03/93 for HOL88 V2.02 ;;; Some common lisps do not support automatic expansion of "~" into ;;; the user's home directory when loading files. A change was made to ;;; find-file1 to ensure that the file returned (if found) by find-file1 ;;; has a fully expanded pathname. (defun find-file1 (dir name exts) (do ((exts exts (cdr exts)) (file nil)) ((null exts) nil) (setq file (catenate dir name (car exts))) (let ((fle (probe-file file))) (if fle #+franz (return file) #-franz (return (namestring fle)))))) ;;; MJCG 13/10/88 for HOL88 ;;; dml-ed versions of find-file; failure if files can't be found ;;; (N.B. Lisp find-file doesn't fail) (defun ml-find_file (name) (let ((file (find-file name))) (if (probe-file file) file (failwith '|find_file|)))) (dml |find_file| 1 ml-find_file (|string| -> |string|)) (defun ml-find_ml_file (name) (let ((file (find-file (if (ends-in-ml name) name (catenate name '|.m*|))))) (if (probe-file file) file (failwith '|find_file|)))) (dml |find_ml_file| 1 ml-find_ml_file (|string| -> |string|)) (defun ml-find_theory (name) (or (fileexists 'theory name) (failwith '|find_file|))) (dml |find_theory| 1 ml-find_theory (|string| -> |string|)) ;;; MJCG 12/10/88 for HOL88 ;;; find-file wrapped around fileof (defun fileexists (kind tok) (let ((file (find-file (fileof kind tok)))) (if (probe-file file) file))) hol88-2.02.19940316/lisp/hol-writ.l0000640000212700021270000012655705523413326014640 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: hol-writ.l ;;; ;;; ;;; ;;; DESCRIPTION: Lisp functions for printing HOL terms ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l, genmacs.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; RJB 16.11.92 - All occurrences of <=> deleted. (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (include "lisp/genmacs") (special ol-lam-sym hol-unops hol-binops binders |%show_types-flag| |%interface_print-flag| %turnstile |%print_top_types-flag| |%print_list-flag| |%print_cond-flag| |%print_quant-flag| |%print_restrict-flag| |%print_let-flag| |%print_uncurry-flag| |%print_infix-flag| |%print_lettypes-flag| |%print_top_val-flag| |%print_set-flag| |%empty-set| |%finite-set-constructor| |%set-abstraction-constructor| |%pp_sexpr-flag| |%print_sexpr-flag| %pt1 |%print_parse_trees-flag|)) #+franz (declare (localf subtract is-subset nargtys polytys uninferred-poly-remnant prep-ol-let print-ol-bnd print-ol-let prep-ol-uncurry is-ol-cons is-ol-list pre-prep-ol-list prep-ol-list print-ol-list is-ol-set-cons is-ol-finite-set pre-prep-ol-finite-set prep-ol-finite-set print-ol-finite-set prep-ol-set-abstraction print-ol-set-abstraction prep-ol-cond is-special-comb prep-ol-quant prep-ol-restrict prep-ol-unop prep-ol-binop print-ol-unop print-eq print-ol-binop print-neg print-ol-quant print-ol-restrict)) ;;; If T1 is a 'closes property of T2 then brackets will be put around ;;; T1 when it is printed in the context of T2 (eval-when (load) (mapc #'(lambda (x) (putprop (car x) (cdr x) 'closes)) '((|~| . (quant restrict /\\ \\/ |==>| |,| |=|)) (/\\ . (quant restrict /\\ \\/ |==>| |,| |=|)) (\\/ . (quant restrict \\/ |==>| |,| |=|)) (|==>| . (quant restrict |==>| |,| |=|)) (|,| . (quant restrict |,| /\\ \\/ |==>| ol-let |=|)) (|=| . (quant restrict ol-let |=|)) (then . (quant restrict then |=| /\\ \\/ |~| |==>|)) (else . (quant restrict then |,| |=| /\\ \\/ |==>|)) (listcomb . (quant restrict listcomb ratorofcomb infixcomb then |,| typed ol-let |=| /\\ \\/ ==> )) (ratorofcomb . (quant restrict listcomb ratorofcomb infixcomb then |,| typed ol-let |=| /\\ \\/ ==> )) (infixcomb . (quant restrict listcomb ratorofcomb infixcomb then |,| typed ol-let |=| /\\ \\/ ==> |~|)) (varstruct . (|,| typed)) (varstructrator . (|,| typed)) (let-rhs . (|=| |,| typed)) (let-body . (quant restrict |=| /\\ \\/ |~| |==>|)) (typed . (infixcomb)) (fun . (fun)) (sum . (sum fun)) (prod . (prod sum fun)) (quant . (|,| typed)) (restrict . (|,| typed)) (fin-set . (|,|)) (set-abs1 . (|,|)) (eqn-rhs . (quant restrict listcomb ratorofcomb infixcomb then |,| typed))))) ;;; MJCG 17/1/89 for HOL88 ;;; Code change from Davis Shepherd for changing lambda symbol ;;; (ol-lam-sym for lam-sym) ;;; MJCG 31/1/89 for HOL88 ;;; Modified to support print_flags ;;; MJCG 5/8/90 for HOL88.1.12 ;;; |%print_set-flag| added (eval-when (load) (mapc (function (lambda (x) (set x t))) '(|%print_list-flag| |%print_cond-flag| |%print_restrict-flag| |%print_quant-flag| |%print_infix-flag| |%print_let-flag| |%print_comb-flag|)) (setq |%print_set-flag| nil)) ;;; MJCG 5/8/90 for HOL88.1.12 ;;; Modified to print sets (defun prep-tm (tm) (case (term-class tm) (var tm) (const (cond ((and |%print_set-flag| (eq (get-const-name tm) %empty-set)) `(ol-finite-set . (nil . ,(get-ol-set-type tm)))) ((and |%print_list-flag| (eq (get-const-name tm) 'NIL)) `(ol-list . (nil . ,(get-ol-list-type tm)))) (t tm))) (abs (list 'quant ol-lam-sym (get-abs-var tm) (prep-tm (get-abs-body tm)))) (comb (let ((rator (get-rator tm)) (rand (get-rand tm)) (ty (get-type tm))) (or (and |%print_set-flag| (prep-ol-finite-set tm)) (and |%print_set-flag| (prep-ol-set-abstraction rator rand ty)) (and |%print_list-flag| (prep-ol-list tm)) (and |%print_cond-flag| (prep-ol-cond rator rand ty)) (and |%print_restrict-flag|(prep-ol-restrict rator rand ty)) (and |%print_quant-flag| (prep-ol-quant rator rand ty)) (and |%print_let-flag| (prep-ol-let tm)) (and |%print_infix-flag| (prep-ol-binop rator rand ty)) (and |%print_infix-flag| (prep-ol-unop rator rand ty)) (and |%print_uncurry-flag| (prep-ol-uncurry tm)) (prep-comb rator rand ty)))) (t (lcferror "prep-tm")))) ;;; Added by RJB 16.11.92 ;;; Set difference (defun subtract (l1 l2) (if (null l1) nil (if (member (car l1) l2) (subtract (cdr l1) l2) (cons (car l1) (subtract (cdr l1) l2))))) ;;; Added by RJB 16.11.92 (defun is-subset (l1 l2) (if (null l1) t (and (member (car l1) l2) (is-subset (cdr l1) l2)))) ;;; Added by RJB 16.11.92 ;;; Given a type and a number n this function returns a cons cell whose car is ;;; a list of the first n argument types and the cdr is the remainder of the ;;; type. If the number of arguments is less than n, the function stops pulling ;;; off argument types when they are exhausted. (defun nargtys (ty n) (if (or (< n 1) (not (eq (get-type-op ty) '|fun|))) (cons nil ty) (let ((tyargs (get-type-args ty))) (let ((argty (car tyargs)) (restty (cadr tyargs))) (let ((result (nargtys restty (- n 1)))) (cons (cons argty (car result)) (cdr result))))))) ;;; Added by RJB 16.11.92 ;;; Obtains a list of the type variables present in a type. (defun polytys (ty) (if (is-vartype ty) (list ty) (itlist 'union (cons nil (mapcar 'polytys (get-type-args ty))) nil))) ;;; Added by RJB 16.11.92 ;;; This function takes a name of an object language constant and a number. ;;; Suppose the constant has been applied to that number of arguments and the ;;; types of those arguments are known. Then, this function returns non-nil if ;;; it is still not possible to infer the type of the application. ;;; It does this by testing the remnant of the most general type of the ;;; constant to see if it contains a type variable that does not appear in the ;;; types of the arguments. (defun uninferred-poly-remnant (cname num-of-args) (let ((cty (constp cname))) (let ((splitty (nargtys cty num-of-args))) (let ((argtys (car splitty)) (resty (cdr splitty))) (not (is-subset (polytys resty) (itlist 'union (cons nil (mapcar 'polytys argtys)) nil))))))) ;;; RJB 16.11.92: Pretty-printing with `show_types' true re-implemented. ;;; ;;; The basic idea is: ;;; (1) Type the bound variables of abstractions. Note that this ensures that ;;; terms such as "@(x:*). T" are printed with enough type information. ;;; (2) Type each free variable exactly once. ;;; (3) Type polymorphic constants (including NIL) if they are not the operator ;;; of an application. ;;; (4) Type an application (combination) if its operator is a constant whose ;;; most general type contains a type variable which cannot be inferred ;;; from the arguments (see uninferred-poly-remnant). ;;; This is achieved by passing around a list of variables (actually name/type ;;; pairs) that have already been adorned with type information during the ;;; term traversal. The only tricky bit is dealing with bound variables. ;;; As a binding is entered the bound variables are added to the list of typed ;;; variables coming down the term tree (The bound variables are typed at the ;;; binding so don't need to be done in the body.). As the traversal comes ;;; back up through the binding, the new variables added to the list (that is ;;; those variables that were adorned with type information inside the body) ;;; are extracted and added to the original list of typed variables. This ;;; allows the bound variables to be removed from the list so that free ;;; variables of the same name will still be typed, but without removing such ;;; variables from the list if they had already been typed. ;;; ;;; An additional optimisation is performed: A term is not printed with type ;;; information if it is a direct subterm of ~, /\, \/, or ==>. However, if ;;; the term is a variable it *is* added to the typed-variable list since we ;;; know its type can be inferred. ;;; ;;; This scheme certainly doesn't keep type information to a minimum but I ;;; don't think the amount will be excessive, and I think it will provide ;;; enough information for the type of the term to be inferred which was not ;;; the case for the old version. ;;; ;;; - RJB ;;; ;;; Printing of $ before infixed variables added ;;; MJCG 01.02.94 (defun print-tm (tm op1 typedvars) (let ((op2 (term-class tm)) (tml (get-term-list tm)) (ty (get-type tm))) (let ((tyflag ; print type of this particular term? (and |%show_types-flag| (case op2 (var (not (member (cdr tm) typedvars))) (const (and (not (eq op1 'ratorofcomb)) (opoly (constp (get-const-name tm))))) ((listcomb infixcomb) (let ((r (first tml)) ; find innermost operator (n (- (length tml) 1))) (if (eq (term-class r) 'infixcomb) (setq n (+ n (- (length (get-term-list r)) 1)) r (first (get-term-list r)))) (and (is-const r) (uninferred-poly-remnant (get-const-name r) n)))) ((ol-list ol-finite-set) (eq tml nil)) (t nil)))) (knownty (memq op1 '(|~| /\\ \\/ |==>| varstructrator)))) (let ((printty (and tyflag (not knownty)))) ; possibly one pair of parens for precedence, another for typing (let ((cl1 (closes op1 (if printty 'typed op2))) (cl2 (and printty (closes 'typed op2)))) (if cl1 (ptoken |(|)) (if cl2 (ptoken |(|)) (pbegin 0) (setq typedvars (case op2 (var (progn (if (memq (get-var-name tm) hol-var-binops) (ptoken |$|)) (pstring (get-var-name tm)) (if tyflag (cons (cdr tm) typedvars) typedvars))) (const (progn (print-const (get-const-name tm)) typedvars)) (cond (print-cond tml typedvars)) (listcomb (print-listcomb tml typedvars)) (infixcomb (print-infixcomb tml typedvars)) (restrict (print-ol-restrict tm typedvars)) (quant (print-ol-quant tm typedvars)) (|~| (print-ol-unop tm typedvars)) ((|=| /\\ \\/ |==>| |,|) (print-ol-binop tm typedvars)) (ol-let (print-ol-let tm typedvars)) (ol-list (print-ol-list tm typedvars)) (ol-finite-set (print-ol-finite-set tm typedvars)) (ol-set-abstraction (print-ol-set-abstraction tml typedvars)) (t (lcferror "print-tm")))) (cond (printty ; print type (if cl2 (ptoken |)|) (ifn (memq op2 '(var const ol-list ol-finite-set)) (ptoken | |))) (pbreak 0 0) (ptoken |:|) (print-ty (case op2 (ol-list (list '|list| ty)) (ol-finite-set (list '|set| ty)) (t ty)) t))) (if cl1 (ptoken |)|)) (pend)) typedvars)))) ;;; MJCG 20/10/88 for HOL88 ;;; string printing function that inverts interface (defun pistring (str) (pstring (or (and |%interface_print-flag| (get str 'interface-print)) str))) ;;; MJCG 19/10/88 for HOL88 ;;; print a constant (may be a prefix, infix or binder standing alone) ;;; modified to invert interface-map (defun print-const (name) (cond ((or (get name 'olinfix) (get name 'prefix) (get name 'binder)) (ptoken |$|))) (pistring name)) ;;; MJCG 3/2/89 for HOL88 ;;; Function for stripping of the varstructs of a function ;;; "\v1 v2 ... vn. t" --> ((v1 v2 ... vn) . t) ;;; "t" --> (nil . t) -- t not a function ;;; (vi either a variable or a varstruct) ;;; MJCG 27/6/92 ;;; Strip off at most n lambdas if n is a number and all lambdas otherwise ;;; (strip-abs ("\x1 ... xm ... xn. e" m)) = ((x1 ... xm) "\x(m+1) ... xn. e") (defun strip-abs (tm n) (or (and (numberp n) (eq n 0) (cons nil tm)) (and (is-abs tm) (let* ((v (get-abs-var tm)) (b (get-abs-body tm)) (p (strip-abs b (if (numberp n) (sub1 n) n)))) (cons (cons v (car p)) (cdr p)))) (and (is-special-comb tm '(UNCURRY)) (let* ((p (dest-uncurry tm)) (q (strip-abs (cdr p) (if (numberp n) (sub1 n) n)))) (cons (cons (car p) (car q)) (cdr q)))) (cons nil tm))) ;;; MJCG 3/2/89 for HOL88 ;;; Function for exploding an application ;;; "LET ( ... (LET t1 t2) ... ) tn" --> (t1 t2 ... tn) ;;; "t" --> (t) -- t not of this form (defun strip-let (tm) (or (and (is-comb tm) (is-special-comb (get-rator tm) '(LET)) (let ((args (strip-let(get-rand(get-rator tm))))) (append args (list (get-rand tm))))) (list tm))) ;;; code for printing "let ... in ... " ;;; MJCG 3/2/89 for HOL88 ;;; Extended to deal with fancier let constructs ;;; ;;; "let x=u in tm" ;;; ;;; "LET (\x. tm) u" --> (ol-let (((x) . u)) tm) ;;; ;;; "let f v1 ... vn = u in tm" ;;; ;;; "LET (\f. tm) (\v1 ... vn. u)" --> (ol-let (((f v1 ... vn) . u)) tm) ;;; ;;; "let x1=u1 and ... and xn=un in tm" ;;; ;;; "LET ( ... (LET (\x1 ... xn. tm) u1) ... ) un" ;;; --> ;;; (ol-let ((x1 . u2) ... (xn .un)) tm) ;;; ;;; Modified by MJCG 27/6/92 to use new strip-abs with second argument (defun prep-ol-let (tm) (and (is-comb tm) (is-special-comb (get-rator tm) `(LET)) (let* ((tms (strip-let tm)) (args (cdr tms)) ; (u1 ... un) (p (strip-abs (car tms) (length args))) (params (car p)) ; (x1 ... xn) (body (cdr p))) ; tm (and (= (length params) (length args)) (list 'ol-let (mapcar (function (lambda (x u) (let ((q (strip-abs u nil))) (cons (cons (prep-tm x) (mapcar (function prep-tm) (car q))) (prep-tm(cdr q)))))) params args) (prep-tm body)))))) ;;; MJCG 3/2/89 for HOL88 ;;; Printing of let bindings ;;; ((x) . u) --> x = u ;;; ;;; ((f v1 ... vn) . u) --> f v1 ... vn = u ;;; ;;; Modified by RJB 16.11.92 ;;; ;;; The variable being declared by the let binding is not printed with type ;;; information, but any occurrence of it within the body (as a recursive call) ;;; is printed with type information otherwise it may not be possible to infer ;;; the type of the body. If a structure is being declared (e.g. "(x,y)") all ;;; the variables in it *are* given types. This is because the `varstructrator' ;;; context gets lost once the structure is entered and I don't want to ;;; complicate the code with a more sophisticated technique. ;;; ;;; Note that the result returned by this function is not the usual list of ;;; variables that have already been typed but a cons of the variables declared ;;; by the let binding and that list. (defun print-ol-bnd (b typedvars) (pibegin 0) (let ((letvars (print-tm (caar b) 'varstructrator nil)) (boundvars nil)) (pbreak 0 0) (mapc (function (lambda (y) (ptoken | |) (pbreak 0 1) (setq boundvars (append (print-tm y 'varstruct nil) boundvars)))) (cdar b)) (ptoken | = |) (pbreak 0 2) (let ((bodyvars (append boundvars typedvars))) (let ((newlytypedvars (ldiff (print-tm (cdr b) 'let-rhs bodyvars) bodyvars))) (pend) (cons letvars (append (subtract newlytypedvars letvars) typedvars)))))) ;;; MJCG 3/2/89 for HOL88 ;;; Modified printing of let-terms ;;; Modified by RJB 16.11.92 (defun print-ol-let (tm typedvars) (let ((bnd (cadr tm)) (body (caddr tm)) (letvars nil)) (pbegin 0) (ptoken |let |) (let ((result (print-ol-bnd (car bnd) typedvars))) (setq letvars (append (car result) letvars)) (setq typedvars (cdr result))) (mapc #'(lambda (y) (pbreak 1 0 ) (ptoken |and |) (let ((result (print-ol-bnd y typedvars))) (setq letvars (append (car result) letvars)) (setq typedvars (cdr result)))) (cdr bnd)) (pbreak 1 0) (ptoken |in|) (pbreak 1 1) (let ((bodyvars (append letvars typedvars))) (setq typedvars (append (ldiff (print-tm body 'let-body bodyvars) bodyvars) typedvars))) (pend) typedvars)) ;;; MJCG 2/2/89 for HOL88 ;;; code for printing "\(v1,v2,...,vn).t" ;;; MJCG 2/2/89 for HOL88 ;;; function for making pairs: ("t1" "t2") --> "(t1,t2)" (defun make-pair (t1 t2) (let* ((ty1 (get-type t1)) (ty2 (get-type t2)) (prodty (make-type 'prod (list ty1 ty2))) (fun1ty (make-type 'fun (list ty2 prodty))) (fun2ty (make-type 'fun (list ty1 fun1ty)))) (make-comb (make-comb (make-const comma-sym fun2ty) t1 fun1ty) t2 prodty))) ;;; dest-uncurry is defined by the rules: ;;; ;;; ------------------------------------ ;;; "UNCURRY(\x.\y. t)" --> ("x,y" . t) ;;; ;;; "(UNCURRY t)" --> ("p" . t1) ;;; ----------------------------------------- ;;; "UNCURRY(\x. UNCURRY t)" --> ("x,p" . t1) ;;; ;;; "(UNCURRY t)" --> ("p" . "\x.t1") ;;; ------------------------------------- ;;; "UNCURRY(UNCURRY t)" --> ("p,x" . t1) ;;; ;;; "(UNCURRY t)" --> ("p" . "\q.t1") ;;; ------------------------------------- ("q" a tuple) ;;; "UNCURRY(UNCURRY t)" --> ("p,q" . t1) ;;; ;;; If none of these apply, then nil is returned ;;; The Lisp code below shows why Prolog is such a nice language! ;;; Bugfix for Common Lisp: added test that argument is a combination (is-comb) ;;; MJCG 3 March 1991 (defun dest-uncurry (tm) (and (is-comb tm) (let ((t1 (get-rand tm))) (or (and (is-abs t1) (is-abs (get-abs-body t1)) (cons (make-pair (get-abs-var t1) (get-abs-var(get-abs-body t1))) (get-abs-body(get-abs-body t1)))) (and (is-abs t1) (is-special-comb (get-abs-body t1) '(UNCURRY)) (let ((p (dest-uncurry (get-abs-body t1)))) (and p (cons (make-pair (get-abs-var t1) (car p)) (cdr p))))) (and (is-special-comb t1 '(UNCURRY)) (let ((p (dest-uncurry t1))) (and p (or (and (is-abs (cdr p)) (cons (make-pair (car p) (get-abs-var (cdr p))) (get-abs-body(cdr p)))) (and (is-special-comb (cdr p) '(UNCURRY)) (let ((q (dest-uncurry(cdr p)))) (and q (cons (make-pair (car p) (car q)) (cdr q))))))))))))) ;;; (prep-ol-uncurry "\(v1,v2,...,vn).t") --> (quant \\ "v1,...,vn" t) (defun prep-ol-uncurry (tm) (and (is-special-comb tm '(UNCURRY)) (let ((p (dest-uncurry tm))) (and p (list 'quant ol-lam-sym (prep-tm(car p)) (prep-tm(cdr p))))))) ;;; code for printing "[t1; ... ;tn]" ;;; is-ol-list tests whether tm is of the form: ;;; CONS t1 (CONS t2 ... (CONS tn nil) ... ) (defun is-ol-cons (tm) (and (is-comb tm) (let ((rator (get-rator tm))) (and (is-comb rator) (is-const (get-rator rator)) (eq (get-const-name(get-rator rator)) 'CONS))))) (defun is-ol-list (tm) (or (null-ol-list tm) (and (is-ol-cons tm) (is-ol-list(tl-ol-list tm))))) ;;; pre-prep-ol-list gets a list of the elements of an OL value representing ;;; a list - e.g CONS 1(CONS 2(CONS 3 NIL)) -> (1 2 3) (defun pre-prep-ol-list (tm) (cond ((null-ol-list tm) nil) (t (cons (prep-tm (hd-ol-list tm)) (pre-prep-ol-list (tl-ol-list tm)))))) (defun prep-ol-list (tm) (if (is-ol-list tm) (make-prep-term 'ol-list (pre-prep-ol-list tm) (get-ol-list-type tm)))) ;;; Modified by RJB 16.11.92 (defun print-ol-list (tm typedvars) (let ((termlist (get-term-list tm))) (pibegin 1) (ptoken |[|) (cond (termlist (setq typedvars (print-tm (car termlist) t typedvars)) (mapc #'(lambda (y) (ptoken |;|) (pbreak 0 0) (setq typedvars (print-tm y t typedvars))) (cdr termlist)))) (ptoken |]|) (pend) typedvars)) ;;; code for printing "{t1, ... ,tn}" ;;; Duplicates code for lists -- would be more space-efficientr to fold set ;;; and list printing code into one set of routines. ;;; The current empty set and finite set constructor are held in the globals ;;; %empty-set, %finite-set-constructor. ;;; The current set abstraction constructor is held in the global ;;; %set-abstraction-constructor ;;; is-ol-finite-set tests whether tm is of the form: ;;; INSERT t1 (INSERT t2 ... (INSERT tn EMPTY) ... ) (defun is-ol-set-cons (tm) (and (is-comb tm) (let ((rator (get-rator tm))) (and (is-comb rator) (is-const (get-rator rator)) (eq (get-const-name(get-rator rator)) %finite-set-constructor))))) (defun is-ol-finite-set (tm) (or (null-ol-set tm) (and (is-ol-set-cons tm) (is-ol-finite-set(tl-ol-set tm))))) ;;; pre-prep-ol-finite-set gets a list of the elements of an OL value ;;; representing a finite set ;;; - e.g INSERT 1(INSERT 2(INSERT 3 EMPTY)) -> (1 2 3) (defun pre-prep-ol-finite-set (tm) (cond ((null-ol-set tm) nil) (t (cons (prep-tm (hd-ol-set tm)) (pre-prep-ol-finite-set (tl-ol-set tm)))))) (defun prep-ol-finite-set (tm) (if (is-ol-finite-set tm) (make-prep-term 'ol-finite-set (pre-prep-ol-finite-set tm) (get-ol-set-type tm)))) ;;; Modified by RJB 16.11.92 (defun print-ol-finite-set (tm typedvars) (let ((termlist (get-term-list tm))) (pibegin 1) (ptoken |{|) (cond (termlist (setq typedvars (print-tm (car termlist) 'fin-set typedvars)) (mapc #'(lambda (y) (ptoken |,|) (pbreak 0 0) (setq typedvars (print-tm y 'fin-set typedvars))) (cdr termlist)))) (ptoken |}|) (pend) typedvars)) ;;; Prepare set abstractions for printing ;;; MJCG 12/11/90: Modified not to print set abstractions if no variables bound (defun prep-ol-set-abstraction (rator rand ty) (and (is-const rator) (eq (get-const-name rator) %set-abstraction-constructor) (or (is-abs rand) (dest-uncurry rand)) (let ((vp (if (is-abs rand) (cons (get-abs-var rand) (get-abs-body rand)) (dest-uncurry rand)))) (if (is-pair (cdr vp)) (let ((p1 (get-fst (cdr vp))) ;;; p1 in GSPEC(\vars.(p1,p2)) (p2 (get-snd (cdr vp))) ;;; p2 in GSPEC(\vars.(p1,p2)) (vs (freevars(car vp)))) ;;; vars in GSPEC(\vars.(p1,p2)) (and (equal vs (intersect (freevars p1) (freevars p2))) (make-prep-term 'ol-set-abstraction (list (prep-tm p1) (prep-tm p2)) ty))))))) ;;; Modified by RJB 16.11.92 (defun print-ol-set-abstraction (tml typedvars) (ptoken |{|) (setq typedvars (print-tm (first tml) 'set-abs1 typedvars)) (ptoken | \| |) (pbreak 0 1) (setq typedvars (print-tm (second tml) 'set-abs2 typedvars)) (ptoken |}|) typedvars) ;;; prepare conditional for printing ;;; put the combination (((COND P) X) Y) into a special format (defun prep-ol-cond (rator rand ty) (if (is-comb rator) (let ((ratrat (get-rator rator))) (if (is-comb ratrat) (let ((ratratrat (get-rator ratrat))) (if (and (is-const ratratrat) (eq (get-const-name ratratrat) 'COND)) (make-prep-term 'cond (list (prep-tm (get-rand ratrat)) (prep-tm (get-rand rator)) (prep-tm rand)) ty))))))) ;;; print conditionals ;;; Modified by RJB 16.11.92 (defun print-cond (tml typedvars) (ptoken |(|) (setq typedvars (print-tm (first tml) 'then typedvars)) (ptoken | => |) (pbreak 0 1) (setq typedvars (print-tm (second tml) 'else typedvars)) (ptoken " | ") ; vertical bar (pbreak 0 1) (setq typedvars (print-tm (third tml) 'else typedvars)) (ptoken |)|) typedvars) ;;; print a long combination (f x1 ... xn) ;;; Copied from f-writol.l and modified by RJB 16.11.92 (defun print-listcomb (tml typedvars) (let ((y (pop tml)) (prev nil)) (setq typedvars (print-tm y 'ratorofcomb typedvars)) (while tml (setq prev y) (setq y (pop tml)) (if (and(memq (term-class prev) '(var const)) (memq (term-class y) '(var const))) (ptoken | |)) ; space between two identifiers (pbreak 0 0) (setq typedvars (print-tm y 'listcomb typedvars))) typedvars)) ;;; (is-special-comb tm '(tok1 tok2 ...)) checks that tm has the form "F t" ;;; where "F" is a constant. (defun is-special-comb (tm tokl) (and (is-comb tm) (let ((rator (get-rator tm))) (and (is-const rator) (memq (get-const-name rator) tokl))))) ;;; MJCG 27/10/88 for HOL88 ;;; replace a name by its interface-print property (if it exists) (defmacro get-print-name (name) `(or (get ,name 'interface-print) ,name)) ;;; MJCG 27/10/88 for HOL88 ;;; (prep-ol-quant "Q" "\x.t" ty) --> (quant 'Q "x" "t") ;;; Modified to use get-print-name ;;; MJCG 3/2/88 for HOL88 ;;; Modified to handle uncurried functions (defun prep-ol-quant (t1 t2 ty) (and (is-const t1) (get (get-print-name(get-const-name t1)) 'binder) (or (and (is-abs t2) (list 'quant (get-const-name t1) (prep-tm(get-abs-var t2)) (prep-tm(get-abs-body t2)))) (and (is-special-comb t2 '(UNCURRY)) (let ((p (dest-uncurry t2))) (and p (list 'quant (get-const-name t1) (prep-tm (car p)) (prep-tm (cdr p))))))))) ;;; MJCG 24/1/91 ;;; (prep-ol-restrict "Q P" "\x.t" ty) --> (restrict 'Q "P" "x" "t") (defun prep-ol-restrict (t1 t2 ty) (and (is-comb t1) (is-const (get-rator t1)) (get (get-print-name(get-const-name(get-rator t1))) 'unrestrict) (or (and (is-abs t2) (list 'restrict (get (get-const-name (get-rator t1)) 'unrestrict) (prep-tm (get-rand t1)) (prep-tm(get-abs-var t2)) (prep-tm(get-abs-body t2)))) (and (is-special-comb t2 '(UNCURRY)) (let ((p (dest-uncurry t2))) (and p (list 'restrict (get (get-const-name(get-rator t1)) 'unrestrict) (prep-tm (get-rand t1)) (prep-tm (car p)) (prep-tm (cdr p))))))))) (setq hol-unops '(|~|)) (setq hol-binops '(/\\ \\/ |==>| |=| |,|)) (setq binders '(\\ |!| |?| |@|)) ;;; (prep-ol-unop "F" "t" ty) --> (F t) ;;; where F is an atom and t is a term (defun prep-ol-unop (t1 t2 ty) (if (and (is-const t1) (memq (get-const-name t1) hol-unops)) (list (get-const-name t1) (prep-tm t2)))) ;;; (prep-ol-binop "F t1" "t2" ty) --> (F t1 t2) ;;; where F is an atom and t1,t2 are terms (defun prep-ol-binop (t1 t2 ty) (if (is-special-comb t1 hol-binops) (list (get-const-name(get-rator t1)) (prep-tm(get-rand t1)) (prep-tm t2)))) ;;; print a formula built from a unary operator ;;; Modified by RJB 16.11.92 (defun print-ol-unop (fm typedvars) (case (first fm) (|~| (print-neg fm typedvars)))) ;;; print a formula built from a binary operator ;;; suppress parentheses using right-associativity (except for =) ;;; print tuples as an inconsistent block ;;; first an ad-hoc function for printing equations ;;; MJCG 20/10/88 for HOL88 ;;; modified to use pistring ;;; Modified by RJB 16.11.92 (defun print-eq (fm typedvars) (setq typedvars (print-tm (second fm) '|=| typedvars)) ;;; (ptoken | =|) ; old code (ptoken | |)(pistring '|=|) (pbreak 1 0) (print-tm (third fm) '|=| typedvars)) ;;; MJCG 19/10/88 for HOL88 ;;; print a user-defined infix operator ;;; modified to invert interface-map ;;; Modified by RJB 16.11.92 ;;; MJCG added comment on 31/01/94 for HOL88.2.02 (defun print-infixcomb (tml typedvars) (setq typedvars (print-tm (second tml) 'infixcomb typedvars)) (ptoken | |) (pistring (get-const-name (first tml))) ;;; N.B. OK for infixed variables as (pbreak 1 0) ;;; get-const-name = get-var-name (ugh!) (print-tm (third tml) 'infixcomb typedvars)) ; print-infixcomb ;;; MJCG 19/10/88 for HOL88 ;;; print a binary operator ;;; modified to invert interface-map ;;; Modified by RJB 16.11.92 (defun print-ol-binop (fm typedvars) (let ((op (first fm))) (case op (|=| (print-eq fm typedvars)) (t (case op (|,| (pibegin 0)) (t (pbegin 0))) (while (eq op (first fm)) (setq typedvars (print-tm (second fm) op typedvars)) (case (first fm) ;;; (|,| (ptoken |,|) (pbreak 0 0)) ;;; (|=| (ptoken | =|) (pbreak 1 0)) ;;; (/\\ (ptoken \ /\\) (pbreak 1 0)) ;;; (\\/ (ptoken \ \\/ (pbreak 1 0)) ;;; (|==>| (ptoken | ==>|) (pbreak 1 0))) (|,| (cond ((and |%interface_print-flag| (get '|,| 'interface-print)) (ptoken | |)(pistring '|,|) (pbreak 1 0)) (t (ptoken |,|) (pbreak 0 0)))) (/\\ (ptoken | |)(pistring '/\\) (pbreak 1 0)) (\\/ (ptoken | |)(pistring '\\/) (pbreak 1 0)) (|==>| (ptoken | |)(pistring '|==>|) (pbreak 1 0))) (setq fm (third fm))) (setq typedvars (print-tm fm op typedvars)) (pend) typedvars)))) ;;; MJCG 20/10/88 for HOL88 ;;; modified to use pistring ;;; print a negation ;;; Modified by RJB 16.11.92 (defun print-neg (fm typedvars) (pistring '|~|) (print-tm (second fm) (first fm) typedvars)) ;;; print Qx y z.w instead of Qx. Qy. Qz. (where Q is a binder) ;;; this makes a big difference if the formula is broken over several lines ;;; "\" is treated as a quantifier for printing purposes (eval-when (load) (putprop lam-sym t 'binder)) ;;; MJCG 19/10/88 for HOL88 ;;; print a quantifier ;;; modified to invert interface-map (setq |%print_uncurry-flag| t) ;;; Modified by RJB 16.11.92 (defun print-ol-quant (fm typedvars) (let ((quant (second fm)) (vars (third fm)) (body (fourth fm))) (pbegin 1) (pistring quant) (if (not(memq quant binders)) (ptoken | |)) (pibegin 0) (let ((boundvars (print-tm vars 'quant nil))) (while (and (eq (first body) 'quant) (eq (second body) quant)) (pbreak 1 0) (setq boundvars (append (print-tm (third body) 'quant nil) boundvars)) (setq body (fourth body))) (pend) (ptoken |.|) (pend) (pbreak 1 1) (let ((bodyvars (append boundvars typedvars))) (append (ldiff (print-tm body 'quant bodyvars) bodyvars) typedvars))))) ;;; MJCG 24.1.91 ;;; Modified by RJB 16.11.92 (defun print-ol-restrict (fm typedvars) (let ((quant (second fm)) (restrict (third fm)) (vars (fourth fm)) (body (fifth fm))) (pbegin 1) (pistring quant) (if (not(memq quant binders)) (ptoken | |)) (pibegin 0) (let ((boundvars (print-tm vars 'restrict nil))) (while (and (eq (first body) 'restrict) (eq (second body) quant) (equal (third body) restrict)) (pbreak 1 0) (setq boundvars (append (print-tm (fourth body) 'restrict nil) boundvars)) (setq body (fifth body))) (pend) (ptoken | ::|) (pbreak 1 1) (setq typedvars (print-tm restrict 'restrict typedvars)) (ptoken |.|) (pend) (pbreak 1 1) (let ((bodyvars (append boundvars typedvars))) (append (ldiff (print-tm body 'restrict bodyvars) bodyvars) typedvars))))) ;;; Change printing of predicate formulae to suppress HOL_ASSERT ;;; Modified by RJB 16.11.92 (defun print-pred-form (fm) (cond ((not (eq (get-pred-sym fm) 'HOL_ASSERT)) (pstring (get-pred-sym fm)) (pbreak 1 0))) (print-tm (get-pred-arg fm) t nil)) ;;; MJCG 10.12.90 for Centaur: ;;; Flag to determine whether to pretty-print lisp (setq |%pp_sexpr-flag| t) ;;; MJCG 10.12.90 for Centaur: ;;; Flag to determine whether to print in S-expression form (setq |%print_sexpr-flag| nil) ;;; MJCG 10.12.90 for Centaur: ;;; Add these flags to the list of known flags ;;; MJCG 7.4.91: %pp_sexpr-flag and %print_sexpr-flag ;;; declared in f-iox-stand.l ;;; MJCG 10.12.90 for Centaur: ;;; Print function: |%pp_sexpr-flag| true causes pretty-printing, otherwise not (defun sexpr-print (x) (if |%pp_sexpr-flag| #+franz (pp-form x) #-franz (pprint x) (princ x))) ;;; MJCG 10.12.90 for Centaur: redefined to switch on |%print_sexpr-flag| ;;; Overwrites definition in f-writol.l ;;; Modified by RJB 16.11.92 (defun ml-print_term (tm) (cond (|%print_sexpr-flag| (sexpr-print(reshape-tm tm))) (t (ptoken |"|) (print-tm (prep-tm tm) t nil) (ptoken |"|)))) ;ml-print_term ;;; RJB 1.7.92 ;;; Function to print a term without quotes (dml |print_unquoted_term| 1 ml-print_unquoted_term (|term| -> |void|)) ;;; Modified by RJB 16.11.92 (defun ml-print_unquoted_term (tm) (cond (|%print_sexpr-flag| (sexpr-print(reshape-tm tm))) (t (print-tm (prep-tm tm) t nil)))) ;;; MJCG 10.12.90 for Centaur: ;;; Function to convert a term value into an S-expression form that can ;;; be read by a dumb Lisp parser (essentially just add extra brackets) (defun reshape-tm (tm) (cond ((is-var tm) `(var ,(get-var-name tm) ,(get-type tm))) ((is-const tm) `(const ,(get-const-name tm) ,(get-type tm))) ((is-comb tm) `(comb ,(reshape-tm(get-rator tm)) ,(reshape-tm(get-rand tm)) ,(get-type tm))) ((is-abs tm) `(abs ,(reshape-tm(get-abs-var tm)) ,(reshape-tm(get-abs-body tm)) ,(get-type tm))))) ;;; MJCG 10.12.90 for Centaur: ;;; Function to reshape a hypothesis or conclusion of a theorem ;;; (hypotheses and conclusions are wrapped with a HOL_ASSERT for ;;; historical LCF reasons) (defun reshape-thm (x) (reshape-tm(cddr x))) ;;; Changes top-level printing of theorems to suppress quotes ;;; MJCG 10.12.90 for Centaur: modified to switch on |%print_sexpr-flag| ;;; TFM 92.07.08 : [DES] 8Jul92 line below installed. ;;; TFM 92.07.09 : previous change uninstalled, pending better solution. ;;; JRH 92.07.20 : better solution (from DES) put in; old code commented out ;;; (defun ml-print_thm (th) ;;; (cond (|%print_sexpr-flag| ;;; (sexpr-print ;;; (list 'thm ;;; (mapcar (function reshape-thm) (car th)) ;;; (reshape-thm (cdr th))))) ;;; (t ;;; (cond ((not(null(car th))) ;;; (mapc #'(lambda (x) (ptoken |.|)) (car th)) ;;; (ptoken | |))) ;;; line below replaces this one. ;;; ;;; (pbreak 1 2))) ;;; allow a break if many hyps [DES] 8jul92 ;;; (pstring %turnstile) ;;; (print-fm (prep-fm(cdr th)) t)))) (defun ml-print_thm (th) (cond (|%print_sexpr-flag| (sexpr-print (list 'thm (mapcar (function reshape-thm) (car th)) (reshape-thm (cdr th))))) (t (cond ((not(null(car th))) (pibegin 0) (mapc #'(lambda (x) (progn (ptoken |.|) (pbreak 0 0))) (car th)) (pend) (cond ((> (length(car th)) (/ %margin 5)) (pbreak 1 2)) (t (ptoken | |))))) (pstring %turnstile) (print-fm (prep-fm(cdr th)) t)))) ;;; Printing a theorem and all its assumptions (defun ml-print_all_thm (th) (pibegin 0) (cond ((not(null(car th))) (print-fm(prep-fm(caar th))t) (mapc #'(lambda (x) (ptoken |, |) (pbreak 0 0) (print-fm(prep-fm x)t)) (cdar th)) (ptoken | |) (pbreak 0 0))) (pstring %turnstile) (print-fm (prep-fm(cdr th)) t) (pend) ) (dml |print_all_thm| 1 ml-print_all_thm (|thm| -> |void|)) ;;; MJCG 10.12.90 for Centaur: ;;; Flag to switch on parsing of ML parse trees (setq |%print_parse_trees-flag| nil) ;;; MJCG 10.12.90 for Centaur: ;;; Add |%print_parse_trees-flag| to the list of known flags ;;; MJCG 7.4.91: declaration of %print_parse_trees-flag| ;;; moved to f-iox-stand.l ;;; MJCG 10.12.90 for Centaur: ;;; Holds the true parse tree (the one in %pt is sometimes wrong) (setq %pt1 '(mk-empty)) ;;; Print value, type of top-level expression ;;; HOL: modified not to print ": thm" after theorems ;;; MJCG 31/1/89 for HOL88 ;;; Added test for |%print_top_types-flag| ;;; MJCG 7/2/89 for HOL88 ;;; Added test for |%print_top_val-flag| ;;; MJCG 10.12.90 for Centaur: ML or S-expression form used ;;; depending on |%print_sexpr-flag| ;;; Printing of types suppressed if |%print_sexpr-flag| is nil ;;; (S-expression printing of values is handled by print functions ;;; invoked by prinml) ;;; If |%print_sexpr-flag| then ;;; sexpr-print is defined in f-writol.l (setq |%print_top_types-flag| t) (setq |%print_top_val-flag| t) (defun prvalty (x ty) (cond (|%print_top_val-flag| (prinml x ty nil) (cond ((not(eq (car ty) 'mk-thmtyp)) (pbreak 1 0) (cond ((and (not |%print_sexpr-flag|) |%print_top_types-flag|) (ptoken |: |) (printmty ty))))) (pnewline) (cond (|%print_parse_trees-flag| (terpri) (sexpr-print %pt1) (terpri)))))) ;;; MJCG 27/10/88 for HOL88 ;;; detect infixes and long combinations ;;; modified to invert interface-map (defun prep-comb (rator rand ty) (let ((prator (prep-tm rator))(prand (prep-tm rand))) (cond ((and (is-const prator) |%print_infix-flag| (eq (get (get-print-name(get-const-name prator)) 'olinfix) 'paired) (eq (term-class prand) 'pair)) (make-prep-term 'infixcomb (cons prator (get-term-list prand)) ty)) ((eq (term-class prator) 'listcomb) (prep-curr (get-term-list prator) prand ty)) ((make-prep-term 'listcomb (list prator prand) ty))) )) ;prep-comb ;;; MJCG 27/10/88 for HOL88 ;;; detect infixes and long combinations ;;; see if ((tm1 tm2 ...) y) is the curried infix "tm2 y" ;;; otherwise return (tm1 tm2 ... y) ;;; modified to invert interface-map ;;; MJCG 31/01/94 for HOL88.2.02 ;;; Modified to support infixed variables (defun prep-curr (tml y ty) (let ((tm1 (car tml)) (tm2 (cadr tml)) (tmtail (cddr tml))) (if (or (and (null tmtail) (is-const tm1) |%print_infix-flag| (eq (get (get-print-name(get-const-name tm1)) 'olinfix) 'curried)) (and (null tmtail) (is-var tm1) |%print_infix-flag| (memq (get-var-name tm1) hol-var-binops))) (make-prep-term 'infixcomb (list tm1 tm2 y) ty) (make-prep-term 'listcomb (append tml (list y)) ty) ))) ;prep-curr ;;; MJCG 7/2/89 for HOL88 ;;; MJCG 30/92/89 for HOL88, Ton Kalker: save |%print_lettypes-flag| ;;; Function to print currently defined types (defun prdeftypes () (prog (saved-flag) (setq saved-flag |%print_lettypes-flag|) (setq |%print_lettypes-flag| nil) (pbegin 1) (pbreak 0 1) (mapc (function (lambda (p) (cond ((atom (cdr p)) (pstring (car p)) (ptoken | -- an abstract type|) (pbreak 0 1)) (t (pstring (car p)) (ptoken | = |) (printmty (cdr p)) (pbreak 0 1))))) (reverse %deftypes)) (pend) (pnewline) (setq |%print_lettypes-flag| saved-flag))) (dml |print_defined_types| 0 prdeftypes (|void| -> |void|)) hol88-2.02.19940316/lisp/f-tml.l0000640000212700021270000010660405353322645014105 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-tml.l ;;; ;;; ;;; ;;; DESCRIPTION: Top level ML read-eval-print loop ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: tml (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V2.1 : begin and end renamed as ml-begin and ml-end ;;; ;;; ;;; ;;; V2.2 : errset and err replaced with tag and new-exit;;; ;;; top1, ctrlgfn no more used ;;; ;;; ;;; ;;; V2.3 : compiler added July 82 GH ;;; ;;; ;;; ;;; V3.1 : optimization of lisp code L. Paulson ;;; ;;; ;;; ;;; V3.2 : compatibility VAX-Unix/Multics ;;; ;;; ;;; ;;; V4.2 : message functions gone ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (special %char-buffer %parse-tree-buffer |%abort_when_fail-flag| %turnstile |%print_lib-flag| %prompt-string %libraries |%print_load-flag| |%compile_on_the_fly-flag| |%file_load_msg-flag| %lib-dir %pt1 |%print_parse_trees-flag| %search-path %help-search-path %library-search-path)) #+franz (declare (localf top%f istmlop isdefty isdecl istydecl okpass typechpt tranpt evalpr tmlloop extend-env setbindings updatevalues printresults printtime ml-begin ml-end compiloop parseml0)) ;;; Uses Manifests: eof [iox/din] ;;; nullty [typeml] ;;; nill [tran] ;;; Sets Manifests: initsection, initenv, nosecname ;;; Uses Globals: %f ;;; %emt, %temt [typeml] ;;; |%print_load-flag| [System load] ;;; ibase, base, *nopoint , %prompt-string [lisp/tml] ;;; Globals: %pt, %pt1, %ty, %pr, %val [in top1/okpass] ;;; %sections, %dump ;;; Specials: %p, %thisdec, %thistydec, tenv (eval-when (compile load eval) (defconstant initsection '%mustbeatom) (defconstant initenv (cons initsection nill)) (defconstant nosecname '||)) ; Value printed by begin/end (eval-when (load) (when initial%load ; Globals (setq global%env ()) (setq %f nil) (setq %sections ()) (setq %dump ()) (setq |%timing-flag| nil) (setq %outport nil) (setq |%print_parse_trees-flag| nil) (setq |%abort_when_fail-flag| t) (setq |%compile_on_the_fly-flag| nil))) ;;; Error and message functions ;;; Added by MJCG on 7/4/1987 (defun hol-err (x) (throw-from tmllooptag "System")) (defun lcferror (x) (let (#+franz (poport nil) #-franz (*standard-output* *terminal-io*)) (llterpri) (llprinc "Error in HOL system, please report it.") (llterpri) (llprinc (list "Diagnostic:" x)) (llterpri) #+franz (baktrace) (hol-err %f))) ;lcferror ;;; Top level of ml interpreter (defun top%f () (memq %f '(() load compile))) ;top%f (defun istmlop () (memq %head '(mk-begin mk-end))) ;istmlop (defun isdefty () (eq %head 'mk-deftype)) ;isdefty (defun isdecl () (memq %head '(mk-let mk-letref mk-letrec mk-abstype mk-absrectype))) ;isdecl (defun istydecl () (memq %head '(mk-type mk-rectype))) ;isdecl ;;; MJCG 10.12.90 for Centaur: ;;; The parse tree in %pt seems to get corrupted destructively ;;; So a copy of the original is retained in %pt1 (defun okpass (pass) (catch-throw okpass ; must be catch since throw may come from inside errset (let ((b (errortrap #'(lambda (errtok) "lisp error") (case pass (parse (catch-throw parse (setq %pt (parseml0)) (if |%print_parse_trees-flag| ; for Centaur! (setq %pt1 (copy-tree %pt))) ; for Centaur! (throw-from okpass nil))) (typecheck (catch-throw typecheck (setq %ty (typechpt)) (throw-from okpass nil))) (translation (catch-throw translation (setq %pr (tranpt)) (throw-from okpass nil))) (evaluation (catch-throw evaluation (setq %val (evalpr)) (throw-from okpass nil))) (evtmlop (catch-throw evaluation (setq %val (evtmlop %pt)) (throw-from okpass nil))) (t (lcferror (cons pass '(unknown pass)))))))) ;;; Fall through here if pass failed (llprinc (case pass (parse "parse") (typecheck "typecheck") (translation "translation") (evaluation "evaluation") (evtmlop "evaluation"))) (llprinc " failed ") (if b (llprinc b)) (llterpri) (cond ((memq %f '(load compile)) ;; Propagate failure if performing load or compile (putprop lastvalname () 'mlval) ;to prevent abscope type (putprop lastvalname nullty 'mltype) ;fix for automatic ending (throw-from loaderror nil)) (|%abort_when_fail-flag| (quit 1)) ; to abort when building (t (throw-from tmllooptag %f)))))) ;;; Redefined below to cope with ML generated declarations ;;; (defun parseml0 () (gnt) (parseml 0)) ;parsml0 (defun typechpt () (typecheck %pt)) ;typechpt (defun tranpt () (let ((%p ())) (tran %pt))) ;tranpt (defun evalpr () (mapc #'eval %compfns) ; perform the definitions ;; Compile the functions - unless the eval has compiled them already ;; No in-core compiler in franz #-franz (if (and %compfns |%compile_on_the_fly-flag|) (compile-functions-if-needed %compfns)) ;; Retain compatibility with old franz versions. Do proper thing for CL #+franz (funcall `(lambda (%e) ,%pr) nil) #-franz (funcall ;; may not attempt to compile already-compiled functions in ANSI ;; standard CL. Check added - JAC 19.06.92 (if (and (not (compiled-function-p %pr)) |%compile_on_the_fly-flag|) (compile nil %pr) %pr) nil)) ;;; MJCG 29/11/88 for HOL88 ;;; ML function for setting prompt string (setq %prompt-string '|#|) (defun ml-set_prompt (s) (prog1 %prompt-string (setq %prompt-string s))) (dml |set_prompt| 1 ml-set_prompt (|string| -> |string|)) ;;; MJCG 4/1/89 for HOL88 ;;; ML function for changing theorem printing character (|-) (setq %turnstile "|- ") (defun ml-set_turnstile (s) (prog1 %turnstile (setq %turnstile s))) (dml |set_turnstile| 1 ml-set_turnstile (|string| -> |string|)) ;;; MJCG 5/2/89 for HOL88 ;;; Function to load in hol-init.ml ;;; Sticks loadt`hol-init.ml` in the input buffer (defun load-hol-init () (let ((file (find-file "hol-init.ml"))) (if (probe-file file) (setq %parse-tree-buffer (list '(mk-appn (mk-var |loadt|) (mk-tokconst |hol-init|))))))) ;;; JVT 29/5/92 for HOL88 ;;; read-HOLPATH reads in the environment variable HOLPATH (if present) ;;; to get a new root directory for the system without recourse to hol-init ;;; or a rebuild. (defun read-HOLPATH () #+unix (let ((varble #+franz (getenv 'HOLPATH) #+kcl (system:getenv "HOLPATH") #+lucid (environment-variable "HOLPATH") #+allegro (system:getenv "HOLPATH"))) (cond ((or (eq varble '||) (null varble)) nil) (t (setq %hol-dir varble) (setq %lib-dir (concat varble "/Library")) (setq %search-path (list '|| '|~/| (concat varble "/theories/"))) (setq %library-search-path (list (concat varble "/Library/"))) (setq %help-search-path (list (concat varble "/help/ENTRIES/")))))) #-unix nil ) ;;; Top-level entry to ML ;;; Sets time stamp to allow the generation of symbols unique to this session ;;; Necessary to avoid conflict when loading ML code ;;; compiled in different sessions ;;; MJCG 29/11/88 for HOL88 ;;; Made prompt the global %prompt-string, rather than local hard-wired # ;;; MJCG 5/2/89 for HOL88 ;;; Added load-hol-init ;;; JVT 29/5/92 for HOL88 ;;; Added read-HOLPATH (defun tml () (let ((base 10) (ibase 10) (*nopoint t) (%timestamp (mod (clock) 10000))) (setq fin-ligne t) (init-io) (banner) (incf %symcount (mod %timestamp 100)) (read-HOLPATH) (load-hol-init) (catch-throw eof (tmlloop)) (finalize-tml))) ; before exiting from tml command loop ;;; Drop out of tml or a load back to tml - useful if you can't send eofs (defun ml-dropout () (throw-from eof nil)) (dml |dropout| 0 ml-dropout (|void| -> |void|)) (dml |quit| 0 quit (|void| -> |void|)) ; quit (defun tmlloop () ; Also used by load (while t (ml-read-eval-print))) (defun ml-read-eval-print () (errortrap #'(lambda (errtok) errtok) (catch-throw tmllooptag (and |%print_load-flag| (top%f) (llterpri)) (let ((%thisdec ()) (%thistydec ())) (initlean) (okpass 'parse) (setq %head (car %pt)) (if (istmlop) (okpass 'evtmlop) (progn (okpass 'typecheck) (okpass 'translation) (let ((init-time (runtime10th)) (init-thms %thm-count)) (okpass 'evaluation) (let ((final-time (runtime10th)) (final-thms %thm-count)) (updatetypes) ;Uses %thisdec, %thistydec [typeml] (updatevalues) (printresults) (printtime final-time init-time final-thms init-thms))) )))))) ;tmlloop ;;; Insert new (mlname . lispname) pairs onto an alist ;;; For extending global environment (defun extend-env (bvs lbpat env) (if (atom bvs) (if (eq bvs '%con) env (cons (cons bvs lbpat) env)) (extend-env (cdr bvs) (cdr lbpat) (extend-env (car bvs) (car lbpat) env)))) ;extend-env ;;; Execute set's to maintain top-level environment (defun setbindings (newlb val) (if (atom newlb) (ifn (eq newlb '%con) (set newlb val)) (progn (setbindings (car newlb) (car val)) (setbindings (cdr newlb) (cdr val))))) ;setbindings ;;; Enter bindings in environment and store values in their Lisp atoms ;;; MJCG 9 November 1992. ;;; Added check to suppress binding of "it" if it has been let-bound. (defun updatevalues () (cond ((isdefty)) ((isdecl) (setq global%env (extend-env (car %val) new%%lb global%env)) (setbindings new%%lb (cdr %val))) ((not(get-lisp-binding lastvalname)) (putprop lastvalname %val 'mlval) (putprop lastvalname %ty 'mltype)))) ;updatevalues ;;; MJCG 11 May 1992. Eliminated third argument (ty) of prlet. ;;; This fixes a bug discovered by JG. ;;; prlet is defined in f-writml.l. (defun printresults () (cond ((not |%print_load-flag|) (unless %outport (llprinc '|.|))) ((isdefty) (prdefty %thistydec)) ((istydecl) (prconstrs (cdr %thisdec))) ((isdecl) (prlet (car %val) (cdr %val))) (t (prvalty %val %ty)))) ;printresults ;;; Print runtime and GC time if |%timing-flag| (defun printtime (final-times init-times final-thms init-thms) (when |%print_load-flag| (let ((runtime (- (car final-times) (car init-times))) (gctime (- (cdr final-times) (cdr init-times)))) (let ((seconds (truncate runtime 10))) (when |%timing-flag| (llprinc "Run time: ") (llprinc seconds) (llprinc ".") (llprinc (- runtime (* seconds 10))) (llprinc "s") (llterpri))) (ifn (zerop gctime) (let ((seconds (truncate gctime 10))) (when |%timing-flag| (llprinc "Garbage collection time: ") (llprinc seconds) (llprinc ".") (llprinc (- gctime (* seconds 10))) (llprinc "s") (llterpri)))) (let ((thms (- final-thms init-thms))) (cond ((and |%timing-flag| (not (zerop thms))) (llprinc "Intermediate theorems generated: ") (llprinc thms) (llterpri))))))) ; printtime (defun evtmlop (pt) (case (car pt) (mk-begin (ml-begin (if (cdr pt) (cadr pt) nosecname))) (mk-end (ml-end (cond ((null (cdr pt)) (if %dump (car %dump) (msg-failwith '|end| " not in a section"))) ((assoc-equal (cadr pt) %dump)) (t (msg-failwith '|end| "no section " (cadr pt)))))) (t (lcferror (cons (car pt) '(not a tmlop)))))) ;evtmlop (defun ml-begin (tok) (push (list tok %sections global%env %emt %temt %dump) %dump) (setq %sections t) (ifn %outport (when |%print_load-flag| (llprinc '|Section |) (llprinc tok) (llprinc '| begun|) (llterpri)))) ;ml-begin (defun ml-end (x) (let ((tok (car x)) (new-sections (cadr x)) (new-global-env (caddr x)) (new-emt (cadddr x)) (new-temt (cadddr (cdr x))) (new-dump (cadddr (cddr x))) (tenv ())) (setq tenv new-temt) ; for absscopechk (unless (catch-throw typecheck (typescopechk (get lastvalname 'mltype))) (failwith '|end|)) ; prevents result of section of local type (setq %sections new-sections) (setq global%env new-global-env) (setq %emt new-emt) (setq %temt new-temt) (setq %dump new-dump) (ifn %outport (when |%print_load-flag| (llprinc '|Section |) (llprinc tok) (llprinc '| ended|) (llterpri))) )) ;ml-end ;;; MJCG 31/10/88 for HOL88 ;;; Test whether a file name ends in `.ml` (defun ends-in-ml (tok) (let ((l (nreverse (exploden tok)))) (and (> (length l) 2) (= (car l) #/l) (= (cadr l) #/m) (= (caddr l) #/.)))) ;;; Load one ml file. If there exists a compiled version, it will load ;;; it rather than the source version. ;;; Caution: even if the source is more recent. ;;; ;;; MJCG 31/10/88 for HOL88 ;;; (fileexists '|m*| tok) case added ;;; find-file wrapped around fileof ;;; code to support loadt`foo.ml` added ;;; the resulting definition is inefficient, but disturbs the original ;;; code as little as possible (may optimise later) ;;; MJCG 10/2/90 for HOL88.1.12 ;;; Test on |%file_load_msg-flag| added. (setq |%file_load_msg-flag| t) ;;; Old version. Replaced on 6 April 1991 by ;;; Mark van der Voort's bugfix to handle .s in file names ;;; (See below) ;;; (defun ml-load (tok |%print_load-flag|) ;;; (let ;;; ((initial-nesting (length inputstack)) (%f 'load) (%dump ())) ;;; (catch-throw eof ;;; (catch-throw loaderror ; catch failures inside load ;;; (cond ;;; ((not (filetokp 'ml tok)) ;;; (msg-failwith '|load| tok " cannot be file name")) ;;; ((and (not (ends-in-ml tok)) ;;; (eq (file-ext (fileexists '|m*| tok)) '|o|)) ;;; (throw-from eof ;;; (load (find-file (fileof 'code tok))))) ;;; ((or (fileexists 'ml tok) ;;; (and (ends-in-ml tok) ;;; (fileexists 'ml (file-name tok)))) ;;; (let ((%pt ()) (%ty ()) (%pr ()) (%val ()) (%head ())) ;;; (infilepush (find-file (fileof 'ml (file-name tok)))) ;;; (tmlloop))) ;;; (t ;;; (msg-failwith '|load| tok " ml file not found")))) ;;; ;; an error occurred (before eof encountered) during file load ;;; (if (> (length inputstack) initial-nesting) (infilepop)) ;;; (if %dump (ml-end (car (last %dump)))) ;close dangling sections ;;; (msg-failwith '|load| tok)) ;;; ;; reached end of file without errors ;;; (if %dump (ml-end (car (last %dump)))) ;close dangling sections ;;; (if (> (length inputstack) initial-nesting) (infilepop)) ;;; (when (and |%print_load-flag| |%file_load_msg-flag|) ;;; (llterpri) (llprinc "File ") (llprinc tok) ;;; (llprinc " loaded") (llterpri)))) ;ml-load ;;; Following bugfix installed by MJCG for HOL88.1.13 (6 April 1991) ;;; Revised code supplied by Mark van der Voort. ;;; MvdV 04/02/91 for HOL88.1.11 ;;; whenever a extensionless filename is given ;;; at the end of a path containing dots ;;; file-name will destruct this path instead of ;;; delivering the whole file-name ;;; ;;; So the last two cases in the cond have been split (defun ml-load (tok |%print_load-flag|) (let ((initial-nesting (length inputstack)) (%f 'load) (%dump ())) (catch-throw eof (catch-throw loaderror ; catch failures inside load (cond ((not (filetokp 'ml tok)) (msg-failwith '|load| tok " cannot be file name")) ((and (not (ends-in-ml tok)) (eq (file-ext (fileexists '|m*| tok)) '|o|)) (throw-from eof ;; tidied up conditional code and added :print nil and ;; :verbose nil to load - JAC 19.06.92 #+lucid (let ((*load-binary-pathname-types* (cons "o" *load-binary-pathname-types*))) (fasload (find-file (fileof 'code tok)))) #-lucid #-franz (load (find-file (fileof 'code tok)) :print nil :verbose nil) #+franz (load (find-file (fileof 'code tok))) )) ((fileexists 'ml tok) (let ((%pt ()) (%ty ()) (%pr ()) (%val ()) (%head ())) (infilepush (find-file (fileof 'ml tok))) ;;; ^place of bug (tmlloop))) ((and (ends-in-ml tok) (fileexists 'ml (file-name tok))) (let ((%pt ()) (%ty ()) (%pr ()) (%val ()) (%head ())) (infilepush (find-file (fileof 'ml (file-name tok)))) (tmlloop))) (t (msg-failwith '|load| tok " ml file not found")))) ;; an error occurred (before eof encountered) during file load (if (> (length inputstack) initial-nesting) (infilepop)) (if %dump (ml-end (car (last %dump)))) ;close dangling sections (msg-failwith '|load| tok)) ;; reached end of file without errors (if %dump (ml-end (car (last %dump)))) ;close dangling sections (if (> (length inputstack) initial-nesting) (infilepop)) (when |%print_load-flag| (llterpri) (llprinc "File ") (llprinc tok) (llprinc " loaded") (llterpri)))) ;ml-load (dml |load| 2 ml-load ((|string| |#| |bool|) -> |void|)) ;load ;;; Boolean argument restored V5-1 GH. ;;; Changed for HOL88 by MJCG to return old value (defun ml-timer (flag) (prog1 |%timing-flag| (setq |%timing-flag| flag))) ;ml-timer (dml |timer| 1 ml-timer (|bool| -> |bool|)) ;timer (defun ml-lisp (tok) (errortrap #'(lambda (errtok) (msg-failwith '|lisp| errtok)) (eval #+franz (readlist (explodec tok)) #-franz (read-from-string (string tok))))) ;ml-lisp (dml |lisp| 1 ml-lisp (|string| -> |void|)) ;lisp ;;; Compiler (dml |compile| 2 ml-compile ((|string| |#| |bool|) -> |void|)) ;compile ;;; MJCG 31/10/88 for HOL88 ;;; find-file wrapped around fileof ;;; name-ext added and following let ;;; MJCG 10/2/90 for HOL88.1.12 ;;; Test on |%file_load_msg-flag| added. (defun ml-compile (tok |%print_load-flag|) (let ((%f 'compile) (%dump ()) ($gcprint ()) (name-ext (dest-file-name (find-file (fileof 'ml tok))))) (let ((filename (fileof 'lisp (car name-ext)))) (catch-throw eof (catch-throw loaderror (cond ((not (filetokp 'ml tok)) (msg-failwith '|compile| tok " cannot be file name")) ((fileexists 'ml tok) (let ((%pt ()) (%ty ()) (%pr ()) (%val ()) (%head ())) (infilepush (find-file (fileof 'ml tok))) (setq %outport (outfile filename)) ;; Franz compiler cannot know about any specials #+franz (hol-print-file '(declare (special %vtyl))) (compiloop))) (t (msg-failwith '|compile| tok " ml file not found")))) ;; an error occurred (before eof happened) during compilation (infilepop) (close %outport) (setq %outport nil) (when %dump (ml-end (car (last %dump)))) ;close dangling sections (msg-failwith '|compile| tok)) ;; no error occurred (infilepop) (close %outport) (setq %outport nil) (when %dump (ml-end (car (last %dump)))) ;close dangling sections (compile-lisp filename) ;call Lisp compiler (when (and |%print_load-flag| |%file_load_msg-flag|) (llterpri) (llprinc "File ") (llprinc tok) (llprinc " compiled") (llterpri))))) ;ml-compile ;;; lisp function compiloop: ;;; llprint at line labelled "***" changed to hol-print-file [TFM 90.06.01] (defun compiloop () (while t (let ((%thisdec ()) (%thistydec ())) (and |%print_load-flag| (top%f) (llterpri)) (initlean) (okpass 'parse) (setq %head (car %pt)) (cond ((istmlop) (okpass 'evtmlop) (hol-print-file `(evtmlop ',%pt))) ; *** ;; this ugly special case should disappear soon (t (okpass 'typecheck) (okpass 'translation) (okpass 'evaluation) (updatetypes) (updatevalues) (printresults) (mapc #'(lambda (form) (hol-print-file `(eval-when (load) ,form))) %compfns) (hol-print-file `(eval-when (load) (execute ',%ty ',%thisdec ',%thistydec ',%head ',new%%lb ;; Retain compatibility with old franz versions. ;; Do proper thing for CL #+franz ',%pr #-franz (function ,%pr)))) ))))) ;compiloop ;;; Evaluate an expression and also write it onto %outport ;;; For example, the putprops used to store abstract type information (defun eval-remember (x) (when %outport (hol-print-file `(eval-when (load) ,x))) (eval x)) ;eval-remember ;;; Execute a compiled ML statement (defun execute (%ty %thisdec %thistydec %head new%%lb %pr) (and |%print_load-flag| (top%f) (llterpri)) (let ((init-time (runtime10th)) (init-thms %thm-count)) (okpass 'evaluation) (let ((final-time (runtime10th)) (final-thms %thm-count)) (updatetypes) (updatevalues) (printresults) (printtime final-time init-time final-thms init-thms)))) ;execute ;;; NEW Saves a core image of a session ;;; ;;; caution: this should be invoked only from top-level of ml, and never from ;;; load/mlin (otherwise %f = load, and ml errors are not trapped properly). ;;; ml-save is system-dependent (dml |save| 1 ml-save (|string| -> |void|)) ;;; The code that follows supports ML generated top-level declarations ;;; of the form: let x = f[`t1`;...;`tn`]. This works by maintaining ;;; pending declarations in the list %parse-tree-buffer. The top-level read ;;; loop checks to see if anything is in the buffer before reading from ;;; the input stream (see parsml0 below). ;;; (setq %parse-tree-buffer nil) ;;; Now set in F-parsml.l (MJCG 5/2/89 for HOL88) ;;; The function parsml0 was previously defined by ;;; (defun parseml0 () (gnt) (parseml 0)) ;;; MJCG 5/2/89 for HOL88 ;;; Modified to return the front of %parse-tree-buffer (defun parseml0 () (prog (pt (*standard-input* *standard-input*)) (if %parse-tree-buffer (go exit)) (gnt) (setq pt (parseml 0)) (setq %parse-tree-buffer (append %parse-tree-buffer (list pt))) exit (return (prog1 (car %parse-tree-buffer) (setq %parse-tree-buffer (cdr %parse-tree-buffer)))))) ;;; Make an object corresponding to the parse tree for `let mlname = fn tokl'. (defun mk-let (mlname fn tokl) `(mk-let ((mk-var ,mlname) mk-appn (mk-var ,fn) ,(cons 'mk-list (mapcar (function (lambda (x) (list 'mk-tokconst x))) tokl))))) ;;; and put it on the end of %parse-tree-buffer. ;;; The ML function let_after can be used to put it on at the beginning. (dml |let_after| 3 ml-let_after ((|tok| |#| (|tok| |#| (|tok| |list|))) -> |void|)) (defun ml-let_after (mlname fn tokl) (prog (ob) (setq ob (mk-let mlname fn tokl)) (setq %parse-tree-buffer (append %parse-tree-buffer (list ob))) (return '(mk-empty)))) ;;; ml-let_before and let_before are like ml-let_after and let_after, except that ;;; the generated parse tree is put on the front of %parse-tree-buffer (defun ml-let_before (mlname fn tokl) (prog (ob) (setq ob (mk-let mlname fn tokl)) (setq %parse-tree-buffer (cons ob %parse-tree-buffer)) (return '(mk-empty)))) (dml |let_before| 3 ml-let_before ((|tok| |#| (|tok| |#| (|tok| |list|))) -> |void|)) ;;; MJCG 5/2/89 for HOL88 ;;; (ml-autoload s fn (s1 ... sn) primes a string s so that if it is parsed ;;; as a variable (see the function mk-var-fun in F-parser.l) then the ;;; autoload action fn[s1; ... ;sn] is put into %parse-tree-buffer ;;; The hol-autoload property has the form (eval . ) (defun ml-autoload (name fn args) (putprop name `(eval . (mk-appn (mk-var ,fn) ,(cons 'mk-list (mapcar (function (lambda (x) (list 'mk-tokconst x))) args)))) 'hol-autoload)) (dml |autoload| 3 ml-autoload ((|tok| |#| (|tok| |#| (|tok| |list|))) -> |void|)) ;;; MJCG 5/2/88 for HOL88 ;;; Functions to remove autoload actions (defun ml-undo_autoload (name) (not (null (remprop name 'hol-autoload)))) (dml |undo_autoload| 1 ml-undo_autoload (|string| -> |bool|)) ;;; MJCG 6/2/89 for HOL88 ;;; Code for autoloading axioms, definitions and theorems. ;;; autoload takes a dotted pair whose car is ;;; a sort ('eval, 'axiom, 'definition or 'theorem) ;;; and whose cdr is either an ML parse tree (in the case of 'eval) ;;; or a theory-name pair in the other three cases. ;;; It then returns the parse tree to be put at the front ;;; of %parse-tree-buffer. ;;; In the 'eval case this tree is just the cdr of the argument; ;;; in the other cases it is constructed using mk-let. (defun autoload (p) (if (eq (car p) 'eval) (cdr p) (let ((sort (car p)) (thy (cadr p)) (name (cddr p))) (case sort (|axiom| (mk-let name '|axiom_msg_lfn| (list thy name))) (|definition| (mk-let name '|definition_msg_lfn| (list thy name))) (|theorem| (mk-let name '|theorem_msg_lfn| (list thy name))) (t (failwith '|autoload|)))))) ;;; MJCG 6/2/89 for HOL88 ;;; Function to set up hol-autoload properties for theory retrieval (defun ml-autoload_theory (sort thy name) (cond ((memq sort '(|axiom| |definition| |theorem|)) (putprop name (cons sort (cons thy name)) 'hol-autoload) nil) (t (failwith (concat "autoload: " sort))))) (dml |autoload_theory| 3 ml-autoload_theory ((|string| |#| (|string| |#| |string|)) -> |void|)) ;;; The code that follows enables ML functions to inject sequences of ascii ;;; characters onto the front of the input character stream. ;;; It works by concatenating onto the front of %char-buffer. (defun inject-input (l) (setq %char-buffer (append l %char-buffer))) (dml |inject_input| 1 inject-input ((|int| |list|) -> |void|)) ;;; MJCG 2/3/89 for HOL88.1.01 ;;; Function for loading a library ;;; %libraries holds the libraries already loaded (setq %libraries nil) ;;; ml-load-library takes a print flag [no longer, see below] ;;; and a library name. ;;; MJCG 23/3/89 for HOL88.1.02 ;;; Instead of an explicit print flag argument, the printing ;;; during library loading is now controlled by the ;;; ML setable flag |%print_lib-flag|. ;;; load_library now sets up the search path. ;;; (defun ml-load_library (tok) ;;; (cond ((memq tok %libraries) ;;; (princ (concat tok " already loaded")) ;;; (terpri)) ;;; (t (princ (concat "Loading library `" tok "` ...")) ;;; (terpri) ;;; (let ;;; ((dir-sep ;;; ;; guess a reasonable directory separator char ;;; (if (member #// (exploden %lib-dir)) "/" ":"))) ;;; (ml-load ;;; (catenate %lib-dir dir-sep tok dir-sep tok) ;;; |%print_lib-flag|)) ;;; (setq %libraries (cons tok %libraries)) ;;; (terpri) ;;; (princ (concat "Library `" tok "` loaded.")) ;;; (terpri) ;;; nil))) ;;; New implementation of load_library for version 2.01: ;;; ;;; * finds library using %library-search-path ;;; * multi-section libraries: ;;; - load_library `foo` loads /foo/foo.ml ;;; - load_library `foo:bar` loads /foo/bar.ml ;;; ;;; Auxiliary functions: ;;; ;;; * get-path : return the library pathname ;;; * mk-fname : make load file name ;;; * look-for-lib : search for library loadfile. ;;; ;;; [TFM 91.11.27] (defun get-path (path sep) (let ((snum (car (exploden sep)))) (prog (chars found) (setq chars (reverse (exploden path))) (setq found nil) loop (if (null chars) (return "")) (if found (cond ((= (car chars) snum) (return (imploden (reverse (cdr chars))))) (t (setq chars (cdr chars)) (go loop))) (cond ((= (car chars) snum) (setq found t) (setq chars (cdr chars)) (go loop)) (t (setq chars (cdr chars)) (go loop))))))) (defun mk-fname (tok dir-sep) (prog (chars ext) (setq chars (reverse (exploden tok))) (setq ext nil) loop (if (null chars) (return(catenate tok dir-sep tok))) (cond ((not (= (car chars) colon)) (setq ext (cons (car chars) ext)) (setq chars (cdr chars)) (go loop)) (t (return (catenate (imploden (reverse (cdr chars))) dir-sep (imploden ext))))))) (defun look-for-lib (name tok) (let ((file (find-file (if (ends-in-ml name) name (catenate name '|.m*|))))) (if (probe-file file) file (failwith (catenate '|load_library: | tok '| not found|))))) (defun ml-load_library (tok) (cond ((memq tok %libraries) (princ (concat tok " already loaded")) (terpri)) (t (let ((dir-sep ;; guess a reasonable directory separator char ;; JAC 19.02.92 for pc - was ;; (if (member #// (exploden %lib-dir)) "/" ":") #+(or franz unix) "/" #+pc "\\" #-(or franz unix pc) ":")) (let ((loadfile (mk-fname tok dir-sep))) (let ((pathfile (let ((%search-path %library-search-path)) (look-for-lib loadfile tok)))) (princ (concat "Loading library " tok " ...")) (terpri) (let ((%lib-dir (get-path pathfile dir-sep))) (ml-load (catenate %lib-dir dir-sep loadfile) |%print_lib-flag|))))) (setq %libraries (cons tok %libraries)) (terpri) (princ (concat "Library " tok " loaded.")) (terpri) nil))) (dml |load_library| 1 ml-load_library (|string| -> |void|)) (defun ml-libraries () %libraries) (dml |libraries| 0 ml-libraries (|void| -> (|string| |list|))) ;;; Go from ML to Lisp - was previously in Makefile (dml |lsp| 0 ml-break (|void| -> |void|)) ;;; Reset %hol-dir and %lib-dir from ML (used in install) ;;; no longer used ;;; (defun ml-set_hol_lib_dir (s) ;;; (setq %hol-dir s) ;;; (setq %lib-dir (concat s "/Library")) ;;; nil) ;;;(dml |set_hol_lib_dir| 1 ml-set_hol_lib_dir (|string| -> |void|)) ;;; Return the library pathname. [TFM 90.12.01] (defun ml-library_pathname () %lib-dir) (dml |library_pathname| 0 ml-library_pathname (|void| -> |string|)) ;;; Return the pathname to the HOL system directory. [TFM 91.05.17] (defun ml-hol_pathname () %hol-dir) (dml |hol_pathname| 0 ml-hol_pathname (|void| -> |string|)) hol88-2.02.19940316/lisp/parslist.l0000640000212700021270000002173605335764115014733 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: parslist.l ;;; ;;; ;;; ;;; DESCRIPTION: Parsing of OL lists and sets ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l genmacs.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: %hol-list-depth added by MJCG on 9/2/93 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (include "lisp/genmacs") (special lbrace-sym rbrace-sym pair-tok %set-depth %print_set-flag %empty-set %finite-set-constructor %set-abstraction-constructor)) #+franz (declare (localf mk-ol-list mk-finite-set get-frees-in-pt mk-var-tuple-pt mk-tuple-pt)) (eval-when (load) (let ((lang1 'ol1)(lang2 'ol2)(langlp 'ollp)) (unop lbrkt-sym '(ol-list-rtn)) (putprop scolon-sym 20 'ollp) (putprop rbrkt-sym 0 'ollp) )) ;;; The current empty set and finite set constructor are held in the globals ;;; %empty-set, %finite-set-constructor. ;;; The current set abstraction constructor is held in the global ;;; %set-abstraction-constructor (setq %empty-set nil) (setq %finite-set-constructor nil) (setq %set-abstraction-constructor nil) ;;; Added by MJCG 27/6/92 ;;; Added by MJCG 9/2/93 to fix a bug (see below) ;;; Depth of nesting inside "[...]" (setq %hol-list-depth 0) (defun hol-scolonsetup () (putprop scolon-sym 20 'ollp) (setq %hol-list-depth 0)) ;;; MJCG 27/6/1992 ;;; Bug introduced on 31/5/92 fixed ;;; MJCG 9/2/93 ;;; Bug with nexted "[...]" fixed using %hol-list-depth hack (defun ol-list-rtn () (prog (l) (incf %hol-list-depth) (putprop scolon-sym 0 'ollp) loop (cond ((eq token rbrkt-sym) (gnt) (decf %hol-list-depth) (if (zerop %hol-list-depth) (putprop scolon-sym 20 'ollp)) (return(mk-ol-list(reverse l))))) (setq l (cons (parse-level 10) l)) (cond ((eq token rbrkt-sym) (go loop)) (t (check scolon-sym nil '|bad list separator|) (go loop))))) (defun mk-ol-list (l) (cond ((null l) '(MK=CONST NIL)) (t `(MK=COMB (MK=COMB (MK=CONST CONS) ,(car l)) ,(mk-ol-list (cdr l)))))) ;;; ================ Code for parsing set abstractions ================ ;;; ---------------- MJCG, August 2, 1990 for HOL.1.12 ---------------- (setq lbrace-sym '|{|) (setq rbrace-sym '|}|) ;;; Make } a terminator (putprop rbrace-sym 0 'ollp) ;;; Restore normal precedence of comma (defun hol-commasetup () (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp)) (binop comma-sym 95 (term-rtn pair-tok 'arg1 '(parse-level 90))))) ;;; ================= Finite set notation ================= (defun ml-define_finite_set_syntax (emty con) (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp) (set-prop (get lbrace-sym 'ol1))) (if (not(ml-is_constant emty)) (failwith (concat emty " is not a constant"))) (if (not(ml-is_constant con)) (failwith (concat con " is not a constant"))) (setq %empty-set emty) (setq %finite-set-constructor con) (setq |%print_set-flag| t) (unop lbrace-sym `(ol-set-rtn)))) (dml |define_finite_set_syntax| 2 ml-define_finite_set_syntax ((|string| |#| |string|) |->| |void|)) ;;; ================= Set abstraction notation ================= (defun ml-define_set_abstraction_syntax (con) (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp) (set-prop (get lbrace-sym 'ol1))) (if (not(ml-is_constant con)) (failwith (concat con " is not a constant"))) (setq %set-abstraction-constructor con) (setq |%print_set-flag| t) (unop lbrace-sym `(ol-set-rtn)))) (dml |define_set_abstraction_syntax| 1 ml-define_set_abstraction_syntax (|string| |->| |void|)) ;;; ================ Parsing code ================ ;;; ("t1" "t2" ... "tn") --> "t1,t2,...,tn" (defun mk-tuple-pt (l) (if (null(cdr l)) (car l) `(MK=COMB (MK=COMB (MK=CONST |,|) ,(car l)) ,(mk-tuple-pt (cdr l))))) (defun mk-finite-set (l emty con) (cond ((null l) `(MK=CONST ,emty)) (t `(MK=COMB (MK=COMB (MK=CONST ,con) ,(car l)) ,(mk-finite-set (cdr l) emty con))))) ;;; Compute the names of free variables in a parse tree that are not in vars (defun get-frees-in-pt (vars pt) (cond ((atom pt) nil) ((eq (car pt) '|MK=ABS|) (get-frees-in-pt (cons (cadadr pt) vars) (caddr pt))) ((and (eq (car pt) '|MK=VAR|) (not (memq (cadr pt) vars))) (list (cadr pt))) (t (union (get-frees-in-pt vars (car pt)) (get-frees-in-pt vars (cdr pt)))))) ;;; (x1 x2 ... xn) --> parse tree of "x1,x2,...,xn" ;;; MJCG 12/11/90: redundant code commented out (defun mk-var-tuple-pt (vars) (cond ;;; ((null vars) ;;; This should never happen! ;;; '(MK=TYPED (MK=VAR |%dummy|) (MK=VARTYPE |*|))) ((null (cdr vars)) `(MK=VAR ,(car vars))) (t `(MK=COMB (MK=COMB (MK=CONST |,|) (MK=VAR ,(car vars))) ,(mk-var-tuple-pt (cdr vars)))))) (defun redefine-comma () (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp)) (binop comma-sym 20 (term-rtn pair-tok 'arg1 '(parse-level 15))))) ;;; Added by MJCG 30.10.90 (defun intersect (x y) (cond ((null x) nil) ((member (car x) y) (cons (car x) (intersect (cdr x) y))) (t (intersect (cdr x) y)))) ;;; MJCG 23.3.91 (setq %set-depth 0) ;;; Binding of intersection of variables added by MJCG 30.10.90 ;;; Check that intersection is non-empty added by MJCG 12.11.90 ;;; (This makes some code in mk-var-tuple-pt redundant) ;;; MJCG 28.1.91 extra pred argument to build-lam-struc ;;; MJCG 28.3.91 code to handle precedence of commas in nested sets added (defun ol-set-rtn () (prog (tms tm body) (incf %set-depth) (redefine-comma) loop (cond ((eq token rbrace-sym) (gnt) (decf %set-depth) (if (eq %set-depth 0) (hol-commasetup)) (if (or (null %empty-set) (null %finite-set-constructor)) (parse-failed "finite set constructors not specified")) (return (mk-finite-set (reverse tms) %empty-set %finite-set-constructor)))) (setq tms (cons (parse-level 30) tms)) (cond ((eq token rbrace-sym) (go loop)) ((eq token comma-sym) (gnt) (go loop))) (check else-sym nil '|missing comma or \| in set notation|) (hol-commasetup) (if (null %set-abstraction-constructor) (parse-failed "set abstraction constructor not specified")) (setq tm (mk-tuple-pt(reverse tms))) (setq body (parse-level 10)) (check rbrace-sym nil `|missing } in set abstraction|) (setq tms (intersect (get-frees-in-pt nil tm) (get-frees-in-pt nil body))) (cond ((null tms) (parse-failed "no variable is bound by the set abstraction")) (t (decf %set-depth) (if (> %set-depth 0) (redefine-comma)) (return (build-lam-struc %set-abstraction-constructor nil (mk-var-tuple-pt tms) `(MK=COMB (MK=COMB (MK=CONST |,|) ,tm) ,body))))))) hol88-2.02.19940316/lisp/akcl.l0000640000212700021270000000356705374473335014012 0ustar cammcamm;----------------------------------------------------------------------------; ; ; ; AKCL initialisation for speed. ; ; ; ; FILE: hol-init.ml ; ; ; ; AUTHOR: John Van Tassel ; ; ADDRESS: University of Cambridge Computer Laboratory ; ; New Museums Site ; ; Pembroke Street ; ; Cambridge CB2 3QG ; ; ENGLAND ; ; E-MAIL: jvt@cl.cam.ac.uk ; ; TEL. +44 223 334729 ; ; ; ;----------------------------------------------------------------------------; #+akcl #+sun (progn () (allocate 'cons 900) (allocate 'string 100) (system:allocate-relocatable-pages 100) (system:set-hole-size 2048)) #+mips (progn () (allocate 'cons 2048) (allocate 'string 100) (system:allocate-relocatable-pages 100) (system:set-hole-size 2048)) #+hp9000-800 (progn () (allocate 'cons 2024) (allocate 'string 100) (system:allocate-relocatable-pages 100) (system:set-hole-size 2048)) #-(or sun mips hp9000-800) () #-akcl () hol88-2.02.19940316/lisp/f-inst.l0000640000212700021270000004323205521424657014266 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-inst.l ;;; ;;; ;;; ;;; DESCRIPTION: Object language type instantiation ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: ol3 (lisp 1.6) part of Edinburgh LCF ;;; ;;; by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; Hol version 2.02: Bug in INST_TYPE fixed : [MJCG 25.01.94] ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Sharing relationships in types must be detected -- dumb algorithms that ;;; expand type DAGs into trees will consume exponential time and space! ;;; This particularly holds for algorithms that traverse all types of a term, ;;; for note the duplication of types in combinations: ;;; ((F : ty1 -> ty2) (X : ty1)) : ty2 ;;; The instantiation of terms and formulas is now implemented in Lisp, ;;; as the ML versions were exponential. (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (special %clash-danger-vars)) #+franz (declare (localf tyvars-type instin-type instin-var rename-var forget-var typel-in-tm strip-primes-aux strip-primes)) ;;; ********************************************* (dml |type_in_type| 2 ml-type_in_type ((|type| |#| |type|) -> |bool|)) (dml |type_in| 2 ml-type_in_term ((|type| |#| |term|) -> |bool|)) ;;; No formulas in HOL: paired_type_in_form deleted [TFM 90.04.19] ;;; (dml |paired_type_in_form| 2 ml-type_in_form ((|type| |#| |form|) -> |bool|)) (defun ml-type_in_type (%ty ty) (let ((%oldtys nil)) (type-in-type ty))) ;;; does %ty occur anywhere inside ty? ;;; record compound types already seen to avoid re-traversal (defun type-in-type (ty) (cond ((memq ty %oldtys) nil) ((equal ty %ty) t) ((not (is-vartype ty)) (prog1 (exists 'type-in-type (cdr (ml-dest_type ty))) (push ty %oldtys))) )) ;type-in-type ;;; No formulas in HOL: deleted [TFM 90.04.19] ;;;(defun ml-type_in_form (%ty ob) ;;; (let ((%oldtys nil)) (type-in-fm ob))) (defun ml-type_in_term (%ty ob) (let ((%oldtys nil)) (type-in-tm ob))) ;;; does %ty appear in the formula? (defun type-in-fm (fm) (case (form-class fm) ((conj disj imp) ; iff deleted [TFM 90.01.20] (or (type-in-fm (get-left-form fm)) (type-in-fm (get-right-form fm)))) ((forall exists) (or (type-in-tm (get-quant-var fm)) (type-in-fm (get-quant-body fm)))) (pred (type-in-tm (get-pred-arg fm))) (t (lcferror (cons fm '|type-in-fm|)))) ) ; type-in-fm ;;; does %ty appear in the term? (defun type-in-tm (tm) (case (term-class tm) ((var const) (type-in-type (get-type tm))) (abs (or (type-in-tm (get-abs-var tm)) (type-in-tm (get-abs-body tm)))) (comb (or (type-in-tm (get-rator tm)) (type-in-tm (get-rand tm)))) (t (lcferror '|type-in-tm|))) ) ; type-in-tm ;;; ********************************************* (dml |type_tyvars| 1 ml-type-tyvars (|type| -> (|type| |list|))) ;;; term_tyvars renamed to be tyvars [TFM 90.06.04] ;;; (dml |term_tyvars| 1 ml-term_tyvars (|term| -> (|type| |list|))) (dml |tyvars| 1 ml-term_tyvars (|term| -> (|type| |list|))) ;;; Deleted: formulas not used in HOL [TFM 90.06.27] ;;; (dml |form_tyvars| 1 ml-form_tyvars (|form| -> (|type| |list|))) (defun ml-type-tyvars (ty) (let ((%tyvl nil) (%oldtys nil)) (tyvars-type ty) (nreverse %tyvl))) ; ml-type-tyvars ;;; find all type variables in a type ;;; ;;; [DES] 17feb92 member-equal for memq; again exponentiality. ;;; Looks as if my big tuples have gone over the limit where things ;;; start showing up. Found another problem as equivalent types ;;; are not necessarily "eql". This shows itself up in ;;; tyvars-type. Basically %oldtys was getting over 4000 things ;;; stuck on it. When using member-equal only 170 were there ;;; (i.e. 3800-odd members were equiavalent types with a ;;; different top level cons cell). ;;; ;;; (defun tyvars-type (ty) ;;; (cond ((memq ty %oldtys)) ;;; ((is-vartype ty) (setq %tyvl (inq ty %tyvl))) ;;; (t (mapc #'tyvars-type (cdr (ml-dest_type ty))) ;;; (push ty %oldtys)) ;;; )) ; tyvars (defun tyvars-type (ty) (cond ((member-equal ty %oldtys)) ((is-vartype ty) (setq %tyvl (inq ty %tyvl))) (t (mapc #'tyvars-type (cdr (ml-dest_type ty))) (push ty %oldtys)) )) ; tyvars ;;; Deleted: formulas not used in HOL [TFM 90.06.27] ;;; (defun ml-form_tyvars(ob) ;;; (let ((%tyvl nil) (%oldtys nil)) ;;; (tyvars-fm ob) ;;; (nreverse %tyvl))) (defun ml-term_tyvars(ob) (let ((%tyvl nil) (%oldtys nil)) (tyvars-tm ob) (nreverse %tyvl))) ;;; find all type variables in a formula (defun tyvars-fm (fm) (case (form-class fm) ((conj disj imp) ; iff deleted [TFM 90.01.20] (tyvars-fm (get-left-form fm)) (tyvars-fm (get-right-form fm))) ((forall exists) (tyvars-tm (get-quant-var fm)) (tyvars-fm (get-quant-body fm))) (pred (tyvars-tm (get-pred-arg fm))) (t (lcferror (cons fm '|tyvars-fm|)))) ) ; tyvars-fm ;;; find all type variables in a term (defun tyvars-tm (tm) (case (term-class tm) ((var const) (tyvars-type (get-type tm))) (abs (tyvars-tm (get-abs-var tm)) (tyvars-tm (get-abs-body tm))) (comb (tyvars-tm (get-rator tm)) (tyvars-tm (get-rand tm))) (t (lcferror '|tyvars-tm|))) ) ; tyvars-tm ;;; ********************************************* ;;; type instantiation ;;; Renames variables to ensure that no distinct variables become identical ;;; after instantiation -- makes variants of all (and ONLY) those ;;; variables whose types change and whose names match. ;;; The first argument of inst_term and inst_form is ;;; a list of variables whose names must not be used. ;;; This handles free variables in the assumption list for the rule INST_TYPE. ;;; Original code does not detect capture of free variables when a type ;;; instantiation causes a variable to become identical to a lambda-bound ;;; variable whose scope it is in. This is fixed by a patch at the end ;;; of the file and in the ML code for INST_TYPE (MJCG 15/10/1989). ;;; Problem detected by Roger Jones' group at ICL Defence Systems. (dml |inst_type| 2 ml-inst_type ((((|type| |#| |type|) |list|) |#| |type|) -> |type|)) (dml |inst| 3 ml-inst_term (((|term| |list|) |#| (((|type| |#| |type|) |list|) |#| |term|)) -> |term|)) ;;; No formulas in HOL: paired_inst_form deleted [TFM 90.04.19] ;;;(dml |paired_inst_form| 3 ml-inst_form ;;; (((|term| |list|) |#| (((|type| |#| |type|) |list|) |#| |form|)) -> |form|)) (defun ml-inst_type (%insttyl ty) (if %insttyl (instin-type ty) ty)) ;ml-instintype ;;; No formulas in HOL: ml-inst_form deleted [TFM 90.04.19] ;;;(defun ml-inst_form (used-vars %insttyl ob) ;;; (if %insttyl ;;; (let ((%renames nil) ;;; (%changed-types (mapcar #'cdr %insttyl)) ;;; (%used-varnames (var-name-list used-vars 'inst))) ;;; (instin-fm ob)) ;;; ob)) ; ml-inst-in-fm ;;; GH:duplicated code of ml-inst-in for forms and terms (defun ml-inst_term (used-vars %insttyl ob) (if %insttyl (let ((%renames nil) (%changed-types (mapcar #'cdr %insttyl)) (%used-varnames (var-name-list used-vars 'inst))) (instin-tm ob)) ob)) ; ml-inst-in-tm ;;; instantiate types in a type ;;; record values of compound types to save re-traversal (defun instin-type (ty) (cond ((revassoc1 ty %insttyl)) ((is-vartype ty) ty) ((let* ((constyoptyargs (ml-dest_type ty)) (tyop (car constyoptyargs)) (tyargs (cdr constyoptyargs))) (let ((newty (make-type tyop (mapcar #'instin-type tyargs)))) (push (cons newty ty) %insttyl) newty)) ))) ;instin-type ;;; instantiate types in a formula (defun instin-fm (fm) (case (form-class fm) ((conj disj imp) ; iff deleted [TFM 90.01.20] (make-conn-form (get-conn fm) (instin-fm (get-left-form fm)) (instin-fm (get-right-form fm)))) ((forall exists) (make-quant-form (get-quant fm) (instin-tm (get-quant-var fm)) (instin-fm (get-quant-body fm)))) (pred (make-pred-form (get-pred-sym fm) (instin-tm (get-pred-arg fm)))) (t (lcferror 'instin-fm))) ) ; instin-fm ;;; instantiate types in a term (defun instin-tm (tm) (case (term-class tm) (var (instin-var tm)) (const (ml-mk_const (get-const-name tm) (instin-type (get-type tm)))) (abs (ml-mk_abs (instin-tm (get-abs-var tm)) (instin-tm (get-abs-body tm)))) (comb (let ((rator (instin-tm (get-rator tm))) (rand (instin-tm (get-rand tm)))) (let ((tyargs (cdr (ml-dest_type (get-type rator))))) (make-comb rator rand (second tyargs))))) (t (lcferror 'instin-tm))) ) ; instin-tm ;;; prime tok until it is not one of the tokl ;;; TFM for Version 1.12 [90.11.25] ;;; replaces a call to "variant-name" in instin-var below. (defun variant-name2 (tokl tok) (while (memq tok tokl) (setq tok (concat tok '|'|))) tok) ; variant-name2 ;;; instantiate types in a variable ;;; renames variables whose type may change ;;; the new name differs from all previous names ;;; call to "variant-name" replaced by call to variant-name2 ;;; [TFM 90.11.25] (defun instin-var (tm) (let ((name (get-var-name tm)) (ty (get-type tm))) (cond ((assq1 tm %renames)) ((exists #'(lambda (cty) (ml-type_in_type cty ty)) %changed-types) (let ((newname (variant-name2 %used-varnames name))) (let ((newv (mk_realvar newname (instin-type ty)))) (push newname %used-varnames) (push (cons tm newv) %renames) newv))) (t (push (cons tm tm) %renames) tm)) )) ; instin-var ;;; variable renaming - primarily for storing axioms and theorems ;;; forces all variable names in a scope to be distinct ;;; creates new names (identifiers) for all genvars ;;; We don't allow genvars on theory files because ;;; calling genvar should always make a variable not already present ;;; in the current LCF session (in particular, not read from a theory file). ;;; the implementation of scopes should be changed to use an environment, ;;; without side-effects, rather than the hack of forget-var ;;; rename_term used nowhere in HOL 88: deleted [TFM 90.06.01] ;;; (dml |rename_term| 1 ml-rename_term (|term| -> |term|)) ;;; Not used: deleted [TFM 90.06.01] ;;; (defun ml-rename_term (ob) ;;; (let ((%renames nil) (%used-varnames nil)) ;;; (rename-vars-tm ob))) ;;; No formulas in HOL: rename_form deleted [TFM 90.04.19] ;;;(dml |rename_form| 1 ml-rename_form (|form| -> |form|)) (defun ml-rename_form (ob) (let ((%renames nil) (%used-varnames nil)) (rename-vars-fm ob))) ;;; rename variables in a formula (defun rename-vars-fm (fm) (case (form-class fm) ((conj disj imp) ; iff deleted [TFM 90.01.20] (make-conn-form (get-conn fm) (rename-vars-fm (get-left-form fm)) (rename-vars-fm (get-right-form fm)))) ((forall exists) (let ((quant (get-quant fm)) (bv (rename-vars-tm (get-quant-var fm))) (body (rename-vars-fm (get-quant-body fm)))) (forget-var (get-quant-var fm)) (make-quant-form quant bv body))) (pred (make-pred-form (get-pred-sym fm) (rename-vars-tm (get-pred-arg fm)))) (t (lcferror 'rename-vars-fm ))) ) ; rename-vars-fm ;;; rename variables in a term (defun rename-vars-tm (tm) (case (term-class tm) (var (rename-var tm)) (const tm) (abs (let ((bv (rename-vars-tm (get-abs-var tm))) (body (rename-vars-tm (get-abs-body tm)))) (forget-var (get-abs-var tm)) (ml-mk_abs bv body))) (comb (ml-mk_comb (rename-vars-tm (get-rator tm)) (rename-vars-tm (get-rand tm)))) (t (lcferror 'rename-vars-tm))) ) ; rename-vars-tm ;;; rename a variable ;;; primes each variable to differ from all previous names ;;; renames all genvars (defun rename-var (v) (let ((name (get-var-name v)) (ty (get-type v))) (cond ((assq1 v %renames)) (t (let ((newname (variant-name %used-varnames (if (idenp name) name (gensym-interned))))) (let ((newv (mk_realvar newname ty))) (push newname %used-varnames) (push (cons v newv) %renames) newv)))) )) ; rename-var ;;; forget about a variable once leaving its scope ;;; to allow (\x.x), (\x.x) without priming the second x ;;; change needed by Mike Gordon (this is a mystery to me: MJCG 15/10/89!) (defun forget-var (v) (let ((v2 (assq1 v %renames))) (setq %used-varnames (delq (get-var-name v2) %used-varnames)) (push (cons v nil) %renames)) ) ; forget-var ;;; Code below added on 15/10/89 by MJCG to correct a variable capture bug ;;; found by ICL Defence Systems. ;;; Returns list of variables "x:ty2" in a term where there is a preceding ;;; "x:ty1" in the term with ty1 is not equal to ty2. ;;; (It is possible that the old code could be debugged to avoid this ;;; inefficient second pass, MJCG could not see how and installed this patch ;;; as a temporary fix.) ;;; Patched 25/01/94 by MJCG to return list of variables "x2:ty2" in a term ;;; where there is a preceding "x1:ty1" in the term ;;; with x1 equal to x2 up to priming and ty1 is not equal to ty2. ;;; Fixes a bug found by Joakim Von Wright (defun strip-primes (tok) (strip-primes-aux(reverse(exploden tok)))) (defun strip-primes-aux (tokl) (cond ((eq (car tokl) 39) (strip-primes-aux(cdr tokl))) (t (imploden(reverse tokl))))) (defun get-inst-rename-list (tm) (case (term-class tm) (var (let ((p (assq (strip-primes(get-var-name tm)) %clash-danger-vars))) (cond (p (and (not (eq (get-type tm) (cdr p))) (list tm))) (t (push (cons (strip-primes(cadr tm)) (cddr tm)) %clash-danger-vars) nil)))) (const nil) (abs (append (get-inst-rename-list (get-abs-var tm)) (get-inst-rename-list (get-abs-body tm)))) (comb (append (get-inst-rename-list (get-rator tm)) (get-inst-rename-list (get-rand tm)))) (t (lcferror 'get-inst-rename-list)))) (defun inst-renames (tm) (setq %clash-danger-vars nil) (get-inst-rename-list tm)) (dml |inst_rename_list| 1 inst-renames (|term| -> (|term| |list|))) ;;; Checks whether any type in tyl occurs in term tm ;;; Added 15/10/89 by MJCG as an optimization of INST_TYPE. (defun typel-in-tm (tyl tm) (and tyl (or (ml-type_in_term (car tyl) tm) (typel-in-tm (cdr tyl) tm)))) ;;; Checks (i) that the second component of every pair in inst_tylist ;;; is a type variable, and (ii) that none of these type variables occur ;;; in any of the terms in asl. Returns the free variables in asl. ;;; Added 15/10/89 by MJCG as an optimization of INST_TYPE. (defun ml-inst_check (inst_tylist asl) (prog (tyvars vars) (setq tyvars nil) (setq vars nil) l1 (cond ((null inst_tylist) (go l2)) ((is-vartype(cdar inst_tylist)) (setq tyvars (cons (cdar inst_tylist) tyvars)) (setq inst_tylist (cdr inst_tylist)) (go l1)) (t (failwith '|INST_TYPE: attempt to instantiate non-tyvar|))) l2 (cond ((null asl) (return vars)) ((typel-in-tm tyvars (car asl)) (failwith '|INST_TYPE: type variable free in assumptions|))) (setq vars (nconc (freevars (car asl)) vars)) (setq asl (cdr asl)) (go l2))) (dml |inst_check| 2 ml-inst_check ((((|type| |#| |type|) |list|) |#| (|term| |list|)) |->| (|term| |list|))) hol88-2.02.19940316/lisp/READ-ME0000640000212700021270000000040704610714227013634 0ustar cammcamm+ ===================================================================== + | HOL DISTRIBUTION DIRECTORY: lisp | + ===================================================================== + This directory contains all the lisp source code used in the HOL system. hol88-2.02.19940316/lisp/mk-ml.l0000640000212700021270000000724005071123252014065 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: mk-ml.l ;;; ;;; ;;; ;;; DESCRIPTION: Loads compiled lisp files to create an ML system ;;; ;;; ;;; ;;; USES FILES: f-cl.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; The franz feature is used for distinguishing between CL and ;;; Franz lisp. Remove it from features if it appears in a common ;;; lisp implementation. [Grotty way to tell that in franz lisp ;;; - *features* is unbound). (eval-when (compile load eval) (cond ((boundp '*features*) (setq *features* (remove :franz *features*))))) (eval-when (load) (setq |%theory_pp-flag| nil) (setq %debug nil) (setq experimental nil) (setq eof '$eof$) (setq %mlprindepth 3) (setq initial%load t)) ; allow modules to initialize themselves ;;; Dummy definition for special - franz lisp interpreter does not ;;; seem to know about it. Called when loading files declaring constants ;;; (implemented as specials in franz). #+franz (defun special fexpr (x) nil) ;;; If %directory is bound, then prepend it to filename. If not unix ;;; then make directory separator : rather than /. ;;; f-obj.l deleted from the load sequence [TFM 90.09.09] ;;; f-help.l added to the load sequence (eval-when (load) (mapc #'(lambda (file) (cond ((and (boundp '%directory) (eval '%directory)) (setq file #+franz (concat (eval '%directory) file) #-franz (concatenate 'string (eval '%directory) #+unix file #-unix ;; Franz cannot parse #\: (substitute (schar ":" 0) (schar "/" 0) file))))) (load file)) '(#+franz "lisp/f-franz" #-franz "lisp/f-cl" "lisp/f-system" "lisp/f-constants" "lisp/f-site" "lisp/f-gp" "lisp/f-parser" "lisp/f-parsml" "lisp/f-mlprin" "lisp/f-typeml" "lisp/f-dml" "lisp/f-format" "lisp/f-tran" "lisp/f-iox-stand" "lisp/f-writml" "lisp/f-tml" "lisp/f-lis" "lisp/f-ol-rec" "lisp/f-help"))) ;;; End of file hol88-2.02.19940316/lisp/.gmacs_state0000640000212700021270000000006405033437671015176 0ustar cammcamm.4744 /usr/nfs/grp11/hol/HOL13/lisp/parslist.l :X52 hol88-2.02.19940316/lisp/parslet.l0000640000212700021270000001772005535665632014550 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: parslet.l ;;; ;;; ;;; ;;; DESCRIPTION: Parsing of "let" expressions ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l f-macro.l ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: MJCG 28/02/94 Fixed MN's "in" bug ;;; ;;; : MJCG 04/04/94 Fixed "and" bug like MN's "in" bug ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; MJCG 3/2/89 for HOL88 ;;; ol-let-rtn parses "let ... " as follows ;;; ;;; "let f v1 ... vn = t1 in t2" ;;; --> "LET (\f.t2) (\v1 ... vn.t1)" ;;; ;;; "let (x1,...,xn) = t1 in t2" ;;; --> "LET (\(x1,...,xn).t2) t1" ;;; ;;; "let x1=t1 and x2=t2 ... and xn=tn in t" ;;; --> "LET ( ... (LET(LET (\x1...xn.t) t1)t2) ... ) tn" (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (*lexpr concat)) #+franz (declare (localf hol-bnd-rtn)) (eval-when (load) (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp)) (unop '|let| '(ol-let-rtn)))) ;;;(defun let-lhs-rtn (msg) ;;; (prog (x) ;;; (setq ;;; x ;;; (cond ((eq token anticnr-tok) (gnt) (metacall)) ;;; ((not(= toktyp 1)) (parse-failed msg)) ;;; (t (gnt) (mk-ol-atom ptoken)))) ;;; (while (eq token colon-sym) (gnt) (setq x (list 'MK=TYPED x (olt)))) ;;; (return x))) ;;; MJCG 31/1/89 for HOL88 ;;; Function to test for a parse tree of a (possibly typed) variable ;;; or antiquotation (defun is-var-pt (x) (or (eq (car x) 'MK=VAR) (and (eq (car x) 'MK=TYPED) (is-var-pt (cadr x))) (eq (car x) 'MK=ANTIQUOT))) ;;; MJCG 31/1/89 for HOL88 ;;; Function to test for a parse tree of a (possibly typed) tuple of ;;; variables (or antiquotation) (defun is-var-tuple-pt (x) (or (eq (car x) 'MK=VAR) (and (eq (car x) 'MK=TYPED) (is-var-tuple-pt (cadr x))) (and (eq (car x) 'MK=COMB) (eq (caadr x) 'MK=COMB) (equal (cadadr x) '(MK=CONST |,|)) (is-var-tuple-pt (caddadr x)) (is-var-tuple-pt (caddr x))) (eq (car x) 'MK=ANTIQUOT))) ;;; MJCG 31/1/89 for HOL88 ;;; Function to test for a parse tree of a (possibly typed) varstruct ;;; (i.e. formal application of tuples of variables (or antiquotations) (defun is-varstruct-pt (x) (or (eq (car x) 'MK=VAR) (and (eq (car x) 'MK=TYPED) (is-varstruct-pt (cadr x))) (and (eq (car x) 'MK=COMB) (eq (caadr x) 'MK=COMB) (equal (cadadr x) '(MK=CONST |,|)) (is-varstruct-pt (caddadr x)) (is-varstruct-pt (caddr x))) (and (eq (car x) 'MK=COMB) (is-varstruct-pt (cadr x)) (is-varstruct-pt (caddr x))) (eq (car x) 'MK=ANTIQUOT))) ;;; MJCG 27/1/89 for HOL88 ;;; used to reset |=| on parse failure (see lisp/f-parser.l) (defun hol-eqsetup () (putprop eq-sym 15 'ollp)) ;;; If [t] denotes the result of parsing t, then hol-bnd-rtn does: ;;; "f1 v11 ...vm1 = t1 and ... and fn = vn1 ... vnm" ;;; --> (([f1] . [\v11 ... vm1.t1]) ... ([fn] . [\vn1 ... vnm.tn])) ;;; MJCG 28.1.91 extra pred argument to build-lam-struc (defun hol-bnd-rtn () (prog (bindings name vars rhs) (setq bindings nil) (putprop eq-sym 0 'ollp) loop (setq name (term-check (parse-level 1000) "syntax error immediately after `let`")) (while (eq token colon-sym) (gnt) (setq name (list 'MK=TYPED name (olt)))) (cond ((eq token eq-sym) (ifn (is-var-tuple-pt name) (parse-failed "bad lhs after `let`")) (gnt) (hol-eqsetup) (push-in-and-ollp) (setq rhs (term-check (parse-level 10) "bad term after `=` in `let`")) (setq bindings (cons (cons name rhs) bindings)) (go and))) (ifn (is-var-pt name) (parse-failed "bad function name after `let`")) (setq vars (parse-level 20)) (ifn (is-varstruct-pt vars) (parse-failed "bad args to function definition after `let`")) (check eq-sym nil '|missing = after let|) (hol-eqsetup) (push-in-and-ollp) (setq rhs (term-check (parse-level 10) "bad term after `=` in `let`")) (setq bindings (cons (cons name (build-lam-struc lam-sym nil vars rhs)) bindings)) and (cond ((eq token '|and|) (gnt) (pop-in-and-ollp) (go loop))) (check '|in| nil "missing `in` or `and` after `let`") (pop-in-and-ollp) (return (reverse bindings)))) ;;; MJCG 30/1/89 for HOL88 ;;; If [t] denotes the result of parsing t, then hol-and-rtn does: ;;; (([x1] . [t1]) ([x2] . [t2]) ... ([xn] . [tn])), [t] ;;; --> [LET ( ... (LET (LET (\x1...xn. t) t1)t2) ... ) tn] ;;; MJCG 28.1.91 extra pred argument to build-lam-struc (defun hol-and-rtn (bindings body) (prog (lamb tms) (setq lamb body) (setq tms nil) (mapc (function (lambda (p) (setq lamb (build-lam-struc lam-sym nil (car p) lamb)) (setq tms (cons (cdr p) tms)))) (reverse bindings)) (mapc (function (lambda (x) (setq lamb `(MK=COMB (MK=COMB (MK=CONST LET) ,lamb) ,x)))) tms) (return lamb))) ;;; Recoded on 30/1/89 by MJCG for HOL88 (defun ol-let-rtn () (hol-and-rtn (hol-bnd-rtn) (term-check (parse-level 80) '|bad term after in|))) ;;; used to reset |in| on parse failure (see lisp/f-parser.l) ;;; MJCG 28/02/94: Grotesque fix for Malcolm Newey's "in" bug (defun hol-insetup () (if (eq (get '|in| 'ollp) 0) ;inside "let ... in ..." (putprop '|in| (get '|in| 'ollp-save) 'ollp)));reset in's ollp ;;; MJCG 27/1/89 for HOL88 ;;; used to reset |and| on parse failure (see lisp/f-parser.l) ;;; MJCG 28/02/94: Grotesque fix for "and" bug similar to MN's "in" bug (defun hol-andsetup () (if (eq (get '|and| 'ollp) 0) ;inside "let ... in ..." (putprop '|and| (get '|and| 'ollp-save) 'ollp)));reset and's ollp ;;; MJCG 26/1/89 for HOL88 ;;; Hack to make nested lets work (defun push-in-and-ollp () (putprop '|in| (get '|in| 'ollp) 'ollp-save) (putprop '|and| (get '|and| 'ollp) 'ollp-save) (putprop '|in| 0 'ollp) (putprop '|and| 0 'ollp)) (defun pop-in-and-ollp () (putprop '|in| (get '|in| 'ollp-save) 'ollp) (putprop '|and| (get '|and| 'ollp-save) 'ollp)) hol88-2.02.19940316/lisp/parse_as_binder.l0000640000212700021270000000553305262265612016204 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: parse_as_binder.l ;;; ;;; ;;; ;;; DESCRIPTION: This fragment of lisp originally appeared in ;;; ;;; hol-syn.ml as an argument to the ML function "lisp".;;; ;;; Vertical bars were needed where they appear below, ;;; ;;; but when the ML source was compiled, disaster res- ;;; ;;; ulted because the lisp expression below is compiled ;;; ;;; into a lisp symbol inside vertical bars, ie. res- ;;; ;;; ulting in nested vertical bars which doesn't work. ;;; ;;; Note that the ML could be evaluated but couldn't be ;;; ;;; compiled. Instead, the compiled version of this ;;; ;;; lisp source is loaded at run-time by hol-syn.ml. ;;; ;;; ;;; ;;; USES FILES: ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: April 1987 (J.Joyce) ;;; ;;; October 1 1992 : parse_as_binder removed and put ;;; ;;; into hol-syn.l just after binder-rtn. This file ;;; ;;; removed from build sequence [TFM for HOL88 2.01] ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) (include "lisp/f-macro")) (dml |parse_as_binder| 1 binder-rtn (|tok| -> |tok|)) hol88-2.02.19940316/lisp/mk_pp_thm.l0000640000212700021270000000445405071123244015033 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: mk_pp_thm.l ;;; ;;; ;;; ;;; DESCRIPTION: Hack to get PPLAMBDA started. ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l, f-ol-rec.l, ;;; ;;; genmacs.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro") (include "lisp/f-ol-rec") (include "lisp/genmacs") (special %thm-count)) (defun set-thm-count (x) (prog1 %thm-count (setq %thm-count x))) (dml |set_thm_count| 1 set-thm-count (|int| |->| |int|)) (defun identity-function (x) (incf %thm-count) x) (dml |mk_pp_thm| 1 identity-function (((|form| |list|) |#| |form|) |->| |thm|)) hol88-2.02.19940316/lisp/mk-hol-lcf.l0000640000212700021270000000525605071123256015012 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: mk-hol-lcf.l ;;; ;;; ;;; ;;; DESCRIPTION: Loads files into ML to get an LCF suitable for HOL ;;; ;;; ;;; ;;; USES FILES: f-cl.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; If %directory is bound, then prepend it to filename. If not unix ;;; then make directory separator : rather than /. (eval-when (load) (mapc #'(lambda (file) (cond ((and (boundp '%directory) (eval '%directory)) (setq file #+franz (concat (eval '%directory) file) #-franz (concatenate 'string (eval '%directory) #+unix file #-unix ;; Franz cannot parse #\: (substitute (schar ":" 0) (schar "/" 0) file))))) (load file)) '("lisp/f-parsol" "lisp/f-typeol" "lisp/f-help" "lisp/f-format" "lisp/f-writol" "lisp/f-thyfns" #-franz "lisp/f-freadth" "lisp/f-ol-syntax" "lisp/f-subst" "lisp/f-inst" "lisp/f-simpl" "lisp/f-ol-net"))) ;;; End of file hol88-2.02.19940316/lisp/banner.l0000640000212700021270000000666105223275046014333 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.1 ;;; ;;; ;;; ;;; FILE NAME: banner.l ;;; ;;; ;;; ;;; DESCRIPTION: HOL system banner ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l) ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: "Classic HOL" banner added by MJCG on 31 March 1992 ;;; ;;; ========== banner installed by MJCG on 27 June 1992 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (special %build-date %version)) ;;;(setq HOL-sym ;;; `|_ _ __ _ ;;;!__! ! ! ! ;;;! ! IGHER !__! RDER !__ OGIC ;;;=============================== ;;;|) ;;;(defconstant HOL-sym ;;;" _ _ __ _ __ __ ;;; |___ |__| | | | |__| |__| ;;; | | | |__| |__ |__| |__| ;;; ;;;") ;;;(defconstant HOL-sym ;;;" __ _ _ __ __ _ __ _ _ __ _ ;;; |___ | | /_\\ |__ |__ | | |__| | | | ;;; | |__ |__ / \\ __| __| | |__ | | |__| |__ ;;; ;;;") (defconstant eqline " =============================================================================== ") (setq %build-date (date)) ;;; Version: set in Makefile (setq %version '"") (defun banner () (terpri) (princ eqline) (princ " HOL88 Version ") (princ %version) (princ '", built on ") (princ %build-date) (princ eqline) ) ;;;(defun banner () ;;; (terpri) ;;; (princ HOL-sym) ;;; (princ " HOL88 Version ") (princ %version) ;;; (princ '", built on ") (princ %build-date) ;;; (terpri) ;;; ) ;;;(defun banner () ;;; (terpri) ;;; (princ '|Higher Order Logic|) (terpri) ;;; (princ '|==================|) (terpri) ;;; (princ `|[Based on Cambridge LCF, version |) ;;; (princ %version) ;;; (princ '| created |) (princ %ctime) (princ '|]|) (terpri) ;;; (cond (experimental (princ '|Experimental system!|) (terpri))) ;;; ) hol88-2.02.19940316/lisp/gnt.l0000640000212700021270000000751705071123275013654 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: gnt.l ;;; ;;; ;;; ;;; DESCRIPTION: Get next token ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; gnt (get next token) changed so numbers returned in both ML and OL (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (*lexpr concat) (special token tokchs toktyp cflag ptoken ptokchs ptoktyp pchar parsedepth arg1 lang1 atom-rtn langlp juxtlevel juxt-rtn lang2 msg1 msg2 nulltyptok tokbearer toklbearer olinprec zeros-count)) (defun gnt () (setq cflag (spacep hol-char)) ;for vartypes (berk) (setq ptoken token) (setq ptokchs tokchs) (setq ptoktyp toktyp) (setq pchar hol-char) (while (spacep hol-char)(setq pchar (setq hol-char (gnc)))) ;remove spacing (setq toktyp 1) (cond ((letterp hol-char) (setq tokchs (list hol-char)) ;ident (ident)) ((digitp hol-char) (setq tokchs (list hol-char)) ;number (ML and OL) (numb)) ((= hol-char tokqt) (setq tokchs nil) (tcn)) (t (setq toktyp 2) (setq hol-char (gnc)) (setq token (ascii pchar)) (if (and (eq token scolon-sym) (= hol-char lf)) (setq hol-char (gnc))) (while (memq hol-char (get token 'double)) (setq token (concat token (ascii hol-char))) (setq hol-char (gnc))))) token ) ;gnt ;;; scan a number and return its numeric value ;;; number of leading zeros stored in zeros-count ;;; In the function numb below zeros-flag is t whilst counting leading zeros. ;;; As soon as a non-zero digit is reached it goes to nil. (defun numb () (let ((accu (difference hol-char #/0))(zeros-flag t)) (setq zeros-flag (if (zerop accu) t nil)) (setq zeros-count (if (zerop accu) 1 0)) (while (digitp (setq hol-char (nextcn))) (if (= hol-char #/0) (if zeros-flag (setq zeros-count (add1 zeros-count))) (setq zeros-flag nil)) (setq accu (add (times accu 10)(difference hol-char #/0)))) (setq token accu))) hol88-2.02.19940316/lisp/genmacs.l0000640000212700021270000000647305071123300014466 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: genmacs.l ;;; ;;; ;;; ;;; DESCRIPTION: General-purpose macros ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l, f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro") (include "lisp/f-ol-rec") (macros t) (special %show-types %empty-set)) (defmacro get-term-list (tm) `(cadr ,tm)) (defmacro make-prep-term (class term-list type) `(cons ,class (cons ,term-list ,type))) (defmacro atom-to-num (a) ;; (atom-to-num |n1n2...|) gives the number n1n2... #+franz `(readlist (explodec ,a)) #-franz `(parse-integer (string ,a) :junk-allowed t)) (defmacro is-num-atom (a) ;; is-num-atom tests whether an atom is an atomified number `(numberp (atom-to-num ,a))) (defmacro null-ol-list (tm) `(and (is-const ,tm) (eq (get-const-name ,tm) 'NIL))) (defmacro hd-ol-list (tm) `(get-rand (get-rator ,tm))) (defmacro tl-ol-list (tm) `(get-rand ,tm)) (defmacro get-ol-list-type (tm) `(first (get-type-args (get-type ,tm)))) (defmacro null-ol-set (tm) `(and (is-const ,tm) (eq (get-const-name ,tm) %empty-set))) (defmacro hd-ol-set (tm) `(get-rand (get-rator ,tm))) (defmacro tl-ol-set (tm) `(get-rand ,tm)) (defmacro get-ol-set-type (tm) `(first (get-type-args (get-type ,tm)))) (defmacro is-pair (tm) `(and (is-comb ,tm) (is-comb (get-rator ,tm)) (is-const (get-rator (get-rator ,tm))) (eq (get-const-name (get-rator (get-rator ,tm))) '|,|))) (defmacro is-triple (tm) `(and (is-pair ,tm) (is-pair (get-snd ,tm)))) (defmacro get-fst (tm) `(get-rand (get-rator ,tm))) (defmacro get-snd (tm) `(get-rand ,tm)) (defmacro get-thrd (tm) `(get-snd (get-snd ,tm))) hol88-2.02.19940316/lisp/genfns.l0000640000212700021270000000470205071123304014326 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: genfns.l ;;; ;;; ;;; ;;; DESCRIPTION: General-purpose lisp functions ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l) ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro")) #+franz (declare (localf truncate-list)) ;;;(truncate-list i (x1 ... xn)) gives (x1 ... xi). Must have i ((1 . 2)) ;;; ;;; (cons (errset (error "lisp error")) 1) -> ;;; <"lisp error" reported as an error> ;;; ( . 1) ;;; ;;; (catch 'tag (cons (errset (throw 'tag 1)) 2)) -> 1 or NIL, ;;; but not ( . 2) (defmacro errset (x) #+procyon `(multiple-value-bind (.res. .type. .tag.) (trap-exits ,x) (cond ((eq .type. 'throw) (throw .tag. (car .res.))) ((eq .type. 'error) (fresh-line *terminal-io*) nil) (t .res.))) #+lucid `(multiple-value-bind (.res. .error-p.) (lucid:with-error-trapping ,x) (if .error-p. (progn (format t "~&error -- ~?~%" (third .res.) (fourth .res.)) "error") .res.)) #+kcl `(let ((.fn. (function (lambda nil ,x)))) ;; Have to capture lexical environment first since evaluation ;; takes place in the null environment (multiple-value-bind (.error-p. .res.) (si:error-set (list 'funcall (list 'quote .fn.))) (cond ((not .error-p.) (list .res.)) ((atom .error-p.) (throw .error-p. nil)) (t '|error|)))) #+allegro `(multiple-value-bind (.no-error-p. .res.) (excl:errorset ,x t) (when .no-error-p. (list .res.))) #+:coral `(ccl:catch-error (ccl:catch-abort (ccl:catch-cancel (list ,x)))) #-(or procyon lucid kcl allegro :coral) (error "errset macro (in lisp/f-cl.l) has not been defined for this lisp")) ;;; Exit from lisp. (quit) is a normal exit. Calling (quit 1) should set ;;; an error return code so that an enclosing OS make will also terminate. ;;; Lucid CL 3.0 defined quit directly with the proper form (returns exit ;;; optional exit status). PJW -- 04OCT90 #-lcl3.0 (eval-when (compile load eval) (shadow '(quit))) #-lcl3.0 (eval-when (compile load eval) (defun quit (&rest args) (let ((code (cond (args (car args)) (t 0)))) #+procyon (procyon:quit :quit code) #+lucid (system:quit code) #+kcl (bye code) #+allegro (exit code :quiet t) #+:coral (quit) ))) ;;; Saving a core image. Set top level loop to be tml on restart. (defun ml-save (tok) (setq tok (string tok)) (let ((file (if (and (boundp '%directory) (symbol-value '%directory)) (concatenate 'string (symbol-value '%directory) tok) tok))) #+procyon (save-image :image-file file :start-up-function (compile nil `(lambda nil (setf (procyon:stream-title *terminal-io*) %system-name) (tml)))) #+lucid (disksave file :restart-function (compile nil '(lambda nil (tml) (quit))) :gc t) #+kcl (progn (setf (symbol-function 'si:top-level) `(lambda nil (tml))) (gbc t) (save file)) #+allegro (progn (setf (symbol-function 'excl::copyright-banner) (compile nil '(lambda nil nil))) (gc t) (excl:dumplisp :name file :restart-function 'tml :read-init-file nil)) #+:coral (dumplisp (pathname file) :toplevel-function (symbol-function 'tml)) )) ;;; Control of input. Ignore EOF on standard-input stream #+kcl (eval-when (load) (setf si:*ignore-eof-on-terminal-io* t)) #+allegro (eval-when (load) (setf top-level:*exit-on-eof* nil)) #+(and procyon pc) (defmethod cg:location-fasl-file-p ((stream pc::dos-location)) ;; patch so that '.o' is recognised as a possible extension for binary ;; files as well as the standard '.fsl' (member (pathname-type (pro:stream-location stream)) '("fsl" "o") :test #'equalp)) #+(and procyon pc) (defun pc:check-for-length-and-wildcard (string length error-insert-string) ;; patch so that long file and directory names are allowed, but are ;; silently truncated to the OS limit (8 characters in DOS) (when (i> (length (the string string)) length) (setq string (subseq string 0 length))) (if (whole-string= string "*") :wild string)) ;;; Text editor environment customisation for Procyon lisp. Make sure ;;; the HOL pretty-print margin follows the width of the interaction ;;; window, that newline and enter send last line to reader, and that ;;; hitting enter when cursor is just before an ML expression in a window ;;; causes expression to be evaluated as ML. #+procyon (eval-when (load) (comtab:set-event-function toploop::*toploop-comtab* null-event ;; Make sure %margin always holds the interaction window width #'(lambda (x) (declare (special %margin %prettyon)) (when (and (boundp '%margin) (not (eql %margin (line-length *terminal-io*)))) (setq %margin (line-length *terminal-io*)) (setpretty %prettyon)) (funcall '#.(comtab:event-function toploop::*toploop-comtab* null-event) x))) (defvar *enter-event-fn* (comtab:event-function toploop::*toploop-comtab* #+macintosh enter #+pc pc:vk-enter)) (comtab:set-event-function toploop::*toploop-comtab* #+macintosh enter #+pc pc:vk-enter ;; Configure the toploop so that enter sends the last line ;; to the reader #'(lambda (window) (file-position *terminal-io* :end) #+pc (write-char #\linefeed *terminal-io*) #+macintosh (terpri *terminal-io*) (funcall *enter-event-fn* window))) (comtab:set-event-function toploop::*toploop-comtab* #\Newline (comtab:event-function toploop::*toploop-comtab* #+macintosh enter #+pc pc:vk-enter)) (comtab:set-event-function te:*text-edit-comtab* #+macintosh enter #+pc pc:vk-enter #'(lambda (window) (when (peek-char t window nil nil) (setq *standard-input* window) (te:return-to-reader window)))) ) ;;; More environment customisation for Procyon lisp on Mac. Selecting a region ;;; and going 'evaluate selection' from the menu evaluates as ML, and quit menu ;;; item asks for confimation. #+(and procyon macintosh) (eval-when (load) (comtab:defcom ml-eval-region te:*text-edit-comtab* (window) (multiple-value-bind (start end) (te:get-region window) (while (and (peek-char t window nil nil) (> end (file-position window))) (let ((*standard-input* window)) (ml-read-eval-print))) ;; restore selection (te:set-region window start end) ;; set prompt position for toploop window (toploop::fix-prompt-position *terminal-io*))) (comtab:set-menu-command te:*text-edit-comtab* :eval 'ml-eval-region) (comtab:defcom tml-quit te:*text-edit-comtab* (window) (when (y-or-n-p "Do you really want to quit?") (quit))) (comtab:set-menu-command te:*text-edit-comtab* :quit 'tml-quit) ) ;;; Make sure that the system knows that '.o' (compiled ML) files ;;; are binary files containing compiled lisp code. #+allegro (eval-when (load eval) (setq excl::*load-foreign-types* nil)) ;;; Do CL equivalents for franz declarations at top of files. If ;;; %directory is bound, then prepend it to filename. If PC then make ;;; directory separator \ rather than /, otherwise make it : (eval-when (compile load eval) (shadow '(include))) (defmacro include (x) `(flet ((file-abs-path (name) (concatenate 'string (or (and (boundp '%directory) (symbol-value '%directory)) "") #+unix name ;; JAC 19.06.92 #+pc (substitute #\\ #\/ name) #-(or unix pc) (substitute #\: #\/ name)))) (let ((file (file-abs-path ,x))) (when *load-verbose* (format t "~&;;; Including ~A" (namestring file))) (load file :verbose nil :print nil)))) (defmacro special (&rest vars) `(proclaim '(special ,@vars))) (progn (defmacro macros (&rest x) (declare (ignore x)) nil) (defmacro *lexpr (&rest x) (declare (ignore x)) nil)) ;;; New #-macro sub-character '/' - like '\' but returns the ;;; character code, rather than the character. (eval-when (compile load eval) (set-dispatch-macro-character #\# #\/ #'(lambda (stream subchar arg) (declare (ignore subchar arg)) (char-int (read-char stream t nil t))))) ;;; Control constructs (defmacro catch-throw (name &rest body) `(catch ',name ,@body)) (defmacro throw-from (name &rest body) `(throw ',name ,(if (cdr body) `(progn ,@body) (car body)))) (defmacro ifn (test then . else) `(cond ((not ,test) ,then) (t nil ,@else))) (defmacro newr (var val) `(setq ,var (cond (,var (nconc ,var (list ,val))) (t (list ,val))))) (eval-when (compile load eval) (shadow '(until while))) (defmacro until (test . body) ;; The let avoids double evaluation of test on exit. (let ((lable (gensym)) (valvar (gensym))) `(prog () ,lable (let ((,valvar ,test)) (cond (,valvar (return ,valvar)) (t ,@body (go ,lable))))))) (defmacro while (test . body) (let ((lable (gensym))) `(prog () ,lable (cond (,test ,@body (go ,lable)) (t (return nil)))))) (defmacro cadaddr (x) `(car (cdaddr ,x))) (defmacro cadddaddr (x) `(caddr (cdaddr ,x))) (defmacro caddaddr (x) `(cadr (cdaddr ,x))) (defmacro caddadadr (x) `(caddr (cadadr ,x))) (defmacro cadadadr (x) `(cadr (cadadr ,x))) (defmacro caadadr (x) `(car (cadadr ,x))) (defmacro caddadr (x) `(car (cddadr ,x))) (defmacro add (x y) `(+ ,x ,y)) (defmacro times (x y) `(* ,x ,y)) (defmacro plus (x y) `(+ ,x ,y)) (defmacro sub1 (x) `(1- ,x)) (defmacro add1 (x) `(1+ ,x)) (defmacro difference (x y) `(- ,x ,y)) (defmacro fix (x) `(truncate ,x)) (defmacro greaterp (x y) `(> ,x ,y)) (defmacro lessp (x y) `(< ,x ,y)) ;;; (eval-when (compile load eval) ;; Some CL implementations try to be 'helpful' in defining these as ;; functions. They are macros here. (shadow '(memq assq delq putprop))) (defmacro memq (x lst) `(member ,x ,lst)) (defmacro assq (x lst) `(assoc ,x ,lst)) (defmacro delq (x lst) `(delete ,x ,lst)) (defmacro assoc-equal (x lst) `(assoc ,x ,lst :test #'equal)) (defmacro member-equal (x lst) `(member ,x ,lst :test #'equal)) (defmacro subst-equal (x y lst) `(subst ,x ,y ,lst :test #'equal)) (defmacro putprop (sym val prop) `(setf (get ,sym ,prop) ,val)) ;;; (defmacro alphalessp (x y) `(and (string< (string ,x) (string ,y)) t)) (defmacro atomify (x) `(intern (princ-to-string ,x))) (defmacro ascii (x) `(intern (string (int-char ,x)))) (defun exploden (x) (declare (optimize (speed 3) (safety 0) (space 0))) (do* ((string (typecase x (symbol (symbol-name x)) (string x) (t (princ-to-string x)))) (len (length string)) (res nil) (ind 0 (1+ ind))) ((eql ind len) (nreverse res)) (push (char-int (char string ind)) res))) (defun imploden (lst) (intern (coerce (mapcar #'int-char lst) 'string))) (defun flatc (x) (length (princ-to-string x))) (defmacro gensym-interned nil '(gentemp)) ;;;(defun maknum (x) ;;; (warn "ML function address called - returning zero") ;;; 0) (defun infile (filename) (open (string filename) :direction :input)) (defun outfile (filename) (open (string filename) :direction :output :if-exists :supersede :if-does-not-exist :create)) (defun readc (&optional (stream *standard-input*)) (intern (string (read-char stream nil '|nil|)))) ;;; This is close to the franz concat - princ-to-string takes care of the ;;; number case. The difference between uconcat and concat is that the symbol ;;; is interned only in the case of concat. ;;;(defun uconcat (&rest l) ;;; (make-symbol ;;; (apply #'concatenate 'string (mapcar #'princ-to-string l)))) ;;;(defun concat (&rest l) ;;; (intern ;;; (apply #'concatenate 'string (mapcar #'princ-to-string l)))) ;;;(defun concatl (l) (apply #'concat l)) (defun concat-aux (l) (do ((chars (reverse l) (cdr chars)) (res '"" (concatenate 'string (princ-to-string (car chars)) res))) ((null chars) res))) (defun uconcat (&rest l) (make-symbol (concat-aux l))) (defun concat (&rest l) (intern (concat-aux l))) (defun concatl (l) (intern (concat-aux l))) (defun canonise-case-symbol (x) ;; From a symbol, return the one that would have been returned by ;; reading it - i.e. one with an uppercase print name. ;; Changed to only return the string, rather than make it all ;; all upcase [JVT 03.04.91]. (intern (string x))) ;;;(defun catenate (&rest l) ;;; (apply #'concatenate 'string ;;; (mapcar #'princ-to-string l))) (defun catenate (&rest l) (concat-aux l)) (defun cascii (a) ;; ascii code of first character of a symbol (char-int (char (symbol-name a) 0))) ;;; IO functions (defun llterpri () (terpri *standard-output*)) (defun llprinc (expr) (princ expr *standard-output*) (finish-output *standard-output*)) (defun llprint (expr) ;; changed by MJCG for HOL so that if |%theory_pp-flag| is t ;; then theories are pretty-printed. (if |%theory_pp-flag| (pprint expr *standard-output*) (print expr *standard-output*))) (defun llreadcn () (let ((char (read-char *standard-input* nil nil))) (when char (char-int char)))) (defun llread () (read *standard-input*)) ;;; Re-direct input to be taken from the given file ;;; inputstack holds all previous values of input stream (defun infilepush (filespec) (push *standard-input* inputstack) (setq *standard-input* (infile filespec))) ; infilepush (defun infilepop () ;; Restore previous input stream, closing current one (let ((current-input *standard-input*)) (setq *standard-input* (pop inputstack)) (close current-input))) (defun clock () ;; Get absolute time - just for time-stamps (get-universal-time)) ;;; Add extension .o to a file name for output name in process of ;;; compiling an ML file. #-lucid (defun make-object-filename (x) (let ((len (length x))) (concatenate 'string ;; remove existing .l extension, if any (if (and (> len 2) (eql (schar x (1- len)) #\l) (eql (schar x (- len 2)) #\.)) (subseq x 0 (- len 2)) x) ".o"))) ;; Functions slash-pos & slash-pos1, used to alleviate problem with ;; LUCID Common Lisp inserting extra directory names into filename before ;; compilation. (SMB - 24/5/90) ;;; Note to JVT: SMB is Steve Bancroft who assisted me with HOL at Davis. #+lucid (defun slash-pos (filename) (slash-pos1 filename 0)) #+lucid (defun slash-pos1 (filename position) (let ((len (length filename))) (cond ((= 0 len) 0) ((eq #\/ (schar filename 0)) (1+ position)) (t (slash-pos1 (subseq filename 1 len) (1+ position)))))) ;; Modified make-object-filename for lucid to use slash-pos ;; (SMB - 24/5/90) #+lucid (defun make-object-filename (x) (let ((len (length x))) (setq temp (concatenate 'string ;; remove existing .l extension, if any (if (and (> len 2) (eql (schar x (1- len)) #\l) (eql (schar x (- len 2)) #\.)) (subseq x 0 (- len 2)) x) ".o")) (subseq temp (slash-pos temp) (length temp)))) ;;; Function called on returning from tml command loop (defun finalize-tml () nil) ;;; Turn off debugging switches and set top level to (tml) (defun setup nil (setq *load-verbose* nil) #+allegro-v4.0 (setq *compile-verbose* nil) #+allegro-v4.1 (setq *compile-verbose* nil) #+allegro-v4.1 (setq *compile-print* nil) #+allegro (gc t) #+kcl (gbc 3) (setdebug nil)) ;;; set the internal |%print_fasl-flag| value (defun set-fasl-flag (val) (setq *load-verbose* val) (setq |%print_fasl-flag| val)) (defun setup-ml nil (setdebug nil)) (defun setdebug (flag) (setq *debugging* flag)) ;;; Initialize system in experimental mode - turn debug options on (defun experimental-init () (princ "Experimental version!") (terpri) (setdebug t)) ;;; Set up for loading of system (defun set-make () ;; Called after all lisp code for HOL has been loaded, just before ;; ML top loop is entered. ;; Franz version sets up the error handler to print the error ;; message and quit - not in general possible in CL #+allegro-v4.0 (progn (setq *redefinition-warnings* nil) (setq *record-source-files* nil) (setq *load-verbose* nil) (setq *compile-verbose* nil)) #+allegro-v4.1 (progn (setq *redefinition-warnings* nil) (setq *record-source-files* nil) (setq *load-verbose* nil) (setq *compile-print* nil) (setq *compile-verbose* nil)) #+lucid (progn (setup-gc-time-monitoring) (setq *redefinition-action* nil) (compiler-options :messages nil :warnings nil)) #+kcl (progn ;; Turn off compiler messages (system:gbc-time 0) (setq compiler:*compile-verbose* nil) (setq compiler::*suppress-compiler-notes* t) (setq compiler::*suppress-compiler-warnings* t) ) nil) ;;; Get the current date as a string: dd/mm/yy (defun date nil (multiple-value-bind (sec min hour day mon year) (get-decoded-time) (declare (ignore sec min hour)) (format nil "~D/~D/~D" day mon (rem year 100)))) (defun flatsize2 (str) (length (princ-to-string str))) ;;; Record time spent in GC #+kcl (progn () (system:gbc-time 0)) #+lucid (progn (defvar *internal-gc-time* 0) (defvar *last-gc-start-time* 0)) #+lucid (defun setup-gc-time-monitoring nil (setq *gc-silence* (compile nil '(lambda (when) (case when (:before (fresh-line *terminal-io*) (princ ";;; GC") (finish-output *terminal-io*) (setq *last-gc-start-time* (get-internal-run-time))) (:after (terpri) (incf *internal-gc-time* (- (get-internal-run-time) *last-gc-start-time*))) (t)))))) ;;; Return (jobtime . gctime) where jobtime does not include gctime ;;; in 10ths of seconds (rounded) (defun runtime10th () (flet ((sec-10ths (x) (cons (truncate (* (car x) 10) internal-time-units-per-second) (truncate (* (cdr x) 10) internal-time-units-per-second)))) (sec-10ths #+lucid (cons (- (get-internal-run-time) *internal-gc-time*) *internal-gc-time*) #+procyon (let ((gc (system:%gctime t))) (cons (- (get-internal-run-time) gc) gc)) #+allegro (multiple-value-bind (user system gc-user gc-system) (excl::get-internal-run-times) (declare (ignore system gc-system)) ;; exclude system overheads for this process ;; - otherwise (cons (+ user system) (+ gc-user gc-system)) (cons user gc-user)) #+kcl (let ((gc (system:gbc-time))) (cons (- (get-internal-run-time) gc) gc)) #-(or lucid procyon allegro kcl) (cons (get-internal-run-time) 0)))) (defun bigger (obj size) (> (flatsize2 obj) size)) ;bigger (defun init-io () (setq outfiles nil) (setq inputstack nil)) ;;; Call a lisp listener. Break is a grubby but implementation- ;;; independent way to get into a lisp debugger loop. (defun ml-break nil #+(or procyon allegro) (break "Enter lisp debugger top level loop") #+lucid (progn (format t "~%Entering lisp top level loop - type (q) to exit~%~%") (lucid::enter-top-level t)) #+kcl (let ((si::*quit-tag* (cons nil nil))) (catch si::*quit-tag* (break "Entering lisp debugger - type :q to exit"))) ) #+lucid (defun q nil (throw 'tmllooptag nil)) ;;; Compile a list of function definitions - but the kcl compiler is ;;; _really_ slow for individual functions. (defun compile-functions-if-needed (forms) (mapc #'(lambda (form) (unless (compiled-function-p (symbol-function (cadr form))) (compile (cadr form)))) forms)) ;;; End of file hol88-2.02.19940316/lisp/f-tran.l0000640000212700021270000010033705306736376014262 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-tran.l ;;; ;;; ;;; ;;; DESCRIPTION: Translate ML to lisp ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: tran (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V2.2 :throw instead of err ;;; ;;; ;;; ;;; V3.1 Unix -- Made MK-ABSTR generate defun's instead ;;; ;;; of embedded lambdas ;;; ;;; ;;; ;;; V4-4 Optimization of code transferred from F-tml. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Specials for compiling tran: %p, %loop, %test ;;; Specials for compiling tran-output: %e ;;; Sets manifests: isomclosure, isom, dummy, empty, tzero (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (*lexpr concat)) #+franz (declare (localf translation-failed nfirst access_code access_path upd_ap rap access stor copyst copys storst bvpat varpat trex trin tr-match combinetree lispfunpat chkvarstr chkvarstrx inserttransfun mkclosure lispfunclosure lispargs fastap genloop isloop trarms trtrap qreturn trlast testeval trb trabstyb isompat make-cond-case gencheck gencheckl checkst checks checks2 checksl trdecl optimize-code optimize-ap trans-sexpr build-lb)) ;;; translation tables for OL parse trees ;;; phyla for which all subtrees must be translated (via trq) (eval-when (compile load eval) (defconstant %q-trans-args '( ; term constructors (MK=TYPED . q-mk_typed) (MK=ABS . q-mk_abs) (MK=COMB . q-mk_comb) (MK=PAIR . q-mk_pair) (MK=COND . q-mk_cond) ; formula constructors (MK=EQUIV . q-mk_equiv) (MK=INEQUIV . q-mk_inequiv) (MK=NEG . q-mk_neg) (MK=CONJ . q-mk_conj) (MK=DISJ . q-mk_disj) (MK=IMP . q-mk_imp) ;;; (MK=IFF . q-mk_iff) DELETED [TFM 90.01.20] (MK=FORALL . q-mk_forall) (MK=EXISTS . q-mk_exists)))) ;;; phyla for which the one subtree must be quoted (eval-when (compile load eval) (defconstant %q-quote-arg '((MK=VAR . q-mk_var) (MK=CONST . q-mk_const) (MK=VARTYPE . q-mk_vartype)))) (eval-when (compile load eval) (defconstant isomclosure (cons 'car 'isomclosure)) ;new (defconstant isom '%isom) (defconstant rec '%rec) (defconstant ord '%ord) (defconstant dummy '%dummy)) ;;; Franz compiler cannot compile the catch-throw and throw-from macros ;;; properly when making lisp object code from ML since it does not ;;; know about them. So macroexpand into *catch and *throw for it. (defun make-catch-form (x) #+franz `(*catch 'evaluation ,x) #-franz `(catch 'evaluation ,x)) (defun make-throw-form (x) #+franz `(*throw 'evaluation ,x) #-franz `(throw 'evaluation ,x)) (defun make-lambda-binding (var val &rest forms) #+franz `((lambda (,var) ,@forms) ,val) #-franz `(let ((,var ,val)) ,@forms)) (defun remember-tran-function (name arglist body-forms) (push `(defun ,name ,arglist #-franz (declare (optimize (speed 2) (safety 0))) ,@body-forms) %compfns)) ;;; For translation error messages (defun translation-failed (msg) (llprinc msg) (llterpri) (throw-from translation nil)) ;translation-failed ;;; Get the global Lisp binding of the ml identifier i ;;; returns nil if undeclared (defun get-lisp-binding (i) (or (assq1 i rec%env) (assq1 i global%env))) (defun nfirst (l n) (if (zerop n) nil (cons (car l) (nfirst (cdr l) (- n 1))))) (defun access_code (l) (if (null l) '%e (if (< (length l) 5) `(,(concatl `(c ,@l r)) %e) `(,(concatl `(c ,@(nfirst l 4) r)) ,(access_code (cddddr l)))))) (defun access_path (i rho) (let ((tac nil)) (ifn (null rho) (cond ((atom (car rho)) (cond ((equal (car rho) i) (cons ord '(a))) ((equal (car rho) isom) (if (memq i (cdr rho)) (list isom))) ((equal (car rho) rec) (if (setq tac (rap i (cdr rho))) `(,rec . ,tac))) ((atom (cdr rho)) (if (equal (cdr rho) i) (cons ord '(d)))) ((setq tac (access_path i (cdr rho))) (upd_ap tac 'd)))) ((setq tac (access_path i (car rho))) (upd_ap tac 'a)) ((atom (cdr rho)) (if (equal (cdr rho) i) (cons ord '(d)))) ((setq tac (access_path i (cdr rho))) (upd_ap tac 'd)))))) ;access_path (defun upd_ap (path move) (cond ((eq (car path) isom) path) ((eq (car path) rec) (rplacd (cdr path) (cons move (cddr path))) path) ((eq (car path) ord) (rplacd path (cons move (cdr path)))))) (defun rap (i rho) (let ((tac nil)) (cond ((atom (car rho)) (if (equal (car rho) i) (cons (cdr rho) nil))) ((atom (caar rho)) (cond ((equal (caar rho) i) (cons (cdar rho) '(a))) ((atom (cadr rho) ) (if (equal (cadr rho) i) (cons (cddr rho) '(d)))) ((setq tac (rap i (cdr rho))) (rplacd tac (cons 'd (cdr tac)))))) ((setq tac (rap i (car rho))) (rplacd tac (cons 'ad (cdr tac)))) ((atom (cadr rho)) (if (equal (cadr rho) i) (cons (cddr rho) '(d)))) ((setq tac (rap i (cdr rho))) (rplacd tac (cons 'd (cdr tac))))))) ;rap (defun access (i) (let ((path (access_path i %p))) (ifn (null path) (cond ((eq (car path) isom) path) ((eq (car path) ord) (cons (car path) (access_code (reverse (cdr path))))) ((eq (car path) rec) (cons (car path) (cons (cadr path) (access_code (reverse (cddr path)))))))))) ;access (defun stor (i rhs) (let ((path (access_path i %p))) (ifn (null path) (let ((ipath (reverse (cdr path)))) `(,(concatl `(r p l a c ,(car ipath))) ,(access_code (cdr ipath)) ,rhs))))) ;stor (defun copyst (s e) (cond ((atom s) e) ((and (not (atom e)) (not (atom (cdr e))) (memq (car e) '(cons list))) (list 'cons (copyst (car s) (cadr e)) (copyst (cdr s) (cond ((eq (car e) 'cons) (caddr e)) (t (cons 'list (cddr e))))))) (t (make-lambda-binding 'a e (copys s 'a))))) ;copyst (defun copys (s ans) (cond ((atom s) ans) (t (list 'cons (copys (car s) (list 'car ans)) (copys (cdr s) (list 'cdr ans)))))) ;;; Splits up pattern of letref and assigns to its parts ;;; Top-level letrefs are assigned using "setq", others via code from "stor" (defun storst (s arg) (cond ((or (eq s empty) (eq s nill)) nil) ((atom s) (cond ((stor s arg)) ((let ((lb (get-lisp-binding s))) (if lb #+franz `(setq ,lb ,arg) #-franz `(setf (symbol-value ',lb) ,arg) nil))) (t (lcferror '|no variable in translation of := |)))) (t (if (eq (car s) '%con) (storst (cdr s) `(cdr ,arg)) (list 'prog2 (storst (car s) (list 'car arg)) (storst (cdr s) (list 'cdr arg))))))) ;storst (defun bvpat (d) (varpat (cadr (if (memq (car d) '(mk-abstype mk-absrectype)) (caddr d) d)))) ;bvpat ;;; Experimental bugfix for top-level wildcards ;;; MJCG 21/10/90 for HOL88.1.12 ;;; MJCG 25/10/90 for HOL88.1.12 (defun varpat (s) (case (car s) ;;; (mk-empty empty) ((mk-empty mk-wildcard) empty) (mk-var (cadr s)) (mk-straint (varpat (cadr s))) ;;; (mk-wildcard '(%wild)) (mk-con0 '(%con)) (mk-appn (cons '%con (varpat (caddr s)))) ((mk-intconst mk-boolconst mk-tokconst) '%const) (mk-dupl (cons (varpat (cadr s)) (varpat (caddr s)))) (mk-binop (cons (varpat (caddr s)) (varpat (cadddr s)))) (mk-list (nconc (mapcar (function varpat) (cdr s)) nill)) (t (translation-failed "bad variable structure")))) ;varpat ;;; call tre, pushing new layer of environment (defun trex (new%p e) (let ((%p (cons new%p %p))) (tre e))) ;trex ;;; Translate expression ;;; Bugfix: ap changed to %ap ;;; MJCG 10 Nov 1990 for HOL88.1.12 (defun tre (e) (case (car e) ((mk-boolconst mk-intconst) (cadr e)) (mk-tokconst (qeval (cadr e))) (mk-quot (list 'qtrap (make-catch-form (make-lambda-binding '%vtyl nil `(quotation ,(trq (cadr e))))))) (mk-tyquot (list 'qtrap (make-catch-form `(list ,(trq (cadr e)))))) (mk-var (let ((acfn (access (cadr e)))) (cond ((eq (car acfn) isom) 'isomclosure) ((eq (car acfn) ord) (cdr acfn)) ((eq (car acfn) rec) (cddr acfn)) ((get-lisp-binding (cadr e)) ; global variable (let ((var (get-lisp-binding (cadr e)))) #+franz var #-franz `(symbol-value ',var) )) ((primval (cadr e))) ; predefined constant dml/dmlc ))) (mk-con (tre `(mk-abstr (mk-var x) (mk-appn ,e (mk-var x))))) (mk-con0 `(quote ,(cadr e))) (mk-fail (make-throw-form (list 'quote '|fail|))) ;new look (mk-failwith (make-throw-form (tre (cadr e)))) ;new look (mk-empty nil) (mk-dupl (testeval `(cons ,(tre (cadr e)) ,(tre (caddr e))))) (mk-list (testeval (cons 'list (mapcar (function tre) (cdr e))))) (mk-straint (tre (cadr e))) (mk-appn (cond ((eq (caadr e) 'mk-con) ;; application of constructor is special case `(cons (quote ,(cadadr e)) ,(tre (caddr e)))) ((eq (caadr e) 'mk-var) ;; application of variable is special case (let ((acfn (access (cadadr e))) (arg (tre (caddr e)))) (cond ((eq (car acfn) isom) arg) ((eq (car acfn) ord) `(%ap ,(cdr acfn) ,arg)) ((eq (car acfn) rec) `(,(cadr acfn) (cons ,arg (cdr ,(cddr acfn))))) ((let ((lb (get-lisp-binding (cadadr e)))) (if lb #+franz `(%ap ,lb ,arg) #-franz `(%ap (symbol-value ',lb) ,arg) nil))) ((fastap (cadadr e) arg)) (`(%ap ,(primval(cadadr e)) ,arg))))) (`(%ap ,(tre (cadr e)) ,(tre (caddr e)))))) (mk-binop (tre `(mk-appn (mk-var ,(cadr e)) (mk-dupl . ,(cddr e))))) (mk-unop (tre `(mk-appn . ((mk-var ,(cadr e)). ,(cddr e))))) (mk-seq `(cond (t . ,(nconc (mapcar (function tre) (cadr e)) (list (tre (caddr e))))))) (mk-assign (chkvarstr (cadr e) '|multiple occurrence of a variable in left-hand side of assignment| '|application of a non-constructor in left-hand side of assignment|) (make-lambda-binding 'a (checkst (cadr e) (tre (caddr e))) (storst (varpat (cadr e)) 'a) 'a)) (mk-while `(prog () $etiq$ (cond (,(tre (cadr e)) ,(tre (caddr e)) (go $etiq$)) (t (return nil))))) (mk-test (let ((%loop (genloop (cdr e)))) (let ((a (trarms t (cdr e)))) (cond (%loop (list 'prog nil (cadr %loop) a)) (t a))))) (mk-case (make-lambda-binding '%e `(cons ,(tre (cadr e)) %e) (tr-match (caddr e)))) (mk-trap (let ((%loop (genloop (cddr e)))) (let ((e0 (make-catch-form `(list ,(tre (cadr e))))) (a (trarms nil (cddr e)))) (if %loop (list 'prog '(b) (cadr %loop) (list 'setq 'b e0) a) (make-lambda-binding 'b e0 a))))) (mk-fun (let ((checkbody (tr-match (cadr e))) (newfun (if (null (cddr e)) (uniquesym 'FUN %timestamp) (caddr e)))) ;; store away as function to evaluate later (remember-tran-function newfun '(%e) (list checkbody)) ;; store curry binding, if any, for optimization (eval-remember `(putprop (quote ,newfun) (quote ,(currybind checkbody)) 'currybind)) ;; must use "quote" instead of "function" ;; to avoid binary bindings or expansion of function bodies ;; in compiled code, especially to allow optimization of function ;; calls `(cons (quote ,newfun) %e))) (mk-abstr (chkvarstr (cadr e) '|multiple occurrence of a variable in an abstraction| '|misplaced constructor in abstraction|) (let ((cl (checks (cadr e) '(car %e))) (body (trex (varpat (cadr e)) (caddr e)))) (let ((checkbody (gencheck cl body)) (newfun (if (null (cdddr e)) (uniquesym 'FUN %timestamp) (cadddr e)))) ;; store away as function to evaluate later (remember-tran-function newfun '(%e) (list checkbody)) ;; store curry binding, if any, for optimization (eval-remember `(putprop ',newfun ',(currybind checkbody) 'currybind)) ;; must use "quote" instead of "function" ;; to avoid binary bindings or expansion of function bodies ;; in compiled code, especially to allow optimization of function ;; calls `(cons (quote ,newfun) %e)))) ((mk-in mk-ina) (trin (cadr e) (caddr e))) (mk-ind (tre (caddr e))) (t (lcferror (cons e '(bad arg tre)))))) ;tre (defun trin (decl exp) (if (eq (car decl) 'mk-letrec) (let ((bvs (bvpat decl))) (let ((lispfuns (lispfunpat bvs))) `(let ((%e ,(let ((body (trex (cons rec (combinetree bvs lispfuns)) (inserttransfun (caddr decl) lispfuns)))) `(let ((%e (cons nil %e))) (rplaca %e ,body))))) ,(trex (cons rec (combinetree bvs lispfuns)) exp)))) `(let ((%e ,(trdecl decl))) ,(trex (bvpat decl) exp))) );trin (defun tr-match (funcase-list) (gencheckl (mapcar #'(lambda (funcase) (chkvarstr (car funcase) '|multiple occurrence of a variable in a pattern| '|misplaced constructor in pattern|) (cons (checks (car funcase) '(car %e)) (trex (varpat (car funcase)) (cdr funcase)))) funcase-list))) (defun combinetree (t1 t2) (ifn (null t1) (if (atom t1) (cons t1 t2) (cons (combinetree (car t1) (car t2)) (combinetree (cdr t1) (cdr t2)))))) (defun lispfunpat (pat) (ifn (null pat) (if (atom pat) (uniquesym 'FUN %timestamp) (cons (lispfunpat (car pat)) (lispfunpat (cdr pat)))))) (defun chkvarstr (x msg1 msg2) (chkvarstrx x nil msg1 msg2) x) ;chkvarstr ;;; accumulate checks in the idlst (defun chkvarstrx (x idlst msg1 msg2) (case (car x) (mk-straint (chkvarstrx (cadr x) idlst msg1 msg2)) (mk-var (ifn (memq (cadr x) idlst) (cons (cadr x) idlst) (translation-failed msg1))) (mk-appn (if (eq (caadr x) 'mk-con) (chkvarstrx (caddr x) idlst msg1 msg2) (translation-failed msg2))) (mk-dupl (chkvarstrx (caddr x) (chkvarstrx (cadr x) idlst msg1 msg2) msg1 msg2)) ((mk-wildcard mk-empty mk-con0 mk-intconst mk-boolconst mk-tokconst) idlst) (mk-con (translation-failed msg2)) (mk-list (itlist (function (lambda (x idlst) (chkvarstrx x idlst msg1 msg2))) (cdr x) idlst)) (t (if (and (eq (car x) 'mk-binop) (eq (cadr x) '|.|)) (chkvarstrx (cadddr x) (chkvarstrx (caddr x) idlst msg1 msg2) msg1 msg2) (translation-failed msg2))))) ;chkvarstrx (defun inserttransfun (e funpat) (case (car e) ((mk-abstr mk-fun) `(,@e ,funpat)) (mk-dupl `(mk-dupl ,(inserttransfun (cadr e) (car funpat)) ,(inserttransfun (caddr e) (cdr funpat)))) (mk-straint (inserttransfun (cadr e) funpat)) (t (translation-failed "bad use of letrec")))) ; inserttransfun ;;; primitive value from dml, dmlc, or "it" (defun primval (i) (cond ((null i) nil) ;new code for nil ((get i 'numargs) (qeval (mkclosure i))) ((get i 'mltype) `(get ',i 'mlval)) ;NEW -- "it" is now restricted (t (lcferror 'primval)))) ;primval (defun mkclosure (i) (cond ((get i 'closure)) (t (putprop i (lispfunclosure i) 'closure)))) ;mkclosure (defun lispfunclosure (i) (let ((in (get i 'numargs))) (cons `(lambda (%e) ,(cons (car in) (lispargs (cdr in) '(car %e)))) i) )) ;lispfunclosure (defun lispargs (n a) (cond ((zerop n) nil) ((= n 1) (list a)) (t (cons (list 'car a) (lispargs (sub1 n) (list 'cdr a)))))) ;lispargs ;;; apply an ML function to its arguments ;;; called in generated code ;;; Bugfix: ap changed to %ap ;;; MJCG 10 Nov 1990 for HOL88.1.12 (defun %ap (fn arg) (funcall (car fn) (cons arg (cdr fn)))) ;%ap ;;; Generate code to call a dml'd function directly, if it is called ;;; with the correct number of arguments (defun fastap (i arg) (let ((in (get i 'numargs))) (and in (fap (cdr in) arg (list (car in)))))) ;fastap (defun fap (n a r) (cond ((zerop n) r) ((= n 1) (nconc r (list a))) ((not (atom a)) (case (car a) (cons (fap (sub1 n) (caddr a) (nconc r (list (cadr a))))) (quote (cond ((atom (cdr a)) (lcferror 'fap)) ((fap (sub1 n) (qeval (cdadr a)) (nconc r (list (qeval (caadr a)))))))) (t nil))))) ;fap ;;; If function body has the form `(cons ,fun %e) then return "fun" ;;; Such bodies occur in code generated for curried ML functions (defun currybind (body) (ifn (atom body) ;to avoid destructuring a number (let ((x-cons (car body)) (x-quofun (cadr body)) (x-e (caddr body))) (if (and (eq x-cons 'cons) (consp x-quofun) (eq (car x-quofun) 'quote) (eq x-e '%e)) (cadr x-quofun))))) ;currybind (defun genloop (arms) (let ((looper #-franz (concat "" (symbol-name (gensym))) #+franz (concat "" (get_pname (gensym))))) (cond ((isloop arms) (list 'go looper))))) ;genloop (defun isloop (arms) (exists #'(lambda (a) (eq (car a) 'iter)) (nconc (cond ((cdr arms) (list (if (atom (caadr arms)) (cadr arms) (caadr arms))))) (car arms)))) ;isloop (defun trarms (%test arms) (nconc (cond (%test (list 'cond)) (t (list 'cond (list '(not (atom b)) (qreturn '(car b)))))) (mapcar (function (lambda (a) (cons (if %test (tre (cadr a)) (trtrap (cadr a))) (testtrap (car a) (tre (cddr a)))))) (car arms)) (cond ((cdr arms) (list (trlast (cadr arms)))) ((not %test) (list (list 't (make-throw-form 'b))))))) ;trarms (defun trtrap (e) (cond ((and (eq (car e) 'mk-list) (= (length (cdr e)) 1)) (list #+franz 'eq #-franz 'eql 'b (tre (cadr e)))) (t (list 'memq 'b (tre e))))) ;trtrap (defun testtrap (sort ans) (case sort (once (list (qreturn ans))) (iter (list ans %loop)) (t (lcferror (cons sort '(bad sort in testtrap)))))) ;testrap (defun qreturn (ans) (if %loop (list 'return ans) ans)) ;qreturn (defun trlast (a) (let ((z (cond ((atom (car a)) (testtrap (car a) (tre (cdr a)))) (t (testtrap (caar a) `(let ((%e (cons b %e))) ,(trex (cdar a) (cdr a)))))))) (cons 't z))) ;trlast (defun testeval (e) (if (is_constant e) (qeval (eval e)) e)) ;testeval (defun is_constant (e) (if (atom e) (or (numberp e) (memq e '(t nil))) (case (car e) (quote t) ((cons list) (forall 'is_constant (cdr e))) (t nil)))) ;is_constant (defun trb (b) (case (car b) ((mk-abstype mk-absrectype) (trabstyb (cadr b) (caddr b))) (t (chkvarstr (cadr b) "multiple occurrence of a variable in left hand side of a definition" "bad variable structure") (let ((rhs (checkst (cadr b) (tre (caddr b))))) (case (car b) (mk-letref (copyst (bvpat b) rhs)) (t rhs)))))) ;trb (defun trabstyb (eqnl d) (checkst (cadr d) `(let ((%e (cons dummy %e))) ,(trex (isompat eqnl) (caddr d))))) ;trabstyb ;;; lcp - absty, repty are now abs_ty, rep_ty ;;; must be consistent with code in F-typeml (defun isompat (eqnl) (cons isom (nconc (mapcar #'(lambda (eqn) (concat '|abs_| (car eqn))) eqnl) (mapcar #'(lambda (eqn) (concat '|rep_| (car eqn))) eqnl) ))) ;isompat (defun make-cond-case (cl ans) `(,(ifn cl t (ifn (cdr cl) (car cl) (cons 'and cl))) ,ans)) ;make-cond-case (defun gencheck (cl ans) (ifn cl ans `(cond ,(make-cond-case cl ans) (t ,(make-throw-form (list 'quote '|pattern|)))))) ;gencheck (defun gencheckl (cl-ans-list) `(cond ,@(mapcar #'(lambda (p) (make-cond-case (car p) (cdr p))) cl-ans-list) (t ,(make-throw-form (list 'quote '|pattern|))))) ;gencheckl (defun checkst (s ans) (let ((cl (checks s 'a))) (if (null cl) ans `(let ((a ,ans)) ,(gencheck cl 'a))))) ;checkst (defun checks (s arg) (case (car s) ((mk-empty mk-var mk-wildcard) nil) (mk-straint (checks (cadr s) arg)) (mk-con0 `((and (atom ,arg) (#+franz eq #-franz eql (quote ,(cadr s)) ,arg) ))) (mk-appn (ifn (eq (caadr s) 'mk-con) (translation-failed "bad variable structure (error 1)") (cons `(and (consp ,arg) (#+franz eq #-franz eql (car ,arg) ',(cadadr s))) (checks (caddr s) `(cdr ,arg))))) ((mk-intconst mk-boolconst) `((#+franz eq #-franz eql ,(cadr s) ,arg))) (mk-tokconst `((#+franz eq #-franz eql ',(cadr s) ,arg))) (mk-dupl (checks2 (cdr s) arg)) (mk-binop (cons arg (checks2 (cddr s) arg))) (mk-list (cons (list '= (list 'length arg) (length (cdr s))) (checksl (cdr s) arg))) (t (translation-failed "bad variable structure (error 2)"))));checks (defun checks2 (s2 arg) (nconc (checks (car s2) (list 'car arg)) (checks (cadr s2) (list 'cdr arg)))) ;checks2 (defun checksl (sl arg) (if (null sl) nil (nconc (checks (car sl) (list 'car arg)) (checksl (cdr sl) (list 'cdr arg))))) ;checksl ;;; Translate declaration (defun trdecl (d) (case (car d) ((mk-let mk-letref mk-abstype mk-absrectype) `(cons ,(trb d) %e)) (mk-letrec (let ((body (trex (varpat (cadr d)) (caddr d)))) `(let ((%e (cons nil %e))) (rplaca %e ,body)))) (t (lcferror (cons d '(bad decl)))))) ;trdecl ;;; Translate ML to Lisp. ;;; Set new%%lb to pattern of atoms for making Lisp bindings ;;; These atoms will allow reliable reference to ML variables. ;;; When compiled code is loaded, these same Lisp atoms will be set. ;;; Set %compfns to the defun's that must be eval'ed before evaluation of code ;;; Each function in %compfns is defined before its first use. Otherwise ;;; compilation can fail. (defun tran (pt) (setq %compfns nil) (setq new%%lb nil) (setq rec%env nil) (let ((pr (optimize-code (case (car pt) ((mk-deftype mk-type mk-rectype) nil) ((mk-let mk-letref mk-letrec mk-abstype mk-absrectype) (let ((bvs (bvpat pt))) (setq new%%lb (build-lb (car pt) bvs)) (if (eq (car pt) 'mk-letrec) `(cons (quote ,bvs) ,(trb `(mk-let ,(cadr pt) (mk-in ,pt ,(cadr pt))))) `(cons (quote ,bvs) ,(trb pt))))) (t (tre pt))) nil))) (do ((compfns %compfns (cdr compfns))) ((null compfns) (setq %compfns (nreverse %compfns))) (rplaca compfns (optimize-code (car compfns) nil))) ;; Retain compatibility with old franz versions. Do proper thing for CL #+franz pr #-franz `(lambda (%e) (declare (optimize (speed 2) (safety 0))) ,pr))) ;tran ;;; Optimize Lisp code. Lambda expressions inside quoted data may profitably ;;; be yanked out into separate functions which may then be compiled. ;;; Bugfix: ap changed to %ap ;;; MJCG 10 Nov 1990 for HOL88.1.12 (defun optimize-code (code inside-quote) (cond ((atom code) code) ((and (eq (car code) 'lambda) inside-quote) (let ((name (uniquesym 'FUN %timestamp)) (forms (optimize-code (cddr code) nil))) (remember-tran-function name (cadr code) forms) name)) ((eq (car code) 'quote) `(quote ,(optimize-code (cadr code) t))) ((eq (car code) '%ap) (optimize-ap code)) (t (trans-sexpr code inside-quote)))) ; optimize-code ;;; Unwind calls (f x y) where f is a curried function "\a. \b. body" ;;; call innermost function directly ;;; This optimization requires that closure functions be quoted with "quote" ;;; instead of "function" -- it needs the function name and not just its ;;; binding. Using "quote" probably slows execution in some cases, but most ;;; of them should be removed by this optimization. ;;; Bugfix: ap changed to %ap ;;; MJCG 10 Nov 1990 for HOL88.1.12 (defun optimize-ap (comb) (let ((code comb)(randstack nil)(lispfun nil)(env nil)(envcode nil)) ;;; strip off and stack operands, find inner function (while (and (consp code) (eq (car code) '%ap)) (push (optimize-code (caddr code) nil) randstack) ; save rand (setq code (optimize-code (cadr code) nil))) ; look at rator (cond (#+franz (and (atom code) (memq (car (explode-word code)) '(mk-let mk-letrec mk-abstype mk-absrectype))) #-franz (and (consp code) (eq (car code) 'symbol-value) (memq (car (explode-word (cadadr code))) '(mk-let mk-letrec mk-abstype mk-absrectype))) ;; this is call to top-level ML function (not letref) ;; macro-expand what "ap" would execute (now %ap, MJCG 10 Nov 1990) (setq env (eval code)) (setq lispfun (car env)) (setq env (cdr env)) ;; keep environment if there is one - could be `(quote ,env) ;; here except that could be circular (so unable to dump to ;; file when compiling) (setq envcode `(cons ,(pop randstack) ,(if env `(cdr ,code) nil))) (while (and randstack (get lispfun 'currybind)) (setq lispfun (get lispfun 'currybind)) (setq envcode `(cons ,(pop randstack) ,envcode))) (setq code `(,lispfun ,envcode))) ((and (consp code) (eq (car (explode-word (car code))) 'FUN)) (setq lispfun (car code)) (setq envcode (cadr code)) (while (and randstack (get lispfun 'currybind)) (setq lispfun (get lispfun 'currybind)) (setq envcode `(cons ,(pop randstack) ,envcode))) (setq code `(,lispfun ,envcode)))) ;;; build up ordinary calls for remaining rands (while randstack (setq code `(%ap ,code ,(pop randstack)))) code)) ;;; Map optimize-code over an S-expression, preserving its structure ;;; cannot use mapcar since not all S-expressions are lists (defun trans-sexpr (code inside-quote) (if (atom code) code (cons (optimize-code (car code) inside-quote) (trans-sexpr (cdr code) inside-quote)))) ;trans-sexpr ;;; Build Lisp Binding for declaration "dc" and bound vars "bvs" ;;; a pattern of new atoms corresponding to new ML names being declared ;;; the atoms contain the declaration class in order to distinguish ;;; the "letrefs" -- for correct optimization (defun build-lb (dc bvs) (if (atom bvs) (if (eq bvs '%con) '%con (uniquesym dc bvs)) (cons (build-lb dc (car bvs)) (build-lb dc (cdr bvs))))) ;build-lb ;;; Translate quotation. (defun trq (e) (let ((qfun (assq1 (car e) %q-trans-args))) (if qfun (cons qfun (mapcar (function trq) (cdr e))) (let ((qfun (assq1 (car e) %q-quote-arg))) (if qfun `(,qfun (quote ,(cadr e))) (case (car e) (MK=ANTIQUOT `(q-mk_antiquot ,(tre (cadr e)))) (MK=TYPE=ANTIQUOT (tre (cadr e))) (MK=PREDICATE `(q-mk_pred (quote ,(cadr e)) ,(trq (caddr e)))) (MK=TYPE `(q-mk_type (quote ,(cadr e)) (list . ,(mapcar (function trq) (cddr e))))) (t (lcferror (cons e '(bad arg trq)))))))))) ; trq hol88-2.02.19940316/lisp/f-thyfns.l0000640000212700021270000010545705071123342014617 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-thyfns.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions relating to theories ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: thyfns (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V1.4 : Arbitrary non-empty tokens allowed as names of axioms & theorems ;;; ;;; Theories represented by a lisp structure %theorydata rather than ;;; ;;; by a text file. Structure of drafts and theories changed. ;;; ;;; Functions axioms types operators infixes parents added. ;;; ;;; ;;; ;;; V1.3 : newinfix replaces newolinfix and newolcinfix. The authorized ;;; ;;; constants/infixes symbols declared in legalconsts. Feb 82, GH ;;; ;;; ;;; ;;; V1.2 : Files names and headers changed, Dec. 1981, G.Huet ;;; ;;; ;;; ;;; V2.2 : exit instead of err ;;; ;;; exit if error while loading ;;; ;;; ;;; ;;; V4: deleted closeup and dischall, which are better implemented in ML ;;; ;;; ;;; ;;; V4.1 : timestamps GH ;;; ;;; ;;; ;;; V4.2 : removed obsolete special declarations. ;;; ;;; removed message functions; failure tokens include messages. ;;; ;;; reduced use of %theorydata and %theorems. ;;; ;;; theory cache, ;;; ;;; extend_theory, new_theory, close_theory replace make_theory ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Sets Manifests: dash olreserved legalconsts ;;; Sets Globals: %current, %kind, %ancestry ;;; %theorydata, %theorems ;;; Specials: %e, %newtypes, %newconsts (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec")) #+franz (declare (localf defaultp currentp ancestorp add-ancestor not-theory not-draft not-init neg-arity polym not-ancestor clash bad-or-clash add-to-chapter replace-chapter get-chapter update-thm load-theory-parent basic-update-cache update-cache open-thy-file thy-read load-theorydata load-theorems load-thy-threms get-thy-tree get-parent remty remcon add-const-pred save-axiom-thm get-axiom-thm abs-thm extract-axioms-thms flush-draft write-thy-file abs-form abs-term cond-abs-type abs-type encode-thm encode-form encode-term encomb new-sharetype encode-type)) ;;; initialise manifests outside of initial%load (setq dash '|-|) (setq olreserved nil) ;NEW used to contain ^ (setq legalconsts '(|/| |#| |*| |+| |-| |<| |=| |>| |?| |@|)) ;NEW used to be same as ;infixables in LCF now ^ forbidden ~ { } % allowed (setq %loading-thy nil) (eval-when (load) (when initial%load ; Globals (setq %current '-) ; Settings to enable (setq %kind 'init) ; pplamb in system load (setq %newconsts nil) (setq %newtypes nil) (setq %ancestry nil) (setq %thy-cache nil))) (defun defaultp (tok) (eq tok dash)) (defun currentp (tok) (eq tok %current)) ;currentp (defun ancestorp (tok) (member-equal tok %ancestry)) ;ancestorp (defun add-ancestor (tok) (ifn (ancestorp tok) (push tok %ancestry))) ;add-ancestor ;;; Functions that produce error messages ;;; if no error, they return nil ;;; most are called by the theory extension functions (new_constant, ...) ;;; which create new theories (where %loading-thy is nil) ;;; and load existing ones (where %loading-thy is t) (defun not-theory () (ifn (eq %kind 'theory) "only allowed in a theory")) ;not-theory ;;; MJCG 22/11/88 for HOL88 ;;; ML function to tell if one is in draft mode (defun ml-draft_mode () (eq %kind 'draft)) (dml |draft_mode| 0 ml-draft_mode (|void| |->| |bool|)) (defun not-draft () (ifn (or %loading-thy (eq %kind 'draft)) "Legal only in drafts") ) ;not-draft (defun not-init () (ifn (eq %kind 'init) "only allowed in new session")) ;not-init (defun neg-arity (n tok) (if (lessp n 0) (catenate tok " has negative arity"))) ;neg-arity (defun polym (tok ty) (if (opoly ty) (catenate tok " would be polymorphic"))) ;polym (defun not-ancestor (tok) (ifn (ancestorp tok) (catenate tok " is not an ancestor"))) ;not-ancestor ;;; check if the token is acceptable for the given sort (defun bad (sort tok) (ifn %loading-thy (if (case sort (theory (not (filetokp sort tok))) (type (or (member-equal tok olreserved) (not (idenp tok)))) ((constant infix) (or (member-equal tok olreserved) (not (or (eq tok '|()|) (idenp tok) (nump tok) (member-equal tok legalconsts))))) (t nil)) (catenate tok " cannot be " sort " token"))) ) ;bad ;;; MJCG 22/11/88 for HOL88 ;;; ML function to test whether a string could be (or is) a constant ;;; Bugfix 3/12/90 by MJCG for HOL88.1.12. TFM period bug fixed. (defun ml-allowed_constant (str) (not (or (eq str period-sym) (bad 'constant str)))) (dml |allowed_constant| 1 ml-allowed_constant (|string| -> |bool|)) ;;; check that the given token has not already been used for the sort ;;; must be performed when either loading or creating a theory (defun clash (sort tok) (cond ((case sort (theory (fileexists 'theorydata tok)) (type (get tok 'olarity)) ((constant infix) (setq sort (cond ((get tok 'olinfix) 'infix) ((get tok 'const) 'constant))))) (catenate tok " clashes with existing " sort))) ) ;clash (defun bad-or-clash (sort tok) (or (bad sort tok) (clash sort tok))) ;bad-or-clash (dml |new_theory| 1 ml-new_theory (|string| -> |void|)) ;;; Set up lists to hold data for a draft ;;; Since structures are modified destructively, "copy" is called (defun ml-new_theory (thy) (cond-failwith "new_theory" (bad-or-clash 'theory thy)) (flush-draft) (setq %newconsts nil) (setq %newtypes nil) (setq %date (clock)) (setq %theorydata (copy-tree `((parents . ,(ifn (eq %kind 'init) (list %current))) (types) (nametypes) (operators) (paired-infixes) (curried-infixes) (predicates) (version . ,%version) (stamp . ,%date)))) ;stamp with draft-setting time (setq %theorems (copy-tree '((sharetypes 0) (axiom) (fact)))) (setq %kind 'draft) (add-ancestor thy) (setq %current thy) ) ;ml-new_theory (dml |close_theory| 0 ml-close_theory (|void| -> |void|)) ;;; terminate draft mode and write theory file (defun ml-close_theory () (cond-failwith "close_theory" (not-draft)) (flush-draft) (setq %kind 'theory) ) ; ml-close_theory ;;; Add an element to a chapter of the current draft in %theorydata ;;; do nothing if called during loading of an existing theory (defun add-to-chapter (sort value) (cond ((not %loading-thy) (let ((chapter (assq sort %theorydata))) (rplacd chapter (cons value (cdr chapter)))))) ) ;add-to-chapter ;;; Replace an existing chapter of the draft in %theorydata (defun replace-chapter (sort value) (let ((chapter (assq sort %theorydata))) (rplacd chapter value))) ;replace-chapter ;;; get a chapter of a draft or theory (defun get-chapter (thydata sort) (cdr (assq sort thydata))) ; get-chapter ;;; Update a field of threms (defun update-thm (threms sort factname thm) (let ((thl (assq sort threms))) (if (assoc-equal factname (cdr thl)) (msg-failwith %failtok factname " clashes with existing " sort) (rplacd thl (cons (cons factname (encode-thm threms thm)) (cdr thl)))) )) ; update-thm (dml |load_theory| 1 ml-load_theory (|string| -> |void|)) ;;; Load an existing theory -- must be descendant of current theory ;;; Must already be in some theory (possibly PPLAMBDA), not in a draft ;;; Allowed in init mode (the empty theory) NEW (defun ml-load_theory (thy) (let ((%failtok "load_theory")) (load-theory-parent thy)) (setq %kind 'theory) ) ;ml-load_theory (dml |extend_theory| 1 ml-extend_theory (|string| -> |void|)) ;;; allow the user to extend an existing theory (defun ml-extend_theory (thy) (let ((%failtok "extend_theory")) (load-theory-parent thy)) (setq %kind 'draft) ) ;ml-extend_theory (dml |new_parent| 1 ml-new_parent (|string| -> |void|)) ;;; add a new parent to the current draft (defun ml-new_parent (thy) (cond-failwith "new_parent" (not-draft)) (let ((%failtok "new_parent")) (load-theory-parent thy)) (add-to-chapter 'parents thy)) ;ml-new_parent ;;; return the ancestors of the current theory in ML (defun ml-ancestry () %ancestry) (dml |ancestry| 0 ml-ancestry (|void| -> (|string| |list|))) ;;; Load a theory at top-level for load_theory, extend_theory, or new_parent (defun load-theory-parent (thy) (let ((prev-ancestry %ancestry) (%newtypes nil) (%newconsts nil) (%new-ancestors nil) (%loading-thy t)) (failtrap ; if any failure then unload the new theory #'(lambda (errtok) (unload-theory thy prev-ancestry) (failwith errtok)) (let ((thydata (get-thy-tree thy))) (cond ((member-equal %failtok '("load_theory" "extend_theory")) (cond ((or ; check ancestry (time-stamp check suppressed) (eq %kind 'init) (member-equal %current %new-ancestors)) (flush-draft) (setq %date (get-chapter thydata 'stamp)) (setq %theorydata thydata) (setq %theorems (load-theorems thy)) (setq %current thy)) (t (msg-failwith %failtok "not a descendant of " %current))))) (llprinc "Theory ")(llprinc thy)(llprinc " loaded")(llterpri)))) ) ;load-theory-parent ;;; The theory cache is not just for speed. ;;; It also avoids the need to find theory files on remote directories ;;; particularly PPLAMB, which is on the system builder's directory, ;;; and which is an ancestor of every theory. ;;; Eventually we will need a better treatment of remote theories ;;; an alternative is to provide a cache for time-stamps only, since we ;;; must always check the time-stamp of a parent, even if it is loaded already ;;; the parent PPLAMB is never checked anyway, since it is re-built often. ;;; update theory cache (defun basic-update-cache (thy data) (if (defaultp thy) (setq thy %current)) (let ((entry (assoc-equal thy %thy-cache))) (if entry (rplacd entry data) (push (cons thy data) %thy-cache))) ) ; basic-update-cache (defun update-cache (thy thydata threms) (basic-update-cache thy (cons thydata threms)) ) ; update-cache ;;; needed after proving a theorem in a session concurrent with this one (dml |delete_cache| 1 ml-delete_cache (|string| -> |void|)) (defun ml-delete_cache (thy) (basic-update-cache thy nil) ) ; delete-cache ;;; MJCG 7/2/89 for HOL88 ;;; Function to return the lists of cached theories and uncached theories (defun ml-cached_theories () (mapcar (function(lambda (x) (cons (car x) (null(cdr x))))) %thy-cache)) (dml |cached_theories| 0 ml-cached_theories (|void| -> ((|string| |#| |bool|) |list|))) ;;; the globals %theorydata and %theorems hold the %current theory ;;; MJCG 13/10/88 for HOL88 ;;; find-file wrapped around fileof ;;; open and return a channel to the theory file ;;; if the thy is already loaded, return (thydata . threms) ;;; N.B. The error trapping stops working if one ^Ds into Lisp ;;; and then tmls back into ML (MJCG 21/3/89). (defun open-thy-file (thy) (if (defaultp thy) (setq thy %current)) (cond ((currentp thy) (cons %theorydata %theorems)) ((assoc1 thy %thy-cache)) (t (cond-failwith %failtok (not-ancestor thy)) (errortrap #'(lambda (ertok) (msg-failwith %failtok thy " theory missing")) (infile (find-file (fileof 'theorydata thy))))))) ;;; read, reporting any errors (defun thy-read (thy #+franz piport #-franz *standard-input*) (second ; to ignore the (quote ...) -- temporary?? (third ; to ignore the (setq %theorydata...) (errortrap #'(lambda (ertok) (msg-failwith %failtok thy " theory damaged")) (llread))))) ; thy-read ;;; load the given theory and return the value of its theorydata field ;;; does not enter into cache, since theorydata is only needed ;;; when first loading theory hierarchy (defun load-theorydata (thy) (let ((channel (open-thy-file thy))) (if (consp channel) (car channel) (prog1 (thy-read thy channel) (close channel)) ))) ; load-theorydata ;;; load the given theory and return its theorems field, update cache (defun load-theorems (thy) (cdr (load-thy-threms thy)) ) ; load-theorems ;;; load a theory and return its theorydata and theorems fields ;;; also save them in the cache (defun load-thy-threms (thy) (let ((channel (open-thy-file thy))) (cond ((consp channel) channel) (t (let ((thydata (thy-read thy channel))) (let ((threms (thy-read thy channel))) (close channel) (update-cache thy thydata threms) (cons thydata threms)))))) ) ; load-thy-threms ;;; load a theory hierarchy, return theorydata of root ;;; must return theorydata even if theory is already loaded, ;;; in order to check the time-stamp. ;;; side-effect -- store the types, constants, etc. of the hierarchy (defun get-thy-tree (thy) (push thy %new-ancestors) (cond ((ancestorp thy) (load-theorydata thy)) (t (add-ancestor thy) (let ((thydata (load-theorydata thy))) ;parents (let ((%date (get-chapter thydata 'stamp))) (mapc #'get-parent (get-chapter thydata 'parents))) ;types (mapc #'(lambda (type) (ml-new_type (car type)(cdr type))) (get-chapter thydata 'types)) ;nametypes (mapc #'(lambda (type) (ml-new_type_abbrev (car type)(cdr type))) (get-chapter thydata 'nametypes)) ;constants (mapc #'(lambda (con) (ml-new_constant (car con)(cdr con))) (get-chapter thydata 'operators)) ;paired infixes (mapc #'(lambda (infix) (ml-new_paired_infix (car infix)(cdr infix))) (get-chapter thydata 'paired-infixes)) ;curried infixes (mapc #'(lambda (infix) (ml-new_curried_infix (car infix)(cdr infix))) (get-chapter thydata 'curried-infixes)) ;predics (mapc #'(lambda (pred) (ml-new_predicate (car pred)(cdr pred))) (get-chapter thydata 'predicates)) thydata)))) ;get-thy-tree ;;; get a parent for get-thy-tree, and check its stamp (defun get-parent (par) (failtrap #'(lambda (errtok) ; put suffix onto any failure (msg-failwith errtok " ancestor " par)) (let ((pardata (get-thy-tree par))))) ) ; get-parent ;;; LP -- deleted this time-stamp check from inside the "let" ;;; it doesn't work with extend_theory ;;; instead of checking the order of time stamps, it should check for an ;;; exact match (associate a time-stamp with each parent) ;;; (ifn (lessp (get-chapter pardata 'stamp) %date) ;;; (msg-failwith %failtok "time stamps out of sequence")))) ;;; An error occurred while loading theories, so undo new definitions ;;; It may seem cleaner to not store the constants and types until we know ;;; that the load was successful, but this is impossible since loading ;;; a theory requires the environment of its parents to be set up. (defun unload-theory (tok prev-ancestry) (mapc #'remcon %newconsts) ;restore constants (mapc #'remty %newtypes) ;and types (setq %ancestry prev-ancestry) ;and ancestors ) ;unload-theory ;;; Remove a type (defun remty (tok) (remprop tok 'canon) (remprop tok 'olarity)) ;remty ;;; Remove a constant or predicate (defun remcon (tok) (remprop tok 'const) (remprop tok 'predicate) (remprop tok 'olinfix) (remprop tok 'ol2) ; used in OL parser (remprop tok 'ollp)) ;remcon ;;; functions for building drafts ;;; called by get-thy-tree to load an existing theory ;;; or from ML to construct new draft (dml |paired_new_type| 2 ml-new_type ((|int| |#| |string|) -> |void|)) (defun ml-new_type (n tok) (cond-failwith "new_type" (not-draft) (bad-or-clash 'type tok) (neg-arity n tok)) (push tok %newtypes) (add-to-chapter 'types (cons n tok)) (putprop tok n 'olarity) (if (= n 0) (putprop tok (cons tok nil) 'canon))) ;ml-new_type ;;; Modification J.Joyce Apr 87 - vertical bars |new_type_abbrev| ;;; doesn't work for now, the nametypes are not expanded properly ;;; if this is re-introduced, nametypes should be expanded at parse time (dml |new_type_abbrev| 2 ml-new_type_abbrev ((|string| |#| |type|) -> |void|)) (defun ml-new_type_abbrev (tok ty) (cond-failwith "new_type_abbrev" (not-draft) (bad-or-clash 'nametype tok) (polym tok ty)) (push tok %newtypes) (add-to-chapter 'nametypes (cons tok ty)) (putprop tok 0 'olarity) (putprop tok ty 'canon) ) ;;; Stuff below deleted for HOL (MJCG can't understand it!) ;;; (cond ((cdr ty)(putprop tok (cons (car ty) (cdr ty)) 'eqtype) ;;; (rplaca (rplacd ty nil) tok)))) ;ml-new_type_abbrev ;;; add a new constant or predicate to the current theory (defun add-const-pred (chap prop tok ty) (let ((aty (abs-type ty))) (push tok %newconsts) (add-to-chapter chap (cons tok aty)) (putprop tok aty prop))) ; add-const-pred ;;; LP - I really don't like new_operator... how is TT an operator? ;;;(dml |new_operator| 2 ml-new_constant ((|string| |#| |type|) -> |void|)) (dml |new_constant| 2 ml-new_constant ((|string| |#| |type|) -> |void|)) (defun ml-new_constant (tok ty) (cond-failwith "new_constant" (not-draft) (bad-or-clash 'constant tok)) (add-const-pred 'operators 'const tok ty) ) ;ml-new_constant ;;;(dml |new_paired_infix| 2 ml-new_paired_infix ((|string| |#| |type|) -> |void|)) ;;; Now called new_infix [TFM 91.03.17] (dml |new_infix| 2 ml-new_curried_infix ((|string| |#| |type|) -> |void|)) ;;; Declare paired infix operator (defun ml-new_paired_infix (tok ty) (cond-failwith '|new_paired_infix| (not-draft) (bad-or-clash 'infix tok)) (ifn (and (eq (get-type-op ty) '|fun|) (eq (get-type-op (first (get-type-args ty))) '|prod|)) (msg-failwith '|new_paired_infix| tok " is not a function on pairs")) (add-const-pred 'paired-infixes 'const tok ty) (olinfix tok 'paired) ) ;ml-new_paired_infix ;;; Declare curried infix operator (defun ml-new_curried_infix (tok ty) (cond-failwith "new_curried_infix" (not-draft) (bad-or-clash 'infix tok)) (ifn (and (eq (get-type-op ty) '|fun|) (eq (get-type-op (second (get-type-args ty))) '|fun|)) (msg-failwith "new_curried_infix" tok " is not a curried function")) (add-const-pred 'curried-infixes 'const tok ty) (olinfix tok 'curried) ) ;ml-new_curried_infix (dml |new_predicate| 2 ml-new_predicate ((|string| |#| |type|) -> |void|)) (defun ml-new_predicate (tok ty) (cond-failwith "new_predicate" (not-draft) (bad-or-clash 'constant tok)) (add-const-pred 'predicates 'predicate tok ty) ) ;ml-new_predicate (dml |new_open_axiom| 2 ml-new_open_axiom ((|string| |#| |form|) -> |thm|)) (defun ml-new_open_axiom (factname fm) (cond-failwith "new_axiom" (not-draft)) (let ((%failtok "new_axiom")) (save-axiom-thm 'axiom factname fm)) ) ;ml-new_open_axiom ;;; cannot save theorems with assumptions, as it would be difficult ;;; to re-load them using the quotation mechanism ;;; renamed to "save_thm" [TFM 90.12.01] (dml |save_thm| 2 ml-save_thm ((|string| |#| |thm|) -> |thm|)) (defun ml-save_thm (factname thm) (if (get-hyp thm) (msg-failwith "save_thm" "cannot save theorems with hypotheses")) (let ((%failtok "save_thm")) (save-axiom-thm 'fact factname (get-concl thm))) ) ;ml-save_thm ;;; save an axiom or theorem on the current theory-draft (defun save-axiom-thm (sort factname fm) (let* ((consthydatathrems (load-thy-threms %current)) (thydata (car consthydatathrems)) (threms (cdr consthydatathrems)) (thm (make-thm nil (ml-rename_form fm)))) (update-thm threms sort factname thm) (write-thy-file %current thydata threms) thm)) ; save-axiom-thm (dml |paired_delete_thm| 2 ml-delete_thm ((|string| |#| |string|) -> |thm|)) ;;; returns the theorem, in case you delete the wrong one by mistake (defun ml-delete_thm (thy factname) (if (defaultp thy) (setq thy %current)) (let ((%failtok "delete_thm")) (let* ((consthydatathrems (load-thy-threms thy)) (thydata (car consthydatathrems)) (threms (cdr consthydatathrems))) (let ((thl (assq 'fact threms))) (let ((thpair (assoc-equal factname (cdr thl)))) (cond (thpair (delq thpair thl) (write-thy-file thy thydata threms) (abs-thm threms (cdr thpair))) (t (msg-failwith "delete_thm" factname " not found on theory " thy))))))) ) ; ml-delete_thm (dml |axiom| 2 ml-axiom ((|string| |#| |string|) -> |thm|)) (defun ml-axiom (thy factname) (let ((%failtok "axiom")) (get-axiom-thm 'axiom thy factname)) ) ;ml-axiom (dml |paired_theorem| 2 ml-theorem ((|string| |#| |string|) -> |thm|)) (defun ml-theorem (thy factname) (let ((%failtok "theorem")) (get-axiom-thm 'fact thy factname)) ) ;ml-theorem ;;; Get the axiom or theorem (sort) named factname from the theory thy (defun get-axiom-thm (sort thy factname) (if (defaultp thy) (setq thy %current)) (let ((threms (load-theorems thy))) (let ((result (assoc-equal factname (cdr (assq sort threms))))) (if result (abs-thm threms (cdr result)) (msg-failwith %failtok factname " not found on theory " thy)))) ) ; get-axiom-thm ;;; Re-build a theorem from its abstract form retrieved form the file ;;; Sets up proper internal format of variables and types ;;; Also links up the "sharetypes" used to save space on files ;;; invokes quotation system (F-typeol, F-ol-syntax) (defun abs-thm (threms thm) (let ((%sharetypes (cddr (assq 'sharetypes threms)))) (make-thm nil (failtrap #'(lambda (ftok) (lcferror (catenate ftok " -- while reading theory file"))) (car (let ((%vtyl nil)) (quotation (abs-form thm))))))) ) ;abs-thm (dml |axioms| 1 ml-axioms (|string| -> ((|string| |#| |thm|) |list|))) (defun ml-axioms (thy) (let ((%failtok "axioms")) (extract-axioms-thms 'axiom thy)) ) ;ml-axioms (dml |theorems| 1 ml-theorems (|string| -> ((|string| |#| |thm|) |list|))) (defun ml-theorems (thy) (let ((%failtok "theorems")) (extract-axioms-thms 'fact thy)) ) ;ml-theorems ;;; ===================================================================== ;;; TFM 07.04.90 for HOL88.1.12 ;;; ML function to test whether an axiom (or definition) is stored under ;;; a given name in a given theory. (defun ml-is_axiom (thy name) (if (defaultp thy) (setq thy %current)) (let ((%failtok "is_axiom")) (let* ((threms (cdr (load-theorems thy))) (thl (assq 'axiom threms))) (if (assoc name (cdr thl)) t nil)))) (dml |is_axiom| 2 ml-is_axiom ((|string| |#| |string|) -> |bool|)) ;;; ===================================================================== (defun extract-axioms-thms (sort thy) (if (defaultp thy) (setq thy %current)) (let ((threms (load-theorems thy))) (mapcar #'(lambda (name-thm) (cons (car name-thm) (abs-thm threms (cdr name-thm)))) (cdr (assq sort threms)))) ) ; extract-axioms-thms ;;; MJCG 31/1/89 for HOL88 (defun ml-current_theory () %current) (dml |current_theory| 0 ml-current_theory (|void| -> |string|)) (dml |constants| 1 ml-constants (|string| -> (|term| |list|))) (defun ml-constants (thy) (let ((%failtok "constants")) (extract-chapter thy 'operators))) ;;; no paired infixes in HOL. [TFM 91.03.17] ;;;(dml |paired_infixes| 1 ml-paired_infixes (|string| -> (|term| |list|))) ;;;(defun ml-paired_infixes (thy) ;;; (let ((%failtok "paired_infixes")) ;;; (extract-chapter thy 'paired-infixes))) ;ml-infixes ;;; Now called infixes [TFM 91.03.17] (dml |infixes| 1 ml-curried_infixes (|string| -> (|term| |list|))) (defun ml-curried_infixes (thy) (let ((%failtok "curried_infixes")) (extract-chapter thy 'curried-infixes))) ;ml-curried_infixes ;;;(dml |predicates| 1 ml-predicates (|string| -> ((|string| |#| |type|) |list|))) ;;;(defun ml-predicates (thy) ;;; (let ((%failtok "predicates")) ;;; (extract-chapter thy 'predicates))) ;ml-predicates (dml |parents| 1 ml-parents (|string| -> (|string| |list|))) (defun ml-parents (thy) (let ((%failtok "parents")) (extract-chapter thy 'parents))) ;ml-parents (dml |types| 1 ml-types (|string| -> ((|int| |#| |string|) |list|))) (defun ml-types (thy) (let ((%failtok "types")) (extract-chapter thy 'types))) ;ml-types (dml |type_abbrevs| 1 ml-nametypes (|string| -> ((|string| |#| |type|) |list|))) (defun ml-nametypes (thy) (let ((%failtok "nametypes")) (extract-chapter thy 'nametypes))) ;ml-nametypes (defun extract-chapter (thy kind) (if (defaultp thy) (setq thy %current)) (let ((thydata (load-theorydata thy))) ; 'extract-chapter (let ((chapter (get-chapter thydata kind))) (case kind ((parents types nametypes predicates) chapter) ((operators paired-infixes curried-infixes) (mapcar #'(lambda (con) (ml-mk_const (car con) (abs-type (cdr con)))) chapter)) (t (lcferror '(bad kind in extract-chapter))))) )) ;extract-chapter (defun flush-draft () (if (eq %kind 'draft) (write-thy-file %current %theorydata %theorems)) ) ; flush-draft ;;; MJCG 13/10/88 for HOL88 ;;; find-file wrapped around fileof ;;; Write out theory `thy` ;;; First line is thydata : types, constants, infixes ;;; Second line is threms : axioms, facts, and sharetypes for them (defun write-thy-file (thy thydata threms) (let ((%outport (outfile (find-file (fileof 'theorydata thy)))) ($gcprint nil)) (hol-print-file `(setq %theorydata (quote ,thydata))) (hol-print-file `(setq %theorems (quote ,threms))) (close %outport)) (update-cache thy thydata threms) ) ;write-thy-file ;;;Build the abstract syntax of fm s.t. fm=quotch[abs-form[fm]] (defun abs-form (fm) (case (form-class fm) (conj (q-mk_conj (abs-form (get-left-form fm)) (abs-form (get-right-form fm)))) (disj (q-mk_disj (abs-form (get-left-form fm)) (abs-form (get-right-form fm)))) (imp (q-mk_imp (abs-form (get-left-form fm)) (abs-form (get-right-form fm)))) ;;; (iff (q-mk_iff (abs-form (get-left-form fm)) DELETED [TFM 90.01.20] ;;; (abs-form (get-right-form fm)))) (forall (q-mk_forall (abs-term (get-quant-var fm)) (abs-form (get-quant-body fm)))) (exists (q-mk_exists (abs-term (get-quant-var fm)) (abs-form (get-quant-body fm)))) (pred (q-mk_pred (get-pred-sym fm) (abs-term (get-pred-arg fm)))) (t (lcferror '(bad axiom or theorem))))) ;abs-form ;;; note that in general [abs-form [quotch abs]] # abs. for instance, ;;; (q-mk_pair x y) becomes (q-mk_comb (q-mk_comb (q-mk_tok pair) x) y). (defun abs-term (tm) ;builds the abstract syntax of tm (case (term-class tm) (var (cond-abs-type (q-mk_var (get-var-name tm)) (get-type tm))) (const (cond-abs-type (q-mk_const (get-const-name tm)) (get-type tm))) (comb (cond-abs-type (q-mk_comb (abs-term (get-rator tm))(abs-term (get-rand tm))) (get-type tm))) (abs (q-mk_abs (abs-term (get-abs-var tm))(abs-term (get-abs-body tm)))) (t (lcferror '(bad axiom or theorem))))) ;abs-term ;;; Include type if present ;;; to save space, redundant types are not stored on theory files (defun cond-abs-type (tm ty) (if ty (q-mk_typed tm (abs-type ty)) tm)) ;;; build up a pplambda type, linking in %sharetypes (defun abs-type (ty) (case (type-class ty) (%t (abs-type (cdr (assq (cdr ty) %sharetypes)))) (%VARTYPE (q-mk_vartype (get-vartype-name ty))) (t (q-mk_type (get-type-op ty) (mapcar #'abs-type (get-type-args ty)))) )) ;abs-type ;;; Encode a theorem for storage on a theory file ;;; throw away redundant information to save space ;;; types stored in `comb` and `abs` nodes are ignored anyway ;;; Side-effect -- record new shared types (defun encode-thm (threms thm) (let ((share (assq 'sharetypes threms))) (let ((%sharecount (cadr share)) (%sharetypes (cddr share))) (let ((ethm (encode-form (cdr thm)))) (rplacd share (cons %sharecount %sharetypes)) ethm)))) ; encode-thm (defun encode-form (fm) (case (car fm) ((conj disj imp) ; iff deleted [TFM 90.01.20] (make-conn-form (get-conn fm) (encode-form (get-left-form fm)) (encode-form (get-right-form fm)))) ((forall exists) (make-quant-form (get-quant fm) (encode-term (get-quant-var fm) t) (encode-form (get-quant-body fm)))) (pred (make-pred-form (get-pred-sym fm) (encode-term (get-pred-arg fm) t))) (t (lcferror '(bad axiom or theorem))))) ;encode-form ;;; Space reduction for terms: ;;; don't write the types of "abs" and "comb" nodes ;;; don't write the type of a monomorphic constant ;;; share types of constants and variables ;;; Write type only if "needty" is true -- otherwise type is redundant (defun encode-term (tm needty) (case (term-class tm) (var (let ((tok (get-var-name tm)) (ty (get-type tm))) (make-var tok (if needty (new-sharetype tok ty))))) (const (let ((tok (get-const-name tm)) (ty (get-type tm))) (make-const tok (if (and needty (opoly (constp tok))) (new-sharetype tok ty))))) (comb (encomb tm needty)) (abs (make-abs (encode-term (get-abs-var tm) needty) (encode-term (get-abs-body tm) needty) nil)) (t (lcferror '(bad axiom or theorem))))) ;encode-term ;;; LP - can this be coded recursively? ;;; Encode a combination ;;; Type suppression taken from "F-writol/print-tm" ;;; If the innermost rator is a polymorphic constant, don't output its type ;;; instead output types of all rands and of the result type ;;; The type of the rator determines all the other types (defun encomb (tm needty) (let ((rator tm) (rands nil) (ans nil)) (while (eq 'comb (term-class rator)) (push (get-rand rator) rands) (setq rator (get-rator rator))) (let ((pcrator (and (eq 'const (term-class rator)) (opoly (constp (get-const-name rator)))))) (setq ans (encode-term rator (not pcrator))) (while rands (setq ans (make-comb ans (encode-term (pop rands) pcrator) nil))) (if (and needty pcrator) (put-type ans ; can we use q-mk_typed instead of update? (new-sharetype (get-const-name rator) (get-type tm))))) ans)) ; encomb ;;; LP -- this logic should be improved or deleted! ;;; Put the type `ty` on the sharetypes list if: ;;; the type is "big" and not shared already ;;; Give it a name `tok`%nnn where `tok` is the name of the variable or const (defun new-sharetype (tok ty) (if (and (bigger ty 9) (not (revassoc ty %sharetypes))) (progn (let ((sharename (concat tok '% %sharecount))) (incf %sharecount) (push (cons sharename ty) %sharetypes)))) (encode-type ty)) ; sharetype ;;; Encode a type -- copy it, using sharetypes whenever possible (defun encode-type (ty) (let ((sharename (car (revassoc ty %sharetypes)))) (if sharename (cons '%t sharename) (if (is-vartype ty) (q-mk_vartype (get-vartype-name ty)) (make-type (get-type-op ty) (mapcar #'encode-type (get-type-args ty))) )))) ;encode-type hol88-2.02.19940316/lisp/f-system.l0000640000212700021270000002051205265053233014622 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-system.l ;;; ;;; ;;; ;;; DESCRIPTION: All operating system dependent functions in here ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro") (special %liszt %debug %hol-dir %display-function)) ;;; Check validity of file token ;;; must limit the file part (excluding directories) to 11 chars ;;; to allow for Unix's 14 char limit, and a suffix .xx ;;; (Unless this Unix has long filenames). Assume by default it has. (eval-when (compile load eval) #+franz (sstatus feature long-filenames) #-franz (pushnew :long-filenames *features*)) #+(and unix (not long-filenames)) (defun filetokp (kind tok) (let ((chars (nreverse (exploden tok))) (count 0)) (while (and chars (not (= (pop chars) #//))) (incf count)) (<= count 11))) #+(or (not unix) long-filenames) (defun filetokp (kind tok) t) ;;; MJCG 8/11/88 for HOL88 ;;; Changed help and kwic cases - looking for help files goes through ;;; variable %search-path ;;; extensions should not exceed 2 characters ;;; Clauses for jac and doc added by MJCG 7 Dec 1989. (defun fileof (kind name) (case kind (theory (catenate name ".th")) (theorydata (catenate name ".th")) (theoremdata (catenate name ".th")) (help (catenate name ".hlp")) (doc (catenate name ".doc")) (jac (catenate name ".jac")) (kwic (catenate name ".kwic")) (ml (catenate name ".ml")) (lisp (catenate name "_ml.l")) (code (catenate name "_ml.o")) (|m*| (catenate name ".m*")) (t (lcferror (cons kind '(bad arg fileof)))))) ;;; Exec-system-command. Return an integer representing success status. (defun exec-system-command (cmd) #+franz (apply '*process (list cmd)) #+lucid (shell (string cmd)) #+kcl (system (string cmd)) #+allegro (shell (string cmd)) #-(or franz lucid kcl allegro) (failwith "system: no system commands implemented")) ;;; Call help/Reference/doc-to-help.sed on .doc help file ;;; Call help/Reference/jac-to-help.sed on .jac help file ;;; Replaces: (exec-system-command (uconcat "more " fname)) ;;; MJCG 7 Dec 1989 ;;; MJCG 12/11/90: Replaced "more" by %display-function ;;; TFM 90.12.01: help/Reference/ changed to help/bin/ (setq %display-function "cat") (defun display-file (fname kind) #+unix (exec-system-command (uconcat "sed -f " %hol-dir "/help/bin/" (if (eq kind '|jac|) "jac-to-help.sed " "doc-to-help.sed ") "'" fname "'" " | " %display-function)) #-unix (with-open-file (stream fname :direction :input) (let (line) (loop (multiple-value-bind (line eof-p) (read-line stream nil t nil) (when (or eof-p (not (stringp line))) (return nil)) (princ line) (terpri))) (terpri)))) ;;; Keyword facility deleted [TFM 90.09.08] ;;; (defun keyword-search (key fname) ;;; #+unix ;;; (exec-system-command (uconcat "fgrep '" key "' " fname " | more")) ;;; #-unix ;;; (with-open-file (stream fname :direction :input) ;;; (let (line (key-string (string key))) ;;; (loop ;;; (multiple-value-bind (line eof-p) ;;; (read-line stream nil t nil) ;;; (when (search key-string line) ;;; (princ line) (terpri)) ;;; (when (or eof-p (not (stringp line))) ;;; (return nil)))) ;;; (terpri)))) ;;; MJCG 3/11/88 for HOL88 ;;; Some System-dependent commands in ML ;;; dml-ed versions in F-dml.l (defun ml-getenv (thing) #+unix (let ((varble #+franz (getenv thing) #+kcl (system:getenv (string thing)) #+lucid (environment-variable (string thing)) #+allegro (system:getenv thing))) (cond ((or (eq varble '||) (null varble)) (msg-failwith "getenv" "No value for " thing)) (t #+franz varble #-franz (intern varble)))) #-unix (msg-failwith "getenv" "Unix-dependant function") ) (defun ml-host_name () #+franz (sys:gethostname) #-franz (machine-version)) (defun ml-link (old new) #-franz (progn (setq old (string old)) (setq new (string new))) (if (equal old new) (failwith "link: source and destination equal") (if (probe-file old) (prog2 #+franz (sys:link old new) #+(and unix (not franz)) (exec-system-command (concatenate 'string "ln " old " " new)) #-unix (failwith "link: cannot link files") nil) (failwith (concat "link: " old " doesn't exist"))))) (defun ml-unlink (file) (if (probe-file #+franz file #-franz (string file)) #+franz (sys:unlink file) #-franz (delete-file (string file)) (failwith (concat "unlink: " file " doesn't exist")))) ;;; MJCG 3/11/88 for HOL88 ;;; Definitions of ML functions for character IO from ML (defun ml-openi (file) (if (probe-file #+franz file #-franz (string file)) #+franz (infile file) #-franz (open (string file) :direction :input) (failwith (concat "openi: " file " doesn't exist")))) #+franz (defun write-and-drain (port exp) (patom exp port) (drain port) nil) #-franz (defun write-and-drain (port exp) (princ exp port) (finish-output port) nil) #+franz (defun tty-write-and-drain (exp) (patom exp) (drain) nil) #-franz (defun tty-write-and-drain (exp) (princ exp) (finish-output) nil) (defun ml-append_openw (file) #+franz (outfile file 'a) #-franz (open (string file) :direction :output :if-exists :append :if-does-not-exist :create)) ;;; call Lisp compiler from Lisp (for compiling ML) ;;; %liszt for franz lisp set by makefile (defun compile-lisp (filename) (princ "Calling Lisp compiler") (terpri) #+franz (cond ((not (zerop (exec-system-command (concat %liszt " -w -q " filename)))) (msg-failwith '|compile| "error during Lisp compilation"))) #-franz (errortrap #'(lambda (x) (msg-failwith '|compile| "Lisp compilation failed")) ;; added binding of ANSI variable *compile-verbose* - JAC 19.06.92 (let ((*load-verbose* nil) (*compile-verbose* nil)) (compile-file filename :output-file (make-object-filename (string filename))))) (cond ((not %debug) (errortrap #'(lambda (x) (msg-failwith '|compile| "couldn't delete " filename)) (#+franz sys:unlink #-franz delete-file filename))))) ;;; End of file hol88-2.02.19940316/lisp/f-subst.l0000640000212700021270000004226505071123353014443 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-subst.l ;;; ;;; ;;; ;;; DESCRIPTION: Substitution functions ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: ol2 (lisp 1.6) part of Edinburgh LCF ;;; ;;; by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V2.2 : new-exit instead of err ;;; ;;; ;;; ;;; V4 : rewrote substitution, re-arranged arguments of substoccs ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec")) #+franz (declare (localf alpha-fm vars-fm addvar occrec subst-fm find-sub quant-sub abs-sub varfilter choose-var all-frees2 prime unprime)) ;;; ********************************************* ;;; No formulas in HOL: paired_aconv_form deleted [TFM 90.04.19] ;;; (dml |paired_aconv_form| 2 alphaconv ((|form| |#| |form|) -> |bool|)) ;;; --------------------------------------------------------------- ;;; This paired function later gets REDEFINED to be a curried ;;; function (in ml/ml-hol-syn.ml) ;;; Used to be called "paired_aconv_term". ;;; -------------------------------------------------------------- (dml |aconv| 2 alphaconv ((|term| |#| |term|) -> |bool|)) (defun alphaconv (ob1 ob2) (or (#+franz eq #-franz eql ob1 ob2) (let ((%varpairs nil)) (alpha-fm ob1 ob2)))) ;alphaconv ;;; alpha-convertability of formulas (also passes on terms) (defun alpha-fm (fm1 fm2) (and (eq (form-class fm1)(form-class fm2)) (case (form-class fm1) ((forall exists) (let ((%varpairs (cons (cons(get-quant-var fm1)(get-quant-var fm2)) %varpairs))) (alpha-fm (get-quant-body fm1)(get-quant-body fm2)))) ((conj disj imp) ; iff deleted [TFM 90.01.20] (and (alpha-fm (get-left-form fm1)(get-left-form fm2)) (alpha-fm (get-right-form fm1)(get-right-form fm2)))) (pred (and (eq (get-pred-sym fm1) (get-pred-sym fm2)) (alpha-tm (get-pred-arg fm1)(get-pred-arg fm2)))) (t (alpha-tm fm1 fm2)) ))) ;alpha-fm ;;; alpha-convertability of terms (defun alpha-tm (tm1 tm2) (and (eq (term-class tm1) (term-class tm2)) (case (term-class tm1) (const (eq tm1 tm2)) ; assumes sharing of constants (var ; if either bound then bindings must match ; free case assumes variables are shared (let ((p1 (assoc-equal tm1 %varpairs)) (p2 (revassq tm2 %varpairs))) (if (or p1 p2) (#+franz eq #-franz eql p1 p2) (eq tm1 tm2)))) (abs (let ((%varpairs (cons (cons(get-abs-var tm1)(get-abs-var tm2)) %varpairs))) (alpha-tm (get-abs-body tm1)(get-abs-body tm2)))) (comb (and (alpha-tm (get-rator tm1)(get-rator tm2)) (alpha-tm (get-rand tm1)(get-rand tm2)))) (t (lcferror 'alpha-tm)) ))) ;alpha-tm ;;; ********************************************* ;;; term_frees renamed to be frees [TFM 90.06.04] ;;; (dml |term_frees| 1 freevars (|term| -> (|term| |list|))) (dml |frees| 1 freevars (|term| -> (|term| |list|))) ;;; Deleted: formulas not used in HOL [TFM 90.05.27] ;;; (dml |form_frees| 1 freevars (|form| -> (|term| |list|))) (defun freevars (ob) (let ((%all nil)(%vars nil)) (vars-fm ob nil) (nreverse %vars))) ;freevars ;;; term_vars renamed to be vars [TFM 90.06.04] ;;; (dml |term_vars| 1 allvars (|term| -> (|term| |list|))) (dml |vars| 1 allvars (|term| -> (|term| |list|))) ;;; Deleted: formulas not used in HOL [TFM 90.06.27] ;;; (dml |form_vars| 1 allvars (|form| -> (|term| |list|))) (defun allvars (ob) (let ((%all t)(%vars nil)) (vars-fm ob nil) (nreverse %vars))) ;allvars ;;; record the variables in a formula (or term) ;;; if %all then record all variables, even those bound but never used ;;; else record only free variables (defun vars-fm (fm bvars) (case (form-class fm) ((forall exists) (if %all (addvar (get-quant-var fm))) (vars-fm (get-quant-body fm) (cons (get-quant-var fm) bvars))) ((conj disj imp) ; iff deleted [TFM 90.01.20] (vars-fm (get-left-form fm) bvars) (vars-fm (get-right-form fm) bvars)) (pred (vars-tm (get-pred-arg fm) bvars)) (t (vars-tm fm bvars)))) ;vars-fm ;;; record all (free) variables in a term (defun vars-tm (tm bvars) (case (term-class tm) (const) (var (ifn (memq tm bvars) (addvar tm))) (abs (if %all (addvar (get-abs-var tm))) (vars-tm (get-abs-body tm) (cons (get-abs-var tm) bvars))) (comb (vars-tm (get-rator tm) bvars) (vars-tm (get-rand tm) bvars)) (t (lcferror 'vars-tm)))) ;vars ;;; record a variable if not seen already ;;; relies on sharing of variables (defun addvar (v) (ifn (memq v %vars) (push v %vars))) ;addvar ;;; ********************************************* ;;; --------------------------------------------------------------- ;;; This paired function later gets REDEFINED to be a curried ;;; function (in ml/ml-hol-syn.ml). Used to be called "paired_subst_term". ;;; -------------------------------------------------------------- (dml |subst| 2 hol-substitute ((((|term| |#| |term|) |list|) |#| |term|) -> |term|)) ;;; No formulas in HOL: paired_subst_form deleted [TFM 90.04.19] ;;; (dml |paired_subst_form| 2 hol-substitute ;;; ((((|term| |#| |term|) |list|) |#| |form|) -> |form|)) ;;; --------------------------------------------------------------- ;;; This paired function later gets REDEFINED to be a curried function ;;; (in ml/ml-hol-syn.ml). Used to be called "paired_subst_occs_term". ;;; -------------------------------------------------------------- (dml |subst_occs| 3 substitute-occs ((((|int| |list|) |list|) |#| (((|term| |#| |term|) |list|) |#| |term|)) -> |term|)) ;;; No formulas in HOL: paired_subst_occs_form deleted [TFM 90.04.19] ;;;(dml |paired_subst_occs_form| 3 substitute-occs ;;; ((((|int| |list|) |list|) |#| (((|term| |#| |term|) |list|) |#| |form|)) ;;; -> |form|)) (defun hol-substitute (jobl ob) (let ((%newvars nil)) (subst-fm (mapcan #'(lambda (job) (substrec t job)) jobl) ob)) ) ; hol-substitute (defun substitute-occs(occsl jobl ob) (let ((%newvars nil)) (ifn (= (length occsl) (length jobl)) (throw-from evaluation 'subst)) (subst-fm(mapcan 'substrec occsl jobl) ob)) ) ; substitute-occs (eval-when (compile) (defmacro get-term1 (sr) `(car ,sr)) (defmacro get-term2 (sr) `(cadr ,sr)) (defmacro get-occs (sr) `(caddr ,sr)) (defmacro get-frees1 (sr) `(cadddr ,sr)) (defmacro get-frees2 (sr) `(car (cddddr ,sr))) ;gh (defmacro put-occs (sr val) `(rplaca (cddr ,sr) ,val))) ;;; preprocess a substitution ;;; check types, compute free variables, set up occurrence lists ;;; return a record holding this info ;;; return nil if substitution is null ;;; for use with mapcan (NOT mapcar!) (defun substrec(occs job) (let ((tm2 (car job)) (tm1 (cdr job))) (ifn (equal (get-type tm1) (get-type tm2)) (throw-from evaluation 'subst)) (ifn (eq tm2 tm1) (list (list tm1 tm2 (occrec 1 occs) (freevars tm1) (freevars tm2))))) ) ; substrec ;;; convert an ascending list of positive integers ;;; into a list of nil's, with t's interspersed where the integers indicate (defun occrec(n l) (cond ((atom l) (twistlist l)) ; extend out to infinity ((greaterp n (car l)) (throw-from evaluation 'subst)) ; not ascending ((= n (car l)) (cons t (occrec (add1 n)(cdr l)))) ((cons nil (occrec (add1 n) l))) )) ;;; substitute in a formula (or term) (defun subst-fm (srl fm) (cond ((and (null srl) (null %newvars)) fm) ((case (form-class fm) ((forall exists) (quant-sub srl fm)) ((conj disj imp) ; iff deleted [TFM 90.01.21] (make-conn-form (get-conn fm) (subst-fm srl (get-left-form fm)) (subst-fm srl (get-right-form fm)))) (pred (make-pred-form (get-pred-sym fm) (subst-tm srl (get-pred-arg fm)))) (t (subst-tm srl fm)))))) ;subst-fm ;;; substitute in a term (defun subst-tm (srl u) (cond ((and (null srl) (null %newvars)) u) ((find-sub srl u)) ((case (term-class u) (const u) (var (or (assq1 u %newvars) u)) ; rename bound variable (abs (abs-sub srl u)) (comb (make-comb (subst-tm srl (get-rator u)) (subst-tm srl (get-rand u)) (get-type u))) (t (lcferror 'subst-tm)))))) ;subst-tm ;;; base case of substitution ;;; if match found, step down its occurrence list ;;; and return non-nil even if this occurrence is not included ;;; return nil if no match (defun find-sub(srl u) (block found (mapc #'(lambda (sr) (let ((tm1 (get-term1 sr)) (tm2 (get-term2 sr))) (if (alphaconv u tm1) ; match found (let ((occs (get-occs sr))) (put-occs sr (cdr occs)) (return-from found (if (car occs) tm2 u)))))) srl) nil ; indicate not found )) ; find-sub ;;; substitution through a bound variable ;;; if var could be introduced, then rename it ;;; Old version with bug discovered by TFM ;;;(defun quant-sub (srl fm) ;;; (let ((var (get-quant-var fm)) (body (get-quant-body fm))) ;;; (let ((new-srl (varfilter var srl))) ;;; (let ((new-var (choose-var new-srl var body))) ;;; (let ((%newvars (if (eq new-var var) %newvars ;;; (cons (cons var new-var) %newvars)))) ;;; (make-quant-form (get-quant fm) ;;; new-var (subst-fm new-srl body)))))) ;;; ) ; quant-sub ;;; New version with bugfix by LCP (18 June 87) (defun quant-sub (srl fm) (let ((var (get-quant-var fm)) (body (get-quant-body fm))) (let ((new-srl (varfilter var srl))) (let ((new-var (choose-var new-srl var body))) (let ((%newvars (cons (cons var new-var) %newvars))) (make-quant-form (get-quant fm) new-var (subst-fm new-srl body)))))) ) ; quant-sub ;;; substitute through a lambda-abstraction ;;; Old version with bug discovered by TFM ;;;(defun abs-sub (srl tm) ;;; (let ((var (get-abs-var tm)) (body (get-abs-body tm))) ;;; (let ((new-srl (varfilter var srl))) ;;; (let ((new-var (choose-var new-srl var body))) ;;; (let ((%newvars (if (eq new-var var) %newvars ;;; (cons (cons var new-var) %newvars)))) ;;; (make-abs new-var (subst-tm new-srl body) (get-type tm)))))) ;;; ) ; abs-sub ;;; New version with bugfix by LCP (18 June 87) (defun abs-sub (srl tm) (let ((var (get-abs-var tm)) (body (get-abs-body tm))) (let ((new-srl (varfilter var srl))) (let ((new-var (choose-var new-srl var body))) (let ((%newvars (cons (cons var new-var) %newvars))) (make-abs new-var (subst-tm new-srl body) (get-type tm)))))) ) ; abs-sub ;;; filter (from the srl) all rewrites where the var is free ;;; since substitution replaces only free terms (defun varfilter (var srl) (if srl (if (memq var (get-frees1 (car srl))) (varfilter var (cdr srl)) (cons (car srl) (varfilter var (cdr srl)))) )) ; varfilter ;;; choose a new bound variable if old one is mentioned in rewrites ;;; RECENT BUG FIX -- now considers any new variables being introduced ;;; as a result of outer name clashes ;;; #let tm = "\x':*.f (y:*,z:*) (\x:*.(g (x',x,y,z) : tr) ):tr";; ;;; #let tm1 = subst_term ["x'","z"; "x","y"] tm;; ;;; SHOULD GIVE tm1 = "\x''.f(x,x')(\x'''.g(x'',x''',x,x'))" : term (defun choose-var (srl var body) (let ((frees2 (append (mapcar #'cdr %newvars) (all-frees2 srl)))) (if (memq var frees2) (ml-variant (nconc (allvars body) frees2) var) var))) ;;; union of all frees2 fields of srl (defun all-frees2 (srl) (if srl (append (get-frees2 (car srl)) (all-frees2 (cdr srl)))) ) ; all-frees2 ;;; ********************************************* ;;; --------------------------------------------------------------- ;;; This paired function later gets REDEFINED to be a curried ;;; function (in ml/ml-hol-syn.ml). Used to be called ;;; "paired_term_freein_term". ;;; -------------------------------------------------------------- (dml |free_in| 2 freein-tm ((|term| |#| |term|) -> |bool|)) ;;; No formulas in HOL: paired_term_freein_form deleted [TFM 90.04.19] ;;; (dml |paired_term_freein_form| 2 freein-fm ((|term| |#| |form|) -> |bool|)) ;;; No formulas in HOL: paired_term_freein_form deleted [TFM 90.04.19] ;;; (dml |paired_form_freein_form| 2 freein-fm ((|form| |#| |form|) -> |bool|)) ;;; in the current logic, formulas cannot occur in terms ;;; but in general, all four cases are reasonable, ;;; and it is convenient to define freein in terms of "objects", ;;; where objects are either terms or formulas. ;;; see if the ob is free in a formula (or term) (defun freein-fm (ob fm) (or (alphaconv ob fm) (case (form-class fm) ((forall exists) (and (not (freein-fm (get-quant-var fm) ob)) (freein-fm ob (get-quant-body fm)))) ((conj disj imp) ; iff deleted [TFM 90.01.20] (or (freein-fm ob (get-left-form fm)) (freein-fm ob (get-right-form fm)))) (pred (freein-tm ob (get-pred-arg fm))) (t (freein-tm ob fm)) ))) ;freein-fm ;;; see if the ob is free in a term (defun freein-tm (ob tm) (or (alphaconv ob tm) (case (term-class tm) ((var const) nil) (abs (and (not (freein-tm (get-abs-var tm) ob)) (freein-tm ob (get-abs-body tm)))) (comb (or (freein-tm ob (get-rator tm)) (freein-tm ob (get-rand tm)))) (t (lcferror 'freein-tm)) ))) ;freein-tm ;;; ********************************************* ;;; --------------------------------------------------------------- ;;; PAIRED variant function later gets REDEFINED to be curried ;;; in hol-syn.ml ;;; -------------------------------------------------------------- (dml |variant| 2 ml-variant (((|term| |list|) |#| |term|) -> |term|)) ;;; prime v until its name is neither a constant's nor one of the vl (defun ml-variant (vl v) (ifn (memq (term-class v) '(var const)) (throw-from evaluation 'variant) ) (let ((tokl (var-name-list vl 'variant))) (mk_realvar (variant-name tokl (get-var-name v)) (get-type v))) ) ;ml-variant ;;; get the names of the list of variables (defun var-name-list (vl failtok) (mapcar #'(lambda (tm) (if (is-var tm) (get-var-name tm) (throw-from evaluation failtok))) vl)) ; var-name-list ;;; prime tok until it is neither a constant's name nor one of the tokl ;;; no longer strips primes first, that caused problems in ML programs ;;; MJCG 1/2/89 for HOL88.1.01 ;;; Hidden constants no longer primed (defun variant-name (tokl tok) (while (or (memq tok tokl) (and (constp tok) (not (get tok 'hidden-const)))) (setq tok (prime tok))) tok) ; variant-name (defun prime (tok) (concat tok '|'|)) ;prime ;;; strip all primes from tok (including those inside) (defun unprime (tok) (imploden (delq #/' (exploden tok)))) ;unprime hol88-2.02.19940316/lisp/f-site.l0000640000212700021270000000444305071123357014247 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-site.l ;;; ;;; ;;; ;;; DESCRIPTION: Site dependent information ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants")) (setq %build-date (date)) ;;; Actual version and system name set in Makefile (setq %version "") (setq %system-name "") ;;; banner changed, TFM 88.10.08 ;;; This is the banner for hol-lcf and basic-hol (defun banner () (llterpri) (llprinc %system-name) (llprinc " version ") (llprinc %version) (llprinc " created ") (llprinc %build-date) (llterpri)) hol88-2.02.19940316/lisp/f-simpl.l0000640000212700021270000002275105513540256014433 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-simpl.l ;;; ;;; ;;; ;;; DESCRIPTION: Matching functions ;;; ;;; ;;; ;;; USES FILES: ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec")) #+franz (declare (localf var-match prepare-substl prepare-insttyl)) ;;; unlike the F-simpl written by Chris Wadsworth, these matching functions ;;; do not preprocess the patterns for faster matching. They are simpler ;;; to use, their implementation is much cleaner, and they are almost as ;;; efficient as their predecessors. For fast matching, the OL network ;;; functions can be used. ;;; term_match and form_match now match types as well as terms. ;;; match a pattern pat to an object ob ;;; returns nil to indicate failure ;;; records match in specials %substl and %insttyl ;;; --------------------------------------------------------------------- ;;; form-match, ml-form_match, and paired_form_match used nowhere in HOL. ;;; So, commented out here. [TFM 90.04.19] ;;; --------------------------------------------------------------------- ;(defun form-match (pat ob) ; (and (eq (form-class pat) (form-class ob)) ; (case (form-class pat) ; ((conj disj imp iff) ; (and (form-match (get-left-form pat) (get-left-form ob)) ; (form-match (get-right-form pat) (get-right-form ob)))) ; ((forall exists) ; (let ((pbv (get-quant-var pat)) (obv (get-quant-var ob))) ; (and (type-match (get-type pbv) (get-type obv)) ; (let ((%bv-pairs (cons (cons pbv obv) %bv-pairs))) ; (form-match (get-quant-body pat) (get-quant-body ob)))))) ; (pred (and (eq (get-pred-sym pat) (get-pred-sym ob)) ; (term-match (get-pred-arg pat) (get-pred-arg ob)))) ; (t (lcferror 'form-match))))) ; form-match (defun term-match (pat ob) (case (term-class pat) (const (and (is-const ob) (eq (get-const-name pat) (get-const-name ob)) (type-match (get-type pat) (get-type ob)))) (var (var-match pat ob)) (comb (and (is-comb ob) (term-match (get-rator pat) (get-rator ob)) (term-match (get-rand pat) (get-rand ob)))) (abs (and (is-abs ob) (let ((pbv (get-abs-var pat)) (obv (get-abs-var ob))) (type-match (get-type pbv) (get-type obv)) (let ((%bv-pairs (cons (cons pbv obv) %bv-pairs))) (term-match (get-abs-body pat) (get-abs-body ob)))))) (t (lcferror 'term-match)))) ;term-match ;;; match a variable to an object (defun var-match (var ob) (let ((pbind (assq var %bv-pairs)) (obind (revassq ob %bv-pairs))) (cond ((or pbind obind) (#+franz eq #-franz eql pbind obind)) ; corresponding bound vars ((not (exists #'(lambda (vv) (freein-tm (cdr vv) ob)) %bv-pairs)) ; ob is free in entire object (let ((prev (revassq1 var %substl))) ; keep consistent (cond (prev (alphaconv ob prev)) ; with prev match ((type-match (get-type var) (get-type ob)) (push (cons ob var) %substl)))))))) ; var-match ;;; match a pattern type with an object type, return nil if failure ;;; records types that are known to match, to prevent exponential blow-up ;;; (defun type-match (pty ty) ;;; (if (is-vartype pty) ;;; (let ((ty2 (revassq1 pty %insttyl))) ;;; (if ty2 (equal ty ty2) ; consistent with previous match ;;; (push (cons ty pty) %insttyl))) ;;; (let ((pty-tys (assq pty %type-matches))) ;;; (or (memq ty (cdr pty-tys)) ;;; (cond ((is-vartype ty) (failwith '|type-match|)) ;;; ((and (eq (get-type-op pty) (get-type-op ty)) ;;; (forall 'type-match ;;; (get-type-args pty) ;;; (get-type-args ty))) ;;; ; record matching pair of types ;;; (if pty-tys ;;; (rplacd pty-tys (cons ty (cdr pty-tys))) ;;; (push (cons pty (list ty)) %type-matches)) ;;; t)))))) ;type-match ;;; match a pattern type with an object type, return nil if failure ;;; records types that are known to match, to prevent exponential blow-up ;;; [DES] 11feb92 - stop if types are equal as (ty.ty) is dropped later (defun type-match (pty ty) (if (#+franz equal #-franz fast-list-equal pty ty) t ; [DES] 11feb92 (if (is-vartype pty) (let ((ty2 (revassq1 pty %insttyl))) (if ty2 (equal ty ty2) ; consistent with previous match (push (cons ty pty) %insttyl))) (let ((pty-tys (assq pty %type-matches))) (or (memq ty (cdr pty-tys)) (cond ((is-vartype ty) (failwith '|type-match|)) ((and (eq (get-type-op pty) (get-type-op ty)) (forall 'type-match (get-type-args pty) (get-type-args ty))) ; record matching pair of types (if pty-tys (rplacd pty-tys (cons ty (cdr pty-tys))) (push (cons pty (list ty)) %type-matches)) t))))))) ;type-match ;;; instantiate types in variables ;;; and strip out null matches of the form (v . v) ;;; to minimize the variables that must be instantiated ;;; (null matches must first be recorded ;;; to prevent v from matching something else) (defun prepare-substl (substl) (if substl (let ((tm (caar substl)) (var (cdar substl)) (tail (cdr substl))) (let ((var2 (mk_realvar (get-var-name var) (get-type tm)))) (if (eq tm var2) (prepare-substl tail) (cons (cons tm var2) (prepare-substl tail))))))) ; prepare-substl ;;; prepare the type instantiation list ;;; by stripping out redundant pairs (* . *) (defun prepare-insttyl (insttyl) (if insttyl (let ((head (car insttyl)) (tail (cdr insttyl))) (if (eq (car head) (cdr head)) (prepare-insttyl tail) (cons head (prepare-insttyl tail)))))) ; prepare-insttyl ;;; Error changed from term_match to match [JRH 94.01.08] (defun ml-term_match (pat ob) (let ((%substl nil) (%insttyl nil) (%bv-pairs nil) (%type-matches nil)) (ifn (term-match pat ob) (throw-from evaluation 'match)) (cons (prepare-substl %substl) (prepare-insttyl %insttyl)))) ; ml-term_match ;;; --------------------------------------------------------------------- ;;; form-match, ml-form_match, and paired_form_match used nowhere in HOL. ;;; So, commented out here. [TFM 90.04.19] ;;; --------------------------------------------------------------------- ;(defun ml-form_match (pat ob) ; (let ((%substl nil) (%insttyl nil) (%bv-pairs nil) (%type-matches nil)) ; (ifn (form-match pat ob) (throw-from evaluation 'form_match)) ; (cons (prepare-substl %substl) (prepare-insttyl %insttyl)))) ; ml-form_match ;;; --------------------------------------------------------------- ;;; This paired function later gets REDEFINED to be a curried ;;; function (in ml/ml-hol-syn.ml) ;;; Used to be called "paired_term_match". ;;; -------------------------------------------------------------- (dml |match| 2 ml-term_match ((|term| |#| |term|) -> (((|term| |#| |term|) |list|) |#| ((|type| |#| |type|) |list|)))) ;;; --------------------------------------------------------------------- ;;; form-match, ml-form_match, and paired_form_match used nowhere in HOL. ;;; So, commented out here. [TFM 90.04.19] ;;; --------------------------------------------------------------------- ;(dml |paired_form_match| 2 ml-form_match ; ((form |#| form) -> ; (((|term| |#| |term|) |list|) |#| ((|type| |#| |type|) |list|)))) hol88-2.02.19940316/lisp/f-parsol.l0000640000212700021270000002661405523413653014612 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-parsol.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions for parsing OL ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: parsol (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; When changing precedences you must update every call to parse-level. ;;; There are many interactions among the precedences of the operators. ;;; note that the "optr" arg of term-rtn and form-rtn is not used. ;;; thus syntax error messages do not mention the specific operator or ;;; connective being parsed. Earlier code consed up error message that ;;; usually were not needed, wasting storage. A better way to make ;;; specific error messages would be to make term-check and form-check ;;; take args msg1, msg2, and msg3 -- which would be concatenated only ;;; if an error actually occurred. ;;; - LP (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro")) #+franz (declare (localf form-check)) ;;; Parse an OL quotation (for ML) (defun parse-ol () (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp) (atom-rtn '(ol-atomr)) (juxtlevel 120) ; precedence of application (%mk=antiquot 'MK=ANTIQUOT) (juxt-rtn '(oljuxt arg1)) (ibase 10) (parsedepth 0)) (parse-level 0) ; this check catches dangling predicate symbols (if (or (memq (car arg1) term-constrs) (memq (car arg1) form-constrs)) arg1 (parse-failed "syntax error in quotation")) )) ;parse-ol ;;; declare a user-defined OL infix ;;; called from theory package (defun olinfix (x typ) (let ((lang1 'ol1)(lang2 'ol2)(langlp 'ollp)) (putprop x typ 'olinfix) (binop x (+ olinprec 5) ; right-associative (list (if (eq typ 'paired) 'olinf-rtn 'olcinf-rtn) (list 'quote x))) )) ;olinfix ;;; parse paired OL infix (defun olinf-rtn (x) (list 'MK=COMB (mk-ol-atom x) (list 'MK=PAIR (term-check arg1 "arg1 of infix must be a term") (term-check (parse-level olinprec) "arg2 of infix must be a term"))) ) ;olinf-rtn ;;; parse curried OL infix (defun olcinf-rtn (x) (list 'MK=COMB (list 'MK=COMB (mk-ol-atom x) (term-check arg1 "arg1 of infix must be a term")) (term-check (parse-level olinprec) "arg2 of infix must be a term"))) ;olcinf-rtn ;;; Added by MJCG on 31.01.94 for HOL88.2.02 ;;; declare a user-defined OL infixed variable ;;; dml-ed in f-dml.l (setq hol-var-binops nil) (defun olvarinfix (x) (let ((lang1 'ol1)(lang2 'ol2)(langlp 'ollp)) (if (not(memq x hol-var-binops)) (setq hol-var-binops (cons x hol-var-binops))) (binop x (+ olinprec 5) ; right-associative (list 'olcinf-rtn (list 'quote x))) nil )) ;olvarinfix ;;; handle parentheses, also special token () (defun lpar-rtn () (cond ((eq token rparen-sym) (gnt) '(MK=CONST |()|)) (t (check rparen-sym (parse-level 0) "bad paren balance"))) ) ;lpar-rtn ;;; logical connectives (defun form-rtn (optr constr a b) optr ;not used (list constr (form-check a "arg1 of connective must be a formula") (form-check b "arg2 of connective must be a formula"))) ;form-rtn ;;; check that an object is a form, print msg if not (defun form-check (ob msg) (if (memq (car ob) form-constrs) ob (parse-failed msg))) ;form-check ;;; routine for OL atoms, linked to atom-rtn (defun ol-atomr () (mk-ol-atom ptoken)) ;ol-atomr ;;; determine the use of an OL atom : constant or variable ;;; for OL, numbers are scanned as symbols (defun mk-ol-atom (x) (cond ((memq x spec-toks) (parse-failed (catenate x " cannot be a term"))) ((constp x) (list 'MK=CONST x)) ((predicatep x) (list 'MK=PREDSYM x)) (t (list 'MK=VAR x)))) ;mk-ol-atom ;;; routine for juxtaposed OL objects, linked to juxt-rtn ;;; handles predicates and combinations (defun oljuxt (x) (if (eq (car x) 'MK=PREDSYM) (list 'MK=PREDICATE (cadr x) (term-check (parse-level juxtlevel) "argument of predicate must be a term")) (list 'MK=COMB (term-check x "formula terminated by junk") (term-check (parse-level juxtlevel) "term juxtaposed with formula"))) ) ;oljuxt ;;; Parse lambda or quantifier (defun lamq-rtn (constr chk n msg) (let ((x (cond ((eq token anticnr-tok) (gnt) (metacall)) ((not (= toktyp 1)) (parse-failed (catenate token " in a prefix"))) (t (gnt) (mk-ol-atom ptoken))))) (while (eq token colon-sym) (gnt) (setq x (list 'MK=TYPED x (olt)))) (list constr x (cond ((eq token period-sym) (gnt) (funcall chk (parse-level n) msg)) (t (lamq-rtn constr chk n msg)))) )) ;lamq-rtn (defun lam-rtn () (lamq-rtn 'MK=ABS (function term-check) 70 "lambda body must be a term")) ;lam-rtn (defun quant-rtn (constr) (lamq-rtn constr (function form-check) 5 "can only quantify a formula")) ;quant-rtn ;;; negation -- extends over predicates only (defun neg-rtn () (list 'MK=NEG (form-check (parse-level 59) "can only negate a formula"))) ; neg-rtn ;;; infix operators on terms (comma, ==, <<) (defun term-rtn (optr constr a b) optr ;not used (list constr (term-check a "arg1 of operator must be a term") (term-check b "arg2 of operator must be a term"))) ;term-rtn ;;; check that an object is a term, fail if not (defun term-check (ob msg) (if (memq (car ob) term-constrs) ob (parse-failed msg))) ;term-check (defun condl-rtn (p) (list 'MK=COND (term-check p "condition of conditional not term") (term-check (check else-tok (parse-level 80) "need 2 nd branch to conditional") "1 st branch of conditional not term") (term-check (parse-level 80) "2 nd branch of conditional not term") )) ;condl-rtn ;;; antiquotation of terms/forms (MK=ANTIQUOT) or types (MK=TYPE=ANTIQUOT) (defun metacall () (list %mk=antiquot (progn (gnt) (cond ((eq ptoken lparen-sym) (check rparen-sym (parseml metaprec) "bad antiquotation")) ((= ptoktyp 1) (mlatomr)) ((parse-failed "junk in antiquotation")))))) ;metacall ;;; type constraint on term (defun oltyp-rtn () (list 'MK=TYPED (term-check arg1 "only a term can have a type") (olt))) ;oltyp-rtn ;;; free-standing type quotation ;;; this is presumably a separate recursive descent parser (defun olt () (let ((%mk=antiquot 'MK=TYPE=ANTIQUOT)) (olt1 (olt2 (olt3 (olt4)))))) ;olt (defun olt1 (x) (cond ((eq token arrow-tok) (gnt) (list 'MK=TYPE '|fun| x (olt))) (t x))) ;olt1 ;;; PPLAMBDA does not have any built-in "sum" type, but user may define it (defun olt2 (x) (cond ((eq token sum-tok) (gnt) (list 'MK=TYPE '|sum| x (olt2 (olt3 (olt4))))) (t x))) ;olt2 (defun olt3 (x) (cond ((eq token prod-tok) (gnt) (list 'MK=TYPE '|prod| x (olt3 (olt4)))) (t x))) ;olt3 (defun olt4 () (prog (x) (gnt) (when (eq ptoken lparen-sym) (setq x (cond ((eq token rparen-sym) (gnt) nil) (t (olt5)))) (go l)) (setq x (list (cond ((eq ptoken anticnr-tok) (metacall)) ((eq ptoken mul-sym) (list 'MK=VARTYPE (vartype-rtn))) ((not (= ptoktyp 1)) (parse-failed (catenate ptoken " is not allowed in a type"))) (t (list 'MK=TYPE ptoken))))) l (cond ((= toktyp 1) (gnt)) ((and x (null (cdr x))) (return (car x))) (t (parse-failed "missing type constructor"))) (setq x (list (cons 'MK=TYPE (cons ptoken x)))) (go l))) ;olt4 (defun olt5 () (prog (x) (setq x (list (olt))) loop (cond ((eq token rparen-sym) (gnt) (return x)) ((eq token comma-sym) (gnt) (setq x (append x (list (olt)))) (go loop)) (t (parse-failed "missing separator or terminator in type"))) )) ;olt5 ;;; set up OL symbols and precedences (eval-when (load) (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp)) (putprop endcnrtok 0 'ollp) (putprop rparen-sym 0 'ollp) (unop lparen-sym '(lpar-rtn)) (unop forall-tok '(quant-rtn 'MK=FORALL)) (unop exists-tok '(quant-rtn 'MK=EXISTS)) (unop neg-tok '(neg-rtn)) ;; in OL, all infixes associate to RIGHT ;; however == and << do not associate at all ;; the first arg of form-rtn should be a string (for error messages) ;; however it is currently unused ;;; iff-tok deleted [TFM 90.01.20] ;;; (binop iff-tok 25 ;;; '(form-rtn 'if-and-only-if 'MK=IFF arg1 (parse-level 20))) (binop imp-tok 35 '(form-rtn 'implication 'MK=IMP arg1 (parse-level 30))) (binop disj-tok 45 '(form-rtn 'disjunction 'MK=DISJ arg1 (parse-level 40))) (binop conj-tok 55 '(form-rtn 'conjunction 'MK=CONJ arg1 (parse-level 50))) (binop eq-tok 60 '(term-rtn 'equality 'MK=EQUIV arg1 (parse-level 60))) (binop ineq-tok 60 '(term-rtn 'inequality 'MK=INEQUIV arg1 (parse-level 60))) (binop condl-tok 85 '(condl-rtn arg1)) (binop comma-sym 95 '(term-rtn 'tupling 'MK=PAIR arg1 (parse-level 90))) (unop lambda-tok '(lam-rtn)) (putprop else-tok 10 'ollp) ; the value of the number seems irrelevant (binop colon-sym 105 '(oltyp-rtn)) (unop anticnr-tok '(metacall)) (unop exfix-sym '(progn (gnt) (mk-ol-atom ptoken))) )) (setq olinprec 100) (setq term-constrs '(MK=ANTIQUOT MK=CONST MK=VAR MK=COMB MK=PAIR MK=ABS MK=COND MK=TYPED)) ;;; MK=IFF deleted [TFM 90.01.20] (setq form-constrs '(MK=ANTIQUOT MK=PREDICATE MK=EQUIV MK=INEQUIV MK=NEG MK=CONJ MK=DISJ MK=IMP MK=FORALL MK=EXISTS)) hol88-2.02.19940316/lisp/f-parsml.l0000640000212700021270000006430605407073565014615 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-parsml.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions for parsing ML ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: parsml (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V4-1 Added primitive type obj GH ;;; ;;; Corrected bug sec-rtn ;;; ;;; ;;; ;;; Hol version 1.12: deleted obj type : [TFM 90.09.09] ;;; ;;; Hol version 2.02: made preterm_handler work in CL : [MJCG 04.12.92] ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (special %parse-tree-buffer |%preterm-flag| %nil) (*lexpr concat)) ;;; To make sure that the preterm flag is off [TFM 91.01.28] (eval-when (load eval) (setq |%preterm-flag| nil)) #+franz (declare (localf istypedec isabstypedec isconctypedec istypeabbrevdec declnchk ultabstr idchk funcase-rtn bind-rtn bind-rtn1 typeabbrev-rtn next-equals abstypbind-rtn conctypbind-rtn constrs-rtn constr-rtn mlt mlt1 mlt2 mlt3 mlt4 curr-ml-type mlt5)) (defun parseml (pl) (let ((lang1 'ml1) (lang2 'ml2) (langlp 'mllp) (atom-rtn '(mlatomr)) (juxtlevel 1010) (juxt-rtn '(mljuxt arg1)) (ibase 10) (parsedepth 0)) (parse-level pl))) ;parseml (defun istypedec (class) (memq class '(mk-deftype mk-defrectype mk-abstype mk-absrectype))) ;istypedec (defun isabstypedec (class) (memq class '(mk-abstype mk-absrectype))) ;isabstypedec (defun isconctypedec (class) (memq class '(mk-type mk-rectype))) ;isconctypedec (defun istypeabbrevdec (class) (memq class '(mk-deftype))) ;istypeabbrevdec (defun declnchk (x msg) (if (memq (car x) declnconstrs) x (parse-failed msg))) ;delnchk (defun ultabstr (e) (or (eq (car e) 'mk-abstr) (and (eq (car e) 'mk-straint) (ultabstr (cadr e))))) ;ultabstr (defun idchk (id msg) (if (or (numberp id) (memq id spec-syms) (memq id rsvdwds)) (parse-failed msg) id)) ;idchk (defun eqsetup () (putprop eq-sym '(appl-rtn 550 '=) 'ml2) (putprop eq-sym 540 'mllp)) ;eqsetup (defun persetup () (binop period-sym 650 '(appl-rtn 640 '|.|))) ;persetup (defun scolonsetup () (putprop scolon-sym 150 'mllp)) ;scolonsetup ;;; MJCG 28/10/88 for HOL88 ;;; Sections commented out for HOL88 ;;; MJCG 1/2/90 ;;; Sections reinstated ;;; (but intended for system use only) (defun sec-rtn (x) (let ((l '||)) (ifn (= parsedepth 1) (parse-failed '|sections can only be opened or closed at top level|)) (while (not (eq token tml-sym)) (ifn (or (eq token period-sym) (= toktyp 1)) (parse-failed '|bad section name|)) (setq l (concat l token)) (gnt)) (cons x (when l (list l))))) ;sec-rtn (defun mlinfix2 (x typ) (putprop x typ 'mlinfix) ;yes ?? (binop x 450 (list (if (eq typ 'paired) 'mlinf-rtn 'mlcinf-rtn) (qeval x)))) ;mlinfix2 ;;; MJCG 5/2/89 for HOL88 ;;; Function to make the parse tree of an ML variable and, as a side effect, ;;; to take autoload action. ;;; See lisp/f-tml.l for details of %parse-tree-buffer and ;;; computation of the autoload action. (setq %parse-tree-buffer nil) ;;; Bugfix by MJCG for HOL88.1.02 on 22/3/89 ;;; Deletion of hol-autoload property also done by code put ;;; in parse tree buffer by axiom_msg_lfn, definition_msg_lfn ;;; and theorem_msg_lfn. ;;; Bugfix by MJCG for HOL88.1.12 on 25/10/90 ;;; Variable nil parsed to value of %nil to avoid obscure bugs (e.g. \().nil) ;;; Value of %nil is a non-null non-interned atom with printname `nil' #+franz (setq %nil (maknam '(n i l))) #-franz (setq %nil (make-symbol "nil")) (defun mk-var-fun (x) (and (get x 'hol-autoload) (let ((v (get x 'hol-autoload))) (setq %parse-tree-buffer (cons (autoload v) %parse-tree-buffer)) (ifn (eq (car v) 'eval) (remprop x 'hol-autoload)))) ;;;(list 'mk-var x)) ; Old code (list 'mk-var (if x x %nil))) (defun mlinf-rtn (x) (list 'mk-appn (mk-var-fun x) (list 'mk-dupl arg1 (parse-level 460)))) ;mlinf-rtn (defun mlcinf-rtn (x) (list 'mk-appn (list 'mk-appn (mk-var-fun x) arg1) (parse-level 460))) ;mlcinf-rtn (defun exfix-rtn () (gnt) (mk-var-fun (if (eq ptoken tokflag) toklist ptoken))) ;exfix-rtn (defun mlatomr () (cond ((memq ptoken spec-syms) (parse-failed (concat ptoken '| cannot be a var|))) ((numberp ptoken) (list 'mk-intconst ptoken)) ((eq ptoken tokflag) (list 'mk-tokconst (pop toklist))) ((eq ptoken wildcard-sym) '(mk-wildcard)) (t (mk-var-fun ptoken)))) ;mlatomr (defun appl-rtn (pl rn) (let ((x arg1)) (parse-level pl) (list 'mk-binop rn x arg1))) ;appl-rtn (defun lparen-rtn () (cond ((eq token rparen-sym) (gnt) '(mk-empty)) ; cond needed here (t (check rparen-sym (parse-level 15) '|bad paren balance|)))) ;lparen-rtn (defun while-rtn () (let ((x (parse-level 30))) (if (eq token '|do|) (gnt) (parse-failed '|missing do after while|)) `(mk-while ,x ,(parse-level 160))) ); while-rtn (defun case-rtn () (let (x) (setq x (parse-level 30)) (if (eq token '|of|) (gnt) (parse-failed '|missing of after case|)) (let ((c (fun-rtn))) `(mk-case ,x ,(if (eq (car c) 'mk-fun) (cadr c) ; le case a plusieurs alternants et ; fun-rtn renvoie ; (mk-fun (vs1.e1)..(vsn.en)) (list (cons (cadr c) (caddr c)))))))) ;case-rtn (defun test-rtn () (prog (x1 x2 xl xt) loop (setq x1 (parse-level 30)) (setq xt token) (if (memq xt '(|then| |loop|)) (gnt) (parse-failed '|missing then or loop after if|)) (setq x2 (parse-level 320)) (setq xl (cons (cons (if (eq xt '|then|) 'once 'iter) (cons x1 x2)) xl)) (when (eq token '|if|) (gnt) (go loop)) (setq xt token) (cond ((memq xt '(|else| |loop|)) (gnt) (return (list 'mk-test (reverse xl) (cons (if (eq xt '|else|) 'once 'iter) (parse-level 320))))) (t (return (list 'mk-test (reverse xl))))))) ;test-rtn (defun trap-rtn (trap) (prog (x x1 x2 xl) (setq x arg1) loop (setq x1 (parse-level 1020)) (if (memq token trap-syms) (parse-failed '|missing trap body|)) (setq x2 (parse-level 270)) (setq xl (cons (cons trap (cons x1 x2)) xl)) (when (memq token trap-syms) (setq trap (if (memq token (list trap-then-sym trapif-then-sym trapbind-then-sym)) 'once 'iter))) (when (memq token (list trapif-then-sym trapif-loop-sym)) (gnt) (go loop)) (when (memq token (list trap-then-sym trap-loop-sym)) (gnt) (return (list 'mk-trap x (reverse xl) (cons trap (parse-level 240))))) (when (memq token (list trapbind-then-sym trapbind-loop-sym)) (gnt) (return (list 'mk-trap x (reverse xl) (cons (cons trap token) (progn (gnt) (parse-level 270)))))) (return (list 'mk-trap x (reverse xl))))) ;trap-rtn (defun trapbind-rtn (trap) (list 'mk-trap arg1 nil (cons (cons trap (idchk token (concat token '| cannot be bound|))) (progn (gnt) (parse-level 270))))) ;trapbind-rtn (defun list-rtn () (prog (l scolonlp) (setq scolonlp (get scolon-sym 'mllp)) loop (when (eq token rbrkt-sym) (gnt) (return (cons 'mk-list (reverse l)))) (putprop scolon-sym 20 'mllp) (setq l (cons (parse-level 30) l)) (putprop scolon-sym scolonlp 'mllp) (cond ((eq token rbrkt-sym) (go loop)) (t (check scolon-sym arg1 '|funny list separator|) (go loop))))) ;list-rtn (defun fun-rtn () (prog (x) loop (setq x (cons (funcase-rtn) x)) (when (eq token case-sym) (gnt) (go loop)) (return (ifn (cdr x) `(mk-abstr ,(caar x) ,(cdar x)) `(mk-fun ,(reverse x)))))) ; fun-rtn (defun funcase-rtn () (let (x) (binop period-sym 220 '(appl-rtn 210 '|.|)) (setq x (parse-level 230)) (persetup) (check period-sym x '|lost period in fun-case|) (cons x (parse-level 130)))) (defun seq-rtn () (prog (xl) (setq xl (list arg1)) loop (setq xl (cons (parse-level 160) xl)) (when (eq token scolon-sym) (gnt) (go loop)) (return (list 'mk-seq (reverse (cdr xl)) (car xl))))) ;seq-rtn (defun let-rtn (class) (setq arg1 (bind-rtn class)) (cond ((eq token '|in|) (gnt) (in-rtn)) ((lessp 1 parsedepth) (parse-failed '|non top level decln must have in clause|)) (t arg1))) ;let-rtn (defun bind-rtn (class) (cond ((isabstypedec class) (abstypbind-rtn class)) ((isconctypedec class) (conctypbind-rtn class)) ((istypeabbrevdec class) (typeabbrev-rtn class)) (t (cons class (bind-rtn1))))) ; bind-rtn (defun bind-rtn1 () (let ((x nil) (y nil)) (binop eq-sym 30 '(parse-failed '|= inside definiend|)) (setq x (check eq-sym (parse-level 50) '|lost = in decln|)) (eqsetup) (setq y (parse-level 120)) (ifn (eq token '|and|) (list (cons x y)) (gnt) (cons (cons x y) (bind-rtn1))))) ; bind-rtn1 (defun typeabbrev-rtn (class) (let ((dl nil)) (block andloop (while t (let ((tyname token)) (cond ((not (= toktyp 1)) (parse-failed (concat token '| not allowed as a type|))) ((memq token bastypes) (parse-failed (concat token '| musn't be redefined|))) ((assoc-equal token dl) (parse-failed (concat token '| defined more than once|)))) (gnt) (next-equals) (push (cons tyname (mlt)) dl) (unless (eq token '|and|) (return-from andloop nil)) (gnt)))) (list class dl))) ;typeabbrev-rtn (defun next-equals () (unless (eq token eq-sym) (parse-failed '|missing = in declaration|)) (gnt)) ; next-equals ;;; modified for HOL to handle ** being a token etc. (defun abstypbind-rtn (class) (prog (tyargs dl) loop (setq tyargs nil) (cond ((test-list-els (exploden token) '(42)) (gnt) (setq tyargs (list (vartype-rtn)))) ((eq token lparen-sym) (if (eq (gnt) rparen-sym) (gnt) (go l2)))) l1 (unless (= toktyp 1) (parse-failed '|bad type constructor|)) (let ((tyname token)) (gnt) (next-equals) (push (cons tyname (cons tyargs (mlt))) dl)) (cond ((eq token '|and|) (gnt) (go loop)) ((eq token '|with|) (gnt)) (t (parse-failed '|missing with|))) (return (list class dl (bind-rtn 'mk-let))) l2 (ifn (test-list-els (exploden token) '(42)) (parse-failed '|type constructor's args not variables|)) (gnt) (setq tyargs (append tyargs (list (vartype-rtn)))) (cond ((eq token comma-sym) (gnt) (go l2)) ((eq token rparen-sym) (gnt) (go l1)) (t (parse-failed '|bad args to type constructor|))))) ;abstyp-rtn ;;; modified for HOL to cope with ** being a token etc. (defun conctypbind-rtn (class) (prog (tyargs dl) loop (setq tyargs nil) (cond ((test-list-els (exploden token) '(42)) (gnt) (setq tyargs (list (vartype-rtn)))) ((eq token lparen-sym) (if (eq (gnt) rparen-sym) (gnt) (go l2)))) l1 (unless (= toktyp 1) (parse-failed '|bad type constructor|)) (let ((tyname token)) (gnt) (next-equals) (push (cons tyname (cons tyargs (constrs-rtn))) dl)) (ifn (eq token '|and|) (return (cons class dl)) (gnt) (go loop)) l2 (ifn (test-list-els (exploden token) '(42)) (parse-failed '|type constructor's args not variables|)) (gnt) (setq tyargs (append tyargs (list (vartype-rtn)))) (cond ((eq token comma-sym) (gnt) (go l2)) ((eq token rparen-sym) (gnt) (go l1)) (t (parse-failed '|bad args to type constructor'|))))) ;conctyp-rtn (defun constrs-rtn () (prog (x) loop (setq x (cons (constr-rtn) x)) (when (eq token case-sym) (gnt) (go loop)) (return (cons 'mk-construct (reverse x))))) ; constrs-rtn (defun constr-rtn () (let ((x token)) (cond ((not (eq (gnt) '|of|)) (list x)) (t (gnt) (cons x (mlt)))))) ; constr-rtn ;;; MJCG 9 Nov 1992. Check for local datatypes added and previous buggy code commented out. (defun in-rtn () (list (cond ((isabstypedec (car arg1)) 'mk-ina) ; ((isconctypedec (car arg1)) 'mk-inc) ((isconctypedec (car arg1)) (parse-failed "Local concrete types not supported")) ((istypeabbrevdec (car arg1)) 'mk-ind) (t 'mk-in)) (declnchk arg1 '|in must follow decln|) (parse-level 100))) ;in-rtn (defun where-rtn (class) (let ((e arg1)) (list (cond ((isabstypedec class) 'mk-ina) ((istypedec class) 'mk-ind) (t 'mk-in)) (declnchk (bind-rtn class) '|bad decln in where|) e))) ;where-rtn (defun lamb-rtn () (let (x) (binop period-sym 220 '(appl-rtn 210 '|.|)) (setq x (parse-level 230)) (persetup) (check period-sym x '|lost period in abstrn|) `(mk-abstr ,x ,(parse-level 130)))) ;lamb-rtn ;;; (defun iter-rtn (a b) ;;; (cond ((eq (car a) 'mk-appn) (iter-rtn (cadr a) ;;; (list 'mk-abstr ;;; (chkvarstr (caddr a) ;;; '|multiple lambda binding for var| ;;; '|bad var structure in iterated abstrn|) ;;; b))) ;;; (t (list 'mk-abstr ;;; (chkvarstr a ;;; '|multiple lambda binding for var| ;;; '|bad var structure in abstrn|) ;;; b)))) ;iter-rtn (defun assign-rtn () (list 'mk-assign arg1 (parse-level 350))) ;assign-rtn (defun dupl-rtn () (list 'mk-dupl arg1 (parse-level 370))) ;dupl-rtn (defun cond-rtn () (prog (x1 x2 xl) loop (setq x1 arg1) (setq x2 (parse-level 30)) (setq xl (cons (cons 'once (cons x1 x2)) xl)) (if (eq token else-sym) (gnt) (parse-failed (list 'missing else-sym))) (parse-level 430) (cond ((eq token condl-sym) (gnt) (go loop))) (return (list 'mk-test (reverse xl) (cons 'once arg1))))) ;cond-rtn (defun failwith-rtn () (list 'mk-failwith (parse-level 340))) ;failwith-rtn (defun mltyp-rtn () (list 'mk-straint arg1 (mlt))) ;mltyp-rtn (defun mlt () (mlt1 (mlt2 (mlt3 (mlt4))))) ;mlt (defun mlt1 (x) (cond ((eq token arrow-sym) (gnt) (list 'mk-funtyp x (mlt))) (t x))) ;mlt1 (defun mlt2 (x) (cond ((eq token sum-sym) (gnt) (list 'mk-sumtyp x (mlt2 (mlt3 (mlt4))))) (t x))) ;mlt2 (defun mlt3 (x) (cond ((eq token prod-sym) (gnt) (list 'mk-prodtyp x (mlt3 (mlt4)))) (t x))) ;mlt3 (defun mlt4 () (prog (x) (gnt) (when (eq ptoken lparen-sym) (setq x (cond ((eq token rparen-sym) (gnt) nil) (t (mlt5)))) (go l)) (setq x (list (curr-ml-type))) l (cond ((or (not (= toktyp 1)) (memq token rsvdwds)) (cond ((and x (null (cdr x))) (return (car x))) (t (parse-failed '|missing type constructor|)))) (t (gnt))) (setq x (cond ((eq ptoken '|list|) (list (cons 'mk-listyp x))) (t (list (cons 'mk-consttyp (cons ptoken x)))))) (go l))) ;mlt4 ;;; modified for HOL to deal with ** being a token etc (defun curr-ml-type () (case ptoken (|int| '(mk-inttyp)) ;;; (|obj| '(mk-objtyp)) [TFM 90.09.09] (|thm| '(mk-thmtyp)) (|void| '(mk-nulltyp)) (|bool| '(mk-booltyp)) (|type| '(mk-typetyp)) (|term| '(mk-termtyp)) (|form| '(mk-formtyp)) ((|string| |token| |tok|) '(mk-toktyp)) (|*| (list 'mk-vartyp (vartype-rtn))) (t (cond ((test-list-els (exploden ptoken) '(42)) (list 'mk-vartyp (vartype-rtn))) ((= ptoktyp 1) (list 'mk-consttyp ptoken)) (t (parse-failed (concat ptoken '| is not allowed in a type|))))))) (defun mlt5 () (prog (x) (setq x (list (mlt))) loop (cond ((eq token rparen-sym) (gnt) (return x)) ((eq token comma-sym) (gnt) (setq x (append x (list (mlt)))) (go loop)) (t (parse-failed '|missing separator or terminator in type|)))) ) ;mlt5 (defun mljuxt (x) (list 'mk-appn x (parse-level 1020))) ;mljuxt ;;; quotations ;;; in OL digits are considered letters, there should be no numbers ;;; parse-ol sets a flag which the lexer consults when it sees a digit ;;; however stupid parsing algorithm looks too far ahead, so the first ;;; variable in a quotation may be read as a number ;;; the first line fixes this. It handles "1==2" but not "1a==2" ;;; (defun cnr-rtn () ;;; (when (numberp token) (setq token (imploden (exploden token)))) ;;; (check endcnr-sym ;;; (case token ;;; (|:| (gnt) (list 'mk-tyquot (olt))) ;;; (t (list 'mk-quot (parse-ol)))) ;;; '|cannot find end of quotation|)) ;cnr-rtn (defun cnr-rtn () (when (numberp token) (setq token (imploden (exploden token)))) (check endcnr-sym (case token (|:| (gnt) (list 'mk-tyquot (olt))) (t (if |%preterm-flag| `(mk-appn (mk-var |preterm_handler|) ,(term-to-preterm (parse-ol))) (list 'mk-quot (parse-ol))))) '|cannot find end of quotation|)) ;;; Convert a parse tree of a term to a parse tree for a pre-term ;;; const, var, etc renamed to preterm_const, preterm_var, etc ;;; [TFM 90.11.19] (defun term-to-preterm (pt) (case (car pt) (MK=CONST `(mk-appn (mk-con |preterm_const|) (mk-tokconst ,(cadr pt)))) (MK=VAR `(mk-appn (mk-con |preterm_var|) (mk-tokconst ,(cadr pt)))) (MK=COMB `(mk-appn (mk-con |preterm_comb|) (mk-dupl ,(term-to-preterm (cadr pt)) ,(term-to-preterm (caddr pt))))) (MK=ABS `(mk-appn (mk-con |preterm_abs|) (mk-dupl ,(term-to-preterm (cadr pt)) ,(term-to-preterm (caddr pt))))) (MK=TYPED `(mk-appn (mk-con |preterm_typed|) (mk-dupl ,(term-to-preterm (cadr pt)) (mk-tyquot ,(caddr pt))))) (MK=ANTIQUOT `(mk-appn (mk-con |preterm_antiquot|) ,(cadr pt))))) (eval-when (load) (setq lang1 'ml1) (setq lang2 'ml2) (setq langlp 'mllp) (setq metaprec 20)) ;;; MJCG 19/10/88 for HOL88 ;;; Sections commented out from HOL88 ;;; MJCG 1/2/90 ;;; Sections reinstated ;;; (but intended for system use only) (eval-when (load) (unop '|begin_section| '(sec-rtn 'mk-begin)) (unop '|end_section| '(sec-rtn 'mk-end))) ;;; MJCG for HOL88 30/1/89 ;;; Parser hack to ensure top_print is only applied at top level ;;; (see lisp/f-writml.l) ;;; MJCG 17/5/92 bugfix: eta-convert argument to top_print ;;; (avoids obscure bug discovered by TFM). ;;; Bound variable of dummy eta-conversion is %top_print-dummy. (eval-when (load) (unop '|top_print| '(cond ((greaterp parsedepth 1) (parse-failed "top_print can only be applied at the top level of ML")) ((eq token '|;;|) (parse-failed "missing argument to top_print")) (t `(mk-appn (mk-var |top_print|) (mk-abstr (mk-var %top_print-dummy) (mk-appn ,(parse-level 0) (mk-var %top_print-dummy)))))))) (eval-when (load) (unop tml-sym '(parse-failed '(stuff missing))) (unop '|true| ''(mk-boolconst t)) (unop '|false| ''(mk-boolconst nil)) (unop '|fail| ''(mk-fail)) (unop exfix-sym '(exfix-rtn)) (unop lparen-sym '(lparen-rtn)) (unop '|do| '(list 'mk-unop '|do| (parse-level 410))) (unop '|if| '(test-rtn)) (unop '|while| '(while-rtn)) (unop '|loop| '(list 'mk-test nil (cons 'iter (parse-level 320)))) (unop '|else| '(list 'mk-test nil (cons 'once (parse-level 320)))) (bnop trap-then-sym '(list 'mk-trap arg1 nil (cons 'once (parse-level 240)))) (bnop trap-loop-sym '(list 'mk-trap arg1 nil (cons 'iter (parse-level 240)))) (bnop trapif-then-sym '(trap-rtn 'once)) (bnop trapif-loop-sym '(trap-rtn 'iter)) (bnop trapbind-then-sym '(trapbind-rtn 'once)) (bnop trapbind-loop-sym '(trapbind-rtn 'iter)) (unop lbrkt-sym '(list-rtn)) (bnop scolon-sym '(seq-rtn)) (unop '|let| '(let-rtn 'mk-let)) (unop '|letrec| '(let-rtn 'mk-letrec)) (unop '|letref| '(let-rtn 'mk-letref)) (unop '|deftype| '(let-rtn 'mk-deftype)) (unop '|lettype| '(let-rtn 'mk-deftype)) (unop '|typeabbrev| '(let-rtn 'mk-deftype)) (unop '|abstype| '(let-rtn 'mk-abstype)) (unop '|absrectype| '(let-rtn 'mk-absrectype)) (unop '|type| '(let-rtn 'mk-type)) (unop '|rectype| '(let-rtn 'mk-rectype)) (bnop '|in| '(in-rtn)) (bnop '|where| '(where-rtn 'mk-let)) (bnop '|whererec| '(where-rtn 'mk-letrec)) (bnop '|whereref| '(where-rtn 'mk-letref)) (bnop '|wheretype| '(where-rtn 'mk-deftype)) (bnop '|whereabstype| '(where-rtn 'mk-abstype)) (bnop '|whereabsrectype| '(where-rtn 'mk-absrectype)) (unop lam-sym '(lamb-rtn)) (unop '|fun| '(fun-rtn)) (unop '\| '(fun-rtn)) (unop '|case| '(case-rtn)) (bnop assign-sym '(assign-rtn)) (bnop comma-sym '(dupl-rtn)) (bnop condl-sym '(cond-rtn)) (bnop disj-sym '(appl-rtn 470 '|%or|)) (bnop conj-sym '(appl-rtn 510 '|%&|)) (unop '|failwith| '(failwith-rtn)) (unop '|not| '(list 'mk-unop '|not| (parse-level 530))) (bnop eq-sym '(appl-rtn 550 eq-sym)) (bnop lt-sym '(appl-rtn 610 lt-sym)) (bnop gt-sym '(appl-rtn 570 gt-sym)) (bnop conc-sym '(appl-rtn 620 conc-sym)) (bnop period-sym '(appl-rtn 640 period-sym)) (bnop plus-sym '(appl-rtn 710 plus-sym)) (bnop mns-sym '(appl-rtn 670 mns-sym)) (unop mns-sym '(list 'mk-unop '%- (parse-level 760))) (bnop mul-sym '(appl-rtn 750 mul-sym)) (bnop div-sym '(appl-rtn 730 div-sym)) (bnop colon-sym '(mltyp-rtn)) (unop cnr-sym '(cnr-rtn))) (eval-when (load) (putprop tml-sym 0 langlp) (putprop '|of| 20 langlp) (putprop rparen-sym 10 langlp) (putprop '|eqindec| 30 langlp) (putprop '|in| 60 langlp) (putprop '|and| 70 langlp) (putprop '|perinlam| 140 langlp) (putprop scolon-sym 150 langlp) (putprop rbrkt-sym 20 langlp) (putprop '|where| 150 langlp) (putprop '|whereref| 150 langlp) (putprop '|whererec| 150 langlp) (putprop '|wheretype| 150 langlp) (putprop '|whereabstype| 150 langlp) (putprop '|whereabsrectype| 150 langlp) (putprop '|perinvs| 220 langlp) (putprop trap-then-sym 250 langlp) (putprop trap-loop-sym 250 langlp) (putprop trapif-then-sym 260 langlp) (putprop trapif-loop-sym 260 langlp) (putprop trapbind-then-sym 260 langlp) (putprop trapbind-loop-sym 260 langlp) (putprop '|loop| 20 langlp) (putprop '|else| 20 langlp) (putprop '|then| 20 langlp) (putprop '|if| 310 langlp) (putprop '|while| 310 langlp) (putprop '|do| 20 langlp) (putprop '|case| 310 langlp) (putprop assign-sym 360 langlp) (putprop comma-sym 400 langlp) (putprop case-sym 20 langlp) (putprop else-sym 20 langlp) (putprop condl-sym 440 langlp) (putprop '|mlinfix| 450 langlp) (putprop '|or| 500 langlp) (putprop conj-sym 520 langlp) (putprop gt-sym 560 langlp) (putprop lt-sym 600 langlp) (putprop eq-sym 540 langlp) (putprop conc-sym 630 langlp) (putprop period-sym 650 langlp) (putprop mns-sym 660 langlp) (putprop plus-sym 700 langlp) (putprop div-sym 720 langlp) (putprop mul-sym 740 langlp) (putprop colon-sym 770 langlp) (putprop '|primary| 1010 langlp)) hol88-2.02.19940316/lisp/f-parser.l0000640000212700021270000003654505407073552014613 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-parser.l ;;; ;;; ;;; ;;; DESCRIPTION: System parser ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: parser (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V1.4 :idents may not start with ', but may include. ;;; ;;; strings may include% ;;; ;;; ;;; ;;; V2.2 :new-exit instead of err in function parse-failed ;;; ;;; ;;; ;;; V3.1 : |...| notation for literal atoms ;;; ;;; ;;; ;;; to do: ;;; ;;; replace parser completely ;;; ;;; speed it up ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (special %skiplimit %char-buffer %special-letters %special-alphanums %special-table %ch |%read_sexpr-flag| %syntax-block-enabled)) (eval-when (compile) (defmacro bounded (lower a upper) `(and (<= ,lower ,a) (<= ,a ,upper)))) ; bounded (setq %skiplimit 30) ; number of strings to print when skipping ;;; Object language strings (setq eq-tok '|==|) ;;; iff-tok removed [TFM 91.01.20] (setq spec-toks (list lambda-tok else-tok '|:| '|(| '|)| anticnr-tok condl-tok '|,| '|.| eq-tok '|<<| '|~| conj-tok disj-tok imp-tok exists-tok forall-tok endcnrtok)) ;;; Meta language symbols (setq %char-buffer nil) (defun next-char () ;; pop %char-buffer if it is non-empty, otherwise read a character. (cond (%char-buffer (prog1 (car %char-buffer) (setq %char-buffer (cdr %char-buffer)))) (t (nextcn)))) ;;; Added by MJCG on 3/3/89 for HOL88.1.01 ;;; Function to skip regular comments % ... % and supercomments %< ... >% ;;; Entered after %< read. (defun skip-comments () (prog (ch) (setq ch (next-char)) (setq %ch (next-char)) loop (cond ((and (= ch cmntchr) (= %ch cmnt-start)) (skip-comments) (setq %ch (next-char))) ((and (= ch cmnt-end) (= %ch cmntchr)) (return))) (setq ch %ch) (setq %ch (next-char)) (go loop))) ;;; get next char ;;; (not possible to skip blanks because of vartypes) ;;; Changed by MJCG on 3/3/89 for HOL88.1.01 to call skip-comments ;;; and use global %ch (defun gnc () (setq %ch (next-char)) (cond ((= %ch cmntchr) (setq %ch (next-char)) (cond ((= %ch cmntchr)) ((= %ch cmnt-start) (skip-comments)) (t (while (not (= (next-char) cmntchr))))) (gnc)) (t %ch))) ;;; Old code (pre HOL88.1.01) ;;;(defun gnc () ;;; (let ((ch (next-char))) ;;; (cond ((= ch cmntchr) ;;; (while (not (= (next-char) cmntchr))) ;skip comments ;;; (gnc)) ;;; (t ch)))) ;gnc ;;; initialize lexical analyzer (defun initlean () (setq token nil) (setq tokchs nil) (setq toktyp nil) (setq hol-char hol-space) (setq toklist nil)) ;initlean ;;; get next string ;;; BUG: scans the first number in a quotation as a number instead of an ;;; identifier (see gnt.l). (defun gnt () (setq cflag (spacep hol-char)) ;for vartypes (berk) (setq ptoken token) (setq ptokchs tokchs) (setq ptoktyp toktyp) (setq pchar hol-char) (while (spacep hol-char)(setq pchar (setq hol-char (gnc))));remove spacing (setq toktyp 1) (cond ((letterp hol-char) (setq tokchs (list hol-char)) ;ident (ident)) ((digitp hol-char) (setq tokchs (list hol-char)) ;number (ML only) (if (eq lang1 'ml1) (numb) (ident))) ((= hol-char tokqt) (setq tokchs nil) ;string (tcn)) (t (setq toktyp 2) (setq hol-char (gnc)) (setq token (ascii pchar)) (if (and(eq token scolon-sym)(= hol-char lf)) ;multics: lines end (setq hol-char (gnc))) ; with lf was (prog2 (gnc)(gnc)) (while (memq hol-char (get token 'double)) (setq token (concat token (ascii hol-char))) (setq hol-char (gnc))))) token) ;gnt (defun numb () ;;scan a number and return its numeric value (let ((accu (- hol-char #/0))) (while (digitp (setq hol-char (next-char))) (setq accu (+ (* accu 10) (- hol-char #/0)))) (setq token accu))) ; numb (defun ident () ;; scan an identifier as a symbol (used also for numbers in OL) (while (alphanump (setq hol-char (gnc))) (push hol-char tokchs)) (setq token (imploden (reverse tokchs)))) ;ident ;;; Changed nconc to append to fix RJB bug (MJCG 12/11/89) (defun tcn () (while (not (= (setq hol-char (next-char)) tokqt)) (if (= hol-char escape) (setq tokchs (append (escape-rtn (next-char)) tokchs)) (push hol-char tokchs))) (newr toklist (imploden (reverse tokchs))) (setq hol-char (gnc)) (setq token tokflag)) ; tcn (defun escape-rtn (char) (cond ((= char #/0) (itrate hol-space 10)) ((digitp char) (itrate hol-space (- char #/0))) ((get (ascii char) 'stringmacro)) (t (list char)))) ;escape-rtn (defun vartype-rtn () (prog (n) (if cflag (return mul-sym)) (setq n 1) loop (ifn (or (numberp token) (= toktyp 1) (eq token mul-sym)) (return (imploden (itrate multiply n)))) (gnt) (when (and (eq ptoken mul-sym) (not cflag)) (setq n (add1 n)) (go loop)) (return (imploden (nconc (itrate multiply n) (exploden ptoken)))) )) ;vartype-rtn (setq token nil) (setq ptoken nil) (setq tokchs nil) (setq ptokchs nil) (setq toktyp nil) (setq ptoktyp nil) (setq hol-char hol-space) ;;; MJCG 27/10/88 for HOL88 (setq %special-letters nil) (setq %special-alphanums nil) (defun charp (ch) (bounded #/! ch #/~)) ; charp (defun upperp (ch) (bounded #/A ch #/Z)) ; upperp (defun lowerp (ch) (bounded #/a ch #/z)) ; lowerp ;;; MJCG 27/10/88 for HOL88 ;;; Added %special-letters (defun letterp (ch) (or (upperp ch) (lowerp ch) (memq ch %special-letters))) ; letterp (defun digitp (ch) (bounded #/0 ch #/9)) ; digitp ;;; MJCG 27/10/88 for HOL88 ;;; Added %special-alphanums (defun alphanump (ch) (or (upperp ch) (lowerp ch) (digitp ch) (= ch #/') (= ch #/_) (memq ch %special-letters) (memq ch %special-alphanums))) ; alphanump (defun spacep (ch) (memq ch (list hol-space cr lf tab ff))) ; spacep ;;; set up token escape codes (putprop '|L| (list lf) 'stringmacro) (putprop '|F| (list ff) 'stringmacro) (putprop '|R| (list cr) 'stringmacro) (putprop '|S| (list hol-space) 'stringmacro) (putprop '|T| (list tab) 'stringmacro) ;;; set up lexical analysis of multi-character special symbols ;;; ideally should be divided ML from OL ;;; MJCG 27/10/88 for HOL88 ;;; Function for setting up double property and recording the ;;; result in %special-table (a disembodied property list) (setq %special-table #+franz (list 'special-table) #-franz nil) (defun put-double (x l) (prog2 #+franz (putprop %special-table (union l (get %special-table x)) x) #-franz (setf (getf %special-table x) (union l (getf %special-table x))) (putprop x (union l (get x 'double)) 'double))) (eval-when (load) (put-double '|=| '(#/> #/=)) (put-double '|-| '(#/>)) (put-double '|<| '(#/< #/=)) (put-double '|:| '(#/=)) (put-double '|?| '(#/? #/\)) (put-double '|;| '(#/;)) (put-double '|:| '(#/:)) (put-double '|!| '(#/! #/\)) (put-double '|/| '(#/\)) (put-double '\\ '(#//)) (put-double '|==| '(#/>)) (put-double '|<=| '(#/>))) (defun unop (op code) (putprop op code lang1)) ;unop (defun bnop (op code) (putprop op code lang2)) ;bnop (defun binop (op lp code) (putprop op code lang2) (putprop op lp langlp)) ;binop ;;; check for expected token, return rslt if OK ;;; the token is expected AFTER the parsing of rslt (defun check (tok rslt msg) (cond ((eq tok token) (gnt) rslt) (t (parse-failed msg)))) ;check (defun parse-failed (msg) (llprinc msg) (llterpri) (llprinc '|skipping: |) (llprinc ptoken) (llprinc space-sym) (llprinc token) (llprinc space-sym) (do ((i %skiplimit (1- i))) ((eq token tml-sym) (if (<= i 0) (llprinc '|. . .|))) (gnt) (when (> i 0) (llprinc token) (llprinc space-sym))) (initlean) (eqsetup) (persetup) (scolonsetup) (hol-persetup) ; defined in: hol-pars.l (hol-restrictsetup) ; defined in: hol-pars.l (hol-insetup) ; defined in: parslet.l (hol-andsetup) ; defined in: parslet.l (hol-eqsetup) ; defined in: parslet.l (hol-commasetup) ; defined in: parslist.l (hol-scolonsetup) ; defined in: parslist.l (throw-from parse nil)) ;parse-failed (setq arg1 nil) ;;; Lisp flag that says at least one syntax block is in operation ;;; Set to t by ml-new_syntax_block in hol-pars.l (setq %syntax-block-enabled nil) ;;; Added 2.2.90 by MJCG for syntax blocks ;;; Grabs raw characters up to (but not including) the terminator ;;; and returns the result imploded into a string (defun syntax-block-rtn (terminator) (prog (chars terminator-chars remaining) (setq chars nil) (setq terminator-chars (exploden terminator)) loop (setq remaining (cdr terminator-chars)) (while (not (= (setq hol-char (next-char)) (car terminator-chars))) (if (= hol-char escape) (setq chars (append (escape-rtn (next-char)) chars)) (push hol-char chars))) (ifn remaining (go exit)) (push hol-char chars) (while (and remaining (= (setq hol-char (next-char)) (car remaining))) (setq remaining (cdr remaining)) (push hol-char chars)) (ifn remaining (go exit)) (push hol-char chars) (go loop) exit (setq remaining terminator-chars) (while remaining (setq remaining (cdr remaining)) (setq chars (cdr chars))) (setq ptoken terminator) (setq hol-char (gnc)) (setq token (gnt)) (return (imploden(nreverse chars))))) ;;; Added 2.2.90 by MJCG ;;; Constructs the parse tree of the translation of a syntax block (defun mk-syntax-block (tok) `(mk-appn (mk-var ,(car(get tok 'syntax-block))) (mk-tokconst ,(syntax-block-rtn (cdr(get tok 'syntax-block)))))) ;;; MJCG 10.12.90 for Centaur: ;;; Constructs the parse tree of the translation of an S-expression block (defun mk-sexpression-block (tok) (prog (%sexpression terminator) (setq %sexpression (read)) (setq terminator (cdr(get tok 'sexpression-block))) (if (eq %sexpression terminator) (parse-failed "Missing S-expression")) (gnt) (cond ((eq token terminator) (gnt) (return (apply (car(get tok 'sexpression-block)) (list %sexpression))))) (parse-failed (concat "Missing terminator: " terminator)))) ;;; MJCG 10.12.90 for Centaur: ;;; Flag to enable input in S-expression form ;;; Modified 13.12.90 by JVT. Moved the addition of |%read_sexpr-flag| to ;;; the %flags list to the file lisp/f-iox-stand.l. The reason being that ;;; %flags is an unknown variable at this stage. (setq |%read_sexpr-flag| nil) ;;; main parse routine ;;; parses text until reaching level cpl ;;; saves its result in the *special arg1 ;;; Modified 2.2.90 by MJCG to handle syntax blocks ;;; Modified 10.2.90 by JVT to fix the syntax blocks for Common Lisp. ;;; -- Involves the adding of a check on numbers because CL doesn't ;;; like one doing a "get" on them (e.g. (get '0 'syntax-block)) ;;; MJCG 10.12.90 for Centaur: added support for S-expression input (defun parse-level (cpl) (prog (x) (incf parsedepth) (cond ((and %syntax-block-enabled (not (numberp token)) (get token 'syntax-block)) (decf parsedepth) (return (setq arg1 (mk-syntax-block token)))) ((and |%read_sexpr-flag| (not (numberp token)) (get token 'sexpression-block)) (decf parsedepth) (return (setq arg1 (mk-sexpression-block token)))) (t (gnt))) (setq arg1 (ifn (or (numberp ptoken) (null (setq x (get ptoken lang1)))) (eval x) (eval atom-rtn))) loop (setq x (ifn (numberp token) (get token langlp))) (unless x (when (lessp cpl juxtlevel) (setq arg1 (eval juxt-rtn)) (go loop)) (decf parsedepth) (return arg1)) (unless (lessp cpl x) (decf parsedepth) (return arg1)) (if (memq (car arg1) declnconstrs) (parse-failed '|non top level decln must have IN clause|)) (setq x (get token lang2)) (if (null x) (parse-failed (catenate '|`| token '|` in the wrong place|))) (gnt) (setq arg1 (eval x)) (go loop))) ;parse-level hol88-2.02.19940316/lisp/f-ol-syntax.l0000640000212700021270000005077105374437113015252 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-ol-syntax.l ;;; ;;; ;;; ;;; DESCRIPTION: Object language abstract syntax ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: ol0 (lisp 1.6) part of Edinburgh LCF ;;; ;;; by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V2.2 : new-exit instead of err ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (special %vtyl %link-names %linkcount |%type_error-flag| %thm-count)) #+franz (declare (localf new-var-type q-free-var q-typeof strip-antiquot print-mk_comb-error prep-ty-for-print get-type-links get-term-links make-link-names prep-term-fn prep-ty-fn prep-term-ty add-term-links add-type-links)) ;;; for writing destructor functions (eval-when (compile) (defmacro destruct (tag x msg) `(cond ((#+franz eq #-franz eql (car ,x) (quote ,tag)) (cdr ,x)) (t (throw-from evaluation ,msg))))) ;destruct ;;; antiquotation (defun q-mk_antiquot (ob) (cons '%ANTIQUOT ob)) ; q-mk_antiquot ;;; predicates (defun q-mk_pred (tok tm) (if (unify (omutant (predicatep tok)) (q-typeof tm)) (make-pred-form tok tm) (failwith '|mk_pred|))) ; q-mk_pred (dml |mk_pred| 2 q-mk_pred ((|string| |#| |term|) -> |form|)) (defun ml-is_pred (fm) (eq (form-class fm) 'pred)) ;ml-is_pred (dml |is_pred| 1 ml-is_pred (|form| -> |bool|)) (defun ml-dest_pred (fm) (destruct pred fm '|dest_pred|)) ;ml-dest_pred (dml |dest_pred| 1 ml-dest_pred (|form| -> (|string| |#| |term|))) ;;; conjunction (defun q-mk_conj (fm1 fm2) (make-conn-form 'conj fm1 fm2)) ;q-mk_conj (dml |mk_conj| 2 q-mk_conj ((|form| |#| |form|) -> |form|)) (defun ml-is_conj (fm) (eq (form-class fm) 'conj)) ;ml-is_conj (dml |is_conj| 1 ml-is_conj (|form| -> |bool|)) (defun ml-dest_conj (fm) (destruct conj fm '|dest_conj|)) ;ml-dest_conj (dml |dest_conj| 1 ml-dest_conj (|form| -> (|form| |#| |form|)) ) ;;; disjunction (defun q-mk_disj (fm1 fm2) (make-conn-form 'disj fm1 fm2)) ;q-mk_disj (dml |mk_disj| 2 q-mk_disj ((|form| |#| |form|) -> |form|) ) (defun ml-is_disj (fm) (eq (form-class fm) 'disj)) ;ml-is_disj (dml |is_disj| 1 ml-is_disj (|form| -> |bool|)) (defun ml-dest_disj (fm) (destruct disj fm '|dest_disj|)) ;ml-dest_disj (dml |dest_disj| 1 ml-dest_disj (|form| -> (|form| |#| |form|)) ) ;;; implication (defun q-mk_imp (fm1 fm2) (make-conn-form 'imp fm1 fm2)) ;q-mk_imp (dml |mk_imp| 2 q-mk_imp ((|form| |#| |form|) -> |form|) ) (defun ml-is_imp (fm) (eq (form-class fm) 'imp)) ;ml-is_imp (dml |is_imp| 1 ml-is_imp (|form| -> |bool|)) (defun ml-dest_imp (fm) (destruct imp fm '|dest_imp|)) ;ml-dest_imp (dml |dest_imp| 1 ml-dest_imp (|form| -> (|form| |#| |form|)) ) ;;; if-and-only-if ;;; all deleted [TFM 90.01.20] ;;;(defun q-mk_iff (fm1 fm2) (make-conn-form 'iff fm1 fm2)) ;q-mk_iff ;;;(dml |mk_iff| 2 q-mk_iff ((|form| |#| |form|) -> |form|) ) ;;;(defun ml-is_iff (fm) (eq (form-class fm) 'iff)) ;ml-is_iff ;;;(dml |is_iff| 1 ml-is_iff (|form| -> |bool|)) ;;;(defun ml-dest_iff (fm) (destruct iff fm '|dest_iff|)) ;ml-dest_iff ;;;(dml |dest_iff| 1 ml-dest_iff (|form| -> (|form| |#| |form|)) ) ;;; negation is a special case of implication, thus no destructors, etc. (defun q-mk_neg (fm) (make-conn-form 'imp fm %falsity)) ;q-mk_neg ;;; universal quantifier (defun q-mk_forall (v fm) (let ((v (strip-antiquot v))) (q-free-var v) (ml-mk_forall v fm)) ) ;q-mk_forall (defun ml-mk_forall (v fm) (if (is-var v) (make-quant-form 'forall v fm) (failwith '|mk_forall|))) ;ml-mk_forall (dml |mk_forall| 2 ml-mk_forall ((|term| |#| |form|) -> |form|)) (defun ml-is_forall (fm) (eq (form-class fm) 'forall)) ;ml-is_forall (dml |is_forall| 1 ml-is_forall (|form| -> |bool|)) (defun ml-dest_forall (fm) (destruct forall fm '|dest_forall|)) ;ml-dest_forall (dml |dest_forall| 1 ml-dest_forall (|form| -> (|term| |#| |form|)) ) ;;; existential quantifier (defun q-mk_exists (v fm) (let ((v (strip-antiquot v))) (q-free-var v) (ml-mk_exists v fm)) ) ;q-mk_exists (defun ml-mk_exists (v fm) (if (is-var v) (make-quant-form 'exists v fm) (failwith '|mk_exists|))) ;ml-mk_exists (dml |mk_exists| 2 ml-mk_exists ((|term| |#| |form|) -> |form|)) (defun ml-is_exists (fm) (eq (form-class fm) 'exists)) ;ml-is_exists (dml |is_exists| 1 ml-is_exists (|form| -> |bool|)) (defun ml-dest_exists (fm) (destruct exists fm '|dest_exists|)) ;ml-dest_exists (dml |dest_exists| 1 ml-dest_exists (|form| -> (|term| |#| |form|)) ) ;;; equivalence and inequivalence are special cases of predicates ;;; thus no destructors, etc. (defun q-mk_equiv (tm1 tm2) (failtrap #'(lambda (tok) (failwith '|mk_equiv|)) (q-mk_pred '|equiv| (q-mk_pair tm1 tm2)))) ; q-mk_equiv (defun q-mk_inequiv (tm1 tm2) (failtrap #'(lambda (tok) (failwith '|mk_inequiv|)) (q-mk_pred '|inequiv| (q-mk_pair tm1 tm2)))) ; q-mk_ienequ ;;; variables ;;; In a quotation, all variables with the same name are identical -- ;;; the alist %vtyl makes sure of that. (defun q-mk_var (tok) (make-var tok (or (assoc1 tok %vtyl) (new-var-type tok))) ) ;q-mk_var ;;; create a new type variable and put it on %vtyl (defun new-var-type (tok) (let ((newty (genlink))) (push (cons tok newty) %vtyl) newty)) ; new-var-type ;;; allows bound variables of the same name to be independent (defun q-free-var (v) (if (is-var v) (new-var-type (get-var-name v))) ) ; q-free-var ;;; variable names must be identifiers ;;; thus genvars will be distinct from any other variables ;;; MJCG 30/11/88 for HOL88 ;;; removed check that variables are constants or allowable identifiers ;;; Old code: ;;;(defun ml-mk_var (tok ty) ;;; (if (or (constp tok) (not (idenp tok))) (failwith '|mk_var|) ;;; (mk_realvar tok ty))) ;ml-mk_var ;;; set up sharing so equivalent variables are "eq" (defun mk_realvar (tok ty) (or (assoc1 ty (get tok '|mk_var|)) (cdr (consprop tok (cons ty (make-var tok ty)) '|mk_var|)))) ; mk_realvar ;;; MJCG 30/11/88 for HOL88 ;;; ml-mk_var replaced by mk_realvar (dml |mk_var| 2 mk_realvar ((|string| |#| |type|) -> |term|)) ;;; Generate a variable, with name that can't conflict with any other ;;; (presuming that genvars cannot be read from theory files) ;;; the name is interned by uniquesym (to avoid weird consequences) (defun ml-genvar (ty) (mk_realvar (uniquesym 'gen 'var) ty)) ;ml-genvar (defun ml-is_var (term) (eq (term-class term) 'var)) ;ml-is_var (dml |is_var| 1 ml-is_var (|term| -> |bool|)) (defun ml-dest_var (tm) (destruct var tm '|dest_var|)) ;ml-dest_var (dml |dest_var| 1 ml-dest_var (|term| -> (|string| |#| |type|))) ;;; constants (defun q-mk_const (tok) (make-const tok (omutant (constp tok)))) ;q-mk_const ;;; includes code to share constants of identical types ;;; (this wastes storage...does it do any good?) ;;; MJCG 1/12/88 for HOL88 ;;; Informative failure messages added (defun ml-mk_const (tok ty) (cond ((assoc1 ty (get tok '|mk_const|))) ((and (constp tok) (unify ty (omutant(constp tok)))) (cdr (consprop tok (cons ty (make-const tok ty)) '|mk_const|))) ((not(constp tok)) (failwith (concat "mk_const: " tok " not a constant"))) ((not(unify ty (omutant(constp tok)))) (failwith (concat "mk_const: wrong type for " tok " supplied"))) (t (failwith "mk_const: mystery failure; please report"))) ) ;ml-mk_const (dml |mk_const| 2 ml-mk_const ((|string| |#| |type|) -> |term|)) (defun ml-is_const (term) (eq (term-class term) 'const)) ;ml-is_const (dml |is_const| 1 ml-is_const (|term| -> |bool|)) (defun ml-dest_const (tm) (destruct const tm '|dest_const|)) ;ml-dest_const (dml |dest_const| 1 ml-dest_const (|term| -> (|string| |#| |type|))) ;;; abstractions (defun q-mk_abs (v tm) (let ((v (strip-antiquot v))) (q-free-var v) (ml-mk_abs v tm)) ) ;q-mk_abs (dml |mk_abs| 2 ml-mk_abs ((|term| |#| |term|) -> |term|)) (defun ml-mk_abs (v tm) (if (is-var v) (make-abs v tm (make-type '|fun| (list (q-typeof v) (q-typeof tm)))) (failwith '|mk_abs|))) ;ml-mk_abs (dml |is_abs| 1 ml-is_abs (|term| -> |bool|)) (defun ml-is_abs (term) (eq (term-class term) 'abs)) ;ml-is_abs ;;; different from other destructors -- throws away the type (defun ml-dest_abs (tm) (car (destruct abs tm '|dest_abs|))) ;ml-dest_abs (dml |dest_abs| 1 ml-dest_abs (|term| -> (|term| |#| |term|))) ;;; MJCG 2/12/88 for HOL88 ;;; The code that follows is to generate nice error messages ;;; from mk_comb and indeterminate types in quotations. ;;; The code is pretty inefficient (it does multiple passes), ;;; but since it is only invoked on errors this should not be a problem. ;;; MJCG 13/11/88 for HOL88 ;;; Function for making a partially evaluated term printable ;;; (remove antiquotations etc) (defun prep-term-fn (tm) (case (term-class tm) (var (make-var (get-var-name tm) (prep-ty-fn(get-type tm)))) (const (make-const (get-const-name tm) (prep-ty-fn(get-type tm)))) (comb (make-comb (prep-term-fn(get-rator tm)) (prep-term-fn(get-rand tm)) (prep-ty-fn(get-type tm)))) (abs (make-abs (prep-term-fn(get-abs-var tm)) (prep-term-fn(get-abs-body tm)) (prep-ty-fn(get-type tm)))) (%ANTIQUOT (prep-term-fn(cdr tm))) (t (failwith "Error in Lisp function prep-term-fn -- please report")))) (defun prep-term-for-print (tm) (let ((tm1 (add-term-links tm))) (let ((%link-names (make-link-names(get-term-links tm1)))) (prep-term-fn tm1)))) ;;; MJCG 2/12/88 for HOL88 ;;; Replace (%LINK) by (%LINK . N) in a term ;;; side effects %linkcount (defun add-term-links (tm) (case (term-class tm) (var (make-var(get-var-name tm) (add-type-links(get-type tm)))) (const (make-const(get-const-name tm) (add-type-links(get-type tm)))) (comb (make-comb (add-term-links(get-rator tm)) (add-term-links(get-rand tm)) (add-type-links(get-type tm)))) (abs (make-abs (add-term-links(get-abs-var tm)) (add-term-links(get-abs-body tm)) (add-type-links(get-type tm)))) (%ANTIQUOT (add-term-links(cdr tm))) (t (failwith "Error in Lisp function add-term-links -- please report")))) ;;; MJCG 2/12/88 for HOL88 ;;; Replace (%LINK) by (%LINK . N) in a type ;;; side effects %linkcount (defun add-type-links (ty) (case (type-class ty) (%ANTIQUOT (cdr ty)) (%VARTYPE ty) (%LINK (cond ((numberp (cdr ty)) ty) ((null (cdr ty)) (cons '%LINK (incf %linkcount))) (t (add-type-links(cdr ty))))) (t (make-type (get-type-op ty) (mapcar (function add-type-links) (get-type-args ty)))))) ;;; MJCG 2/12/88 for HOL88 ;;; Function for extracting %LINKs from a type (defun get-type-links (ty) (case (type-class ty) ((%ANTIQUOT %VARTYPE) nil) (%LINK (if (numberp (cdr ty)) (list (cdr ty)) (get-type-links(cdr ty)))) (t (apply (function append) (mapcar (function get-type-links) (get-type-args ty)))))) ;;; MJCG 25/11/88 for HOL88 ;;; Function for extracting %LINKs from a term (defun get-term-links (tm) (case (term-class tm) (var (get-type-links(get-type tm))) (const (get-type-links(get-type tm))) (comb (append (get-term-links(get-rator tm)) (get-term-links(get-rand tm)))) (abs (append (get-term-links(get-abs-var tm)) (get-term-links(get-abs-body tm)))) (%ANTIQUOT (get-term-links(cdr tm))) (t (failwith "Error in Lisp function get-term-links -- please report")))) ;;; MJCG 25/11/88 for HOL88 ;;; Make a map from %LINK numbers to print names ?, ?1, ?2 ... (defun make-link-names (l) (prog (ll link-names n) (cond ((null l) (return (list nil))) ((= (length l) 1) (return (list(cons (car l) '|?|))))) (setq n 1) (setq ll l) (setq link-names nil) loop (cond ((null ll) (return link-names)) ((assoc-equal (car ll) link-names)) (t (setq link-names (cons (cons (car ll) (concat '|?| n)) link-names)) (setq n (add1 n)))) (setq ll (cdr ll)) (go loop))) ;;; MJCG 13/11/88 for HOL88 ;;; Function for making a partially typechecked type printable ;;; (remove antiquotations, %LINK, %VARTYPE etc) ;;; MJCG 25/11/88 for HOL88 ;;; Code for ?, ?1, ?2, ?3 ... added (defun prep-ty-fn (ty) (case (type-class ty) (%ANTIQUOT (cdr ty)) (%VARTYPE ty) (%LINK (if (numberp (cdr ty)) (make-vartype (cdr (assoc-equal (cdr ty) %link-names))) (prep-ty-fn(cdr ty)))) (t (make-type (get-type-op ty) (mapcar (function prep-ty-fn) (get-type-args ty)))))) (defun prep-ty-for-print (ty) (let ((ty1 (add-type-links ty))) (let ((%link-names (make-link-names(get-type-links ty1)))) (prep-ty-fn ty1)))) ;;; MJCG 13/11/88 for HOL88 ;;; Get type (stripping off %ANTIQUOT if necessary) (defun prep-term-ty (tm) (if (eq (car tm) '%ANTIQUOT) (get-type(cdr tm)) (get-type tm))) ;;; MJCG 13/11/88 for HOL88 ;;; Function for printing mk_comb failure error messages (defun print-mk_comb-error (tm1 tm2) (progn (ptoken "Badly typed application of:") (pbreak 2 4) (ml-print_term(prep-term-for-print tm1)) (pnewline) (ptoken " which has type: ") (pbreak 2 4) (ml-print_type(prep-ty-for-print(prep-term-ty tm1))) (pnewline) (ptoken "to the argument term: ") (pbreak 2 4) (ml-print_term(prep-term-for-print tm2)) (pnewline) (ptoken " which has type: ") (pbreak 2 4) (ml-print_type(prep-ty-for-print(prep-term-ty tm2))) (pnewline) (pnewline))) ;;; MJCG 13/11/88 for HOL88 ;;; Flag to control printing of type errors (setq |%type_error-flag| t) ;;; MJCG 10/11/88 for HOL88 ;;; add error message printing ;;; combinations (defun q-mk_comb (tm1 tm2) (let ((ty (genlink))) (if (unify (q-typeof tm1) (make-type '|fun| (list (q-typeof tm2) ty))) (make-comb tm1 tm2 ty) (prog2 (if |%type_error-flag| (print-mk_comb-error tm1 tm2)) (failwith '|mk_comb|))))) ;q-mk_comb ;;; q-mk_comb tries to unify types while ml-mk_comb expects an exact match ;;; and returns a type free of links. (defun ml-mk_comb (tm1 tm2) (let* ((constyoptyargs (failtrap #'(lambda (tok) (failwith '|mk_comb|)) (ml-dest_type (get-type tm1)))) (tyop (car constyoptyargs)) (tyargs (cdr constyoptyargs))) (if (and (eq tyop '|fun|) (equal (first tyargs)(get-type tm2))) (make-comb tm1 tm2 (second tyargs)) ;;; (prog2 (if |%type_error-flag| (print-mk_comb-error tm1 tm2)) ;;; (failwith '|mk_comb|)))) (failwith '|mk_comb|))) ) ;ml-mk_comb (dml |mk_comb| 2 ml-mk_comb ((|term| |#| |term|) -> |term|)) (defun ml-is_comb (term) (eq (term-class term) 'comb)) ;ml-is_comb (dml |is_comb| 1 ml-is_comb (|term| -> |bool|)) (defun ml-dest_comb (tm) (car (destruct comb tm '|dest_comb|))) ;ml-dest_comb (dml |dest_comb| 1 ml-dest_comb (|term| -> (|term| |#| |term|))) ;;; other terms ;;; put a type constraint onto a term ;;; the type is antiquoted for efficiency ;;; to prevent canon-ty from traversing it (defun q-mk_typed (tm ty) (if (unify (q-typeof tm) (q-mk_antiquot ty)) tm (failwith '|types|)) ) ;q-mk_typed (defun q-mk_pair (tm1 tm2) (q-mk_comb (q-mk_comb (q-mk_const 'PAIR) tm1) tm2)) ;q-mk_pair (defun q-mk_cond (tm1 tm2 tm3) (q-mk_comb (q-mk_comb (q-mk_comb (q-mk_const 'COND) tm1) tm2) tm3) ) ;q-mk_cond ;;; vartypes ;;; create a vartype, maintaining sharing so equivalent vartypes are "eq" (defun q-mk_vartype (tok) (cond ((get tok '|mk_vartype|)) ((= (first (exploden tok)) #/*) (putprop tok (make-vartype tok) '|mk_vartype|)) ((failwith '|mk_vartype|)) )) ;q-mk_vartype (dml |mk_vartype| 1 q-mk_vartype (|string| -> |type|)) (defun ml-is_vartype (ty) (eq (type-class ty) '%VARTYPE)) ;ml-is_vartype (dml |is_vartype| 1 ml-is_vartype (|type| -> |bool|)) (defun ml-dest_vartype (ty) (if (is-vartype ty) (get-vartype-name ty) (failwith '|dest_vartype|))) ;ml-dest_vartype (dml |dest_vartype| 1 ml-dest_vartype (|type| -> |string|)) ;;; compound types ;;; make a compound type ... check number of arguments (defun q-mk_type (op tylist) (cond ((not (equal (get op 'olarity) (length tylist))) (failwith '|mk_type|)) ((null tylist) (get op 'canon)) (t (make-type op tylist)))) ;q-mk_type (dml |mk_type| 2 q-mk_type ((|string| |#| (|type| |list|)) -> |type|)) ;;; no discriminator -- use (not is_vartype) (defun ml-dest_type (ty) (if (is-vartype ty) (failwith '|dest_type|) ty)) ;ml-dest_type (dml |dest_type| 1 ml-dest_type (|type| -> (|string| |#| (|type| |list|)))) ;;; type of any term (defun ml-type_of (tm) (get-type tm)) ;ml-type_of (dml |type_of| 1 ml-type_of (|term| -> |type|)) ;;; type of a term in a quotation (defun q-typeof (tm) (get-type (strip-antiquot tm))) ;q-typeof ;;; Skip over ANTIQUOT nodes (defun strip-antiquot (ob) (while (is-antiquot ob) (setq ob (cdr ob))) ob) ; strip-antiquot (setq %thm-count 0) ; count theorems inferred in session (defun ml-thm_count () %thm-count) ;ml-thm_count (dml |thm_count| 0 ml-thm_count (|void| -> |int|)) (defun ml-mk_thm (sq) (incf %thm-count) sq) ;ml-mk_thm (dml |mk_thm| 1 ml-mk_thm (((|form| |list|) |#| |form|) -> |thm|)) (defun ml-dest_thm (sq) sq) ;ml-dest_thm (dml |dest_thm| 1 ml-dest_thm (|thm| -> ((|form| |list|) |#| |form|))) ;;; the following function definitions depend on the Lisp representation ;;; of theorems, terms, and formulas. (dml |hyp| 1 car (|thm| -> (|form| |list|))) (dml |concl| 1 cdr (|thm| -> |form|)) ;;; if tok is a predicate symbol, then return its type, else nil (defun predicatep (tok) (get tok 'predicate)) ; predicatep ;;; if tok is a constant symbol, then return its type, else nil (defun constp (tok) (get tok 'const)) ;constp ;;; the predicate FALSITY() (setq %empty (make-const '|()| (make-type '|void| nil))) (setq %falsity (make-pred-form 'FALSITY %empty)) ;;; term_class used nowhere in HOL88: deleted [TFM 90.06.05] ;;; (dml |term_class| 1 car (|term| -> |string|)) ;;; Deleted: formulas not used in HOL [TFM 90.06.27] ;;; (dml |form_class| 1 car (|form| -> |string|)) (dml |genvar| 1 ml-genvar (|type| -> |term|)) ;;; This function defined in this file gets redefined later #-franz (proclaim '(notinline constp)) hol88-2.02.19940316/lisp/f-ol-rec.l0000640000212700021270000000773305071123405014463 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-ol-rec.l ;;; ;;; ;;; ;;; DESCRIPTION: Definition of object language data structures ;;; ;;; AUTHOR: Larry Paulson (October 1982) ;;; ;;; ;;; ;;; USES FILES: ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) (macros t)) (defmacro make-thm (asl w) `(cons ,asl ,w)) (defmacro get-hyp (th) `(car ,th)) (defmacro get-concl (th) `(cdr ,th)) (defmacro make-conn-form (conn left right) `(cons ,conn (cons ,left ,right))) (defmacro get-conn (fm) `(car ,fm)) (defmacro get-left-form (fm) `(cadr ,fm)) (defmacro get-right-form (fm) `(cddr ,fm)) (defmacro make-quant-form (quant var body) `(cons ,quant (cons ,var ,body))) (defmacro get-quant (fm) `(car ,fm)) (defmacro get-quant-var (fm) `(cadr ,fm)) (defmacro get-quant-body (fm) `(cddr ,fm)) (defmacro make-pred-form (pred tm) `(cons 'pred (cons ,pred ,tm))) (defmacro get-pred-sym (fm) `(cadr ,fm)) (defmacro get-pred-arg (fm) `(cddr ,fm)) (defmacro form-class (fm) `(car ,fm)) ;;; Terms -- each class of term stores the type in the same place (defmacro make-var (name ty) `(cons 'var (cons ,name ,ty))) (defmacro is-var (tm) `(eq (car ,tm) 'var)) (defmacro get-var-name (tm) `(cadr ,tm)) (defmacro make-const (name ty) `(cons 'const (cons ,name ,ty))) (defmacro is-const (tm) `(eq (car ,tm) 'const)) (defmacro get-const-name (tm) `(cadr ,tm)) (defmacro make-abs (var body ty) `(cons 'abs (cons (cons ,var ,body) ,ty))) (defmacro is-abs (tm) `(eq (car ,tm) 'abs)) (defmacro get-abs-var (tm) `(caadr ,tm)) (defmacro get-abs-body (tm) `(cdadr ,tm)) (defmacro make-comb (rator rand ty) `(cons 'comb (cons (cons ,rator ,rand) ,ty))) (defmacro is-comb (tm) `(eq (car ,tm) 'comb)) (defmacro get-rator (tm) `(caadr ,tm)) (defmacro get-rand (tm) `(cdadr ,tm)) (defmacro get-type (tm) `(cddr ,tm)) (defmacro put-type (tm ty) ;; used in F-thyfns `(rplacd (cdr ,tm) ,ty)) (defmacro term-class (tm) `(car ,tm)) ;;; Types (defmacro make-type (tyop tyargs) `(cons ,tyop ,tyargs)) (defmacro get-type-op (ty) `(car ,ty)) (defmacro get-type-args (ty) `(cdr ,ty)) (defmacro make-vartype (name) `(cons '%VARTYPE ,name)) (defmacro is-vartype (ty) `(eq (car ,ty) '%VARTYPE)) (defmacro get-vartype-name (ty) `(cdr ,ty)) (defmacro is-linktype (ty) `(eq (car ,ty) '%LINK)) (defmacro type-class (ty) `(car ,ty)) (defmacro is-antiquot (ob) `(eq (car ,ob) '%ANTIQUOT)) hol88-2.02.19940316/lisp/f-ol-net.l0000640000212700021270000002241005071123411014462 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-ol-net.l ;;; ;;; ;;; ;;; DESCRIPTION: Descrimination nets for rewriting ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-marco.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec")) #+franz (declare (localf keylist exec-deferred update-net-fm update-alist combine-tips traverse-link)) ;;; Discrimination net program like that in ;;; Charniak, Riesbeck, McDermott. "Artificial Intelligence Programming", ;;; Lawrence Erlbaum Associates, Inc., Hillsdale, NJ ;;; Unlike book version, table updating is purely constructive ;;; These networks are indexed by PPLAMBDA terms and formulas, ;;; for fast rewriting. ;;; Abstract syntax only is stored, and no types ;;; thus networks take up less space than the terms themselves ;;; ALL variables are considered pattern variables ;;; If you store "X" using the index p=>r|s, then any conditional ;;; will retrieve "X", and possibly other elements ;;; Lookup retrieves all possible matches, and some impossible ones. ;;; Since matching is approximate, stored data should include a proper matching ;;; function for the term index ;;; a-list nodes -- keys with entries (eval-when (compile) (defmacro get-key (link) `(car ,link)) (defmacro get-entry (link) `(cdr ,link)) (defmacro make-link (key entry) `(cons ,key ,entry))) ;;; tips of nets (eval-when (compile) (defmacro get-tiplist (x) `(cdr ,x)) (defmacro is-tip (x) `(eq (car ,x) '*tip*)) (defmacro make-tip (x) `(cons '*tip* ,x))) ;;; all the keys of an alist (defun keylist (alist) (mapcar #'car alist)) ; keylist ;;; apply deferred parts of the formula to the net ;;; if none, enter %elem as a tip node of a net (defun exec-deferred (net) (if %deferred (update-net-fm (pop %deferred) net) (make-tip (cons %elem (get-tiplist net)))) ) ; exec-deferred ;;; Using a formula (or term) index, add a new element to the network (defun enter-elem-fm (%elem fm net) (let ((%deferred nil)) (update-net-fm fm net)) ) ; enter-elem-fm ;;; add the formula (or term) fm to the net, creating a new net. ;;; keep track of deferred parts (defun update-net-fm (fm net) (let ((class (form-class fm))) (let ((child (assq1 class net))) (case class ((conj disj imp) ; iff deleted [TFM 90.01.20] (push (get-right-form fm) %deferred) (update-alist net class (update-net-fm (get-left-form fm) child))) ((forall exists) (update-alist net class (update-net-fm (get-quant-body fm) child))) (pred (let ((pname (get-pred-sym fm))) (let ((pchild (assq1 pname child))) (update-alist net class (update-alist child pname (update-net-tm (get-pred-arg fm) pchild)))))) (t (update-net-tm fm net))))) ) ; update-net-fm ;;; add the formula tm to the net, creating a new net. ;;; build up the continuation (defun update-net-tm (tm net) (let ((class (term-class tm))) (let ((child (assq1 class net))) (let ((newchild (case class (var (exec-deferred child)) (const (let ((cname (get-const-name tm))) (let ((cchild (assq1 cname child))) (update-alist child cname (exec-deferred cchild))))) (comb (push (get-rand tm) %deferred) (update-net-tm (get-rator tm) child)) (abs (update-net-tm (get-abs-body tm) child)) (t (lcferror 'update-net-tm))))) (update-alist net class newchild)))) ) ; update-net-tm ;;; update an alist with a new key/entry pair ;;; does not alter list structure, instead copies when needed ;;; this assumes that there are only a small number of distinct keys ;;; such as conj, disj, imp... (defun update-alist (alist key entry) (if (assq key alist) (let ((newrest (update-alist (cdr alist) key entry))) (if (#+franz eq #-franz eql key (get-key (car alist))) newrest (cons (car alist) newrest))) (cons (make-link key entry) alist)) ) ; update-alist ;;; merge two nets into one, sharing whenever possible (defun ml-merge_nets (net1 net2) (cond ((null net1) net2) ((null net2) net1) ((is-tip net1) (make-tip (append (get-tiplist net1) (get-tiplist net2)))) (t (mapcar #'(lambda (key) (make-link key (ml-merge_nets (assq1 key net1) (assq1 key net2)))) (union (keylist net1) (keylist net2))))) ) ; ml-merge_nets ;;; Look up an item in the net, indexed by a term (defun lookup-elem-tm (net tm) (combine-tips (follow-tm tm net))) ;;; Look up an item in the net, indexed by a formula (defun lookup-elem-fm (net fm) (combine-tips (follow-fm fm net))) ;;; Combine results from nondeterministic search (defun combine-tips (tiplist) (if tiplist (append (get-tiplist (car tiplist)) (combine-tips (cdr tiplist)))) ) ; combine-tips ;;; Follow preorder expansion of index formula in the net ;;; Nondeterministic, since matching of terms is. (defun follow-fm (fm net) (if net (case (form-class fm) (pred (follow-tm (get-pred-arg fm) (assq1 (get-pred-sym fm) (assq1 'pred net)))) ((conj disj imp) ; iff deleted [TFM 90.01.20] (mapcan #'(lambda (link2) (follow-fm (get-right-form fm) link2)) (follow-fm (get-left-form fm) (assq1 (get-conn fm) net)))) ((forall exists) (follow-fm (get-quant-body fm) (assq1 (get-quant fm) net))) (t (lcferror 'follow-fm)))) ) ; follow-fm ;;; Follow preorder expansion of index term in the net ;;; A nondeterministic matcher: ;;; since pattern variables match anything, returns a list of subnets (defun follow-tm (tm net) (nconc (if net (case (term-class tm) (var nil) (const (traverse-link (get-const-name tm) (assq1 'const net))) (abs (follow-tm (get-abs-body tm) (assq1 'abs net))) (comb (mapcan #'(lambda (link2) (follow-tm (get-rand tm) link2)) (follow-tm (get-rator tm) (assq1 'comb net)))) (t (lcferror 'follow-tm)))) (list (assq1 'var net))) ) ; follow-tm ;;; Follow down one link in the net ;;; This is deterministic but returns a list anyway, for consistency with ;;; follow-tm and follow-fm (defun traverse-link (key net) (let ((link (assq1 key net))) (if link (list link))) ) ; traverse-link ;;; ML functions used only to define abstract types (dml |merge_nets_rep| 2 ml-merge_nets (((* |list|) |#| (* |list|)) -> (* |list|))) (dml |enter_term_rep| 3 enter-elem-fm ((* |#| (|term| |#| (* |list|))) -> (* |list|))) (dml |lookup_term_rep| 2 lookup-elem-tm (((* |list|) |#| |term|) -> (* |list|))) (dml |enter_form_rep| 3 enter-elem-fm ((* |#| (|form| |#| (* |list|))) -> (* |list|))) (dml |lookup_form_rep| 2 lookup-elem-fm (((* |list|) |#| |form|) -> (* |list|))) hol88-2.02.19940316/lisp/f-obj.l0000640000212700021270000001021005071123417014037 0ustar cammcamm;;; NOTE NOTE NOTE *********************************************************;;; ;;; This file deleted from the build sequence for HOL version 1.12 ;;; ;;; [TFM 90.09.09] ;;; ;;; ************************************************************************;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-obj.l ;;; ;;; ;;; ;;; DESCRIPTION: LISP objects ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Introduced by GH in V4.1 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro")) ;;; discriminators (dml |is_string| 1 ml-is_string (|obj| -> |bool|)) (defun ml-is_string (x) (symbolp x)) ;ml-is_string (dml |is_int| 1 numberp (|obj| -> |bool|)) (dml |is_cons| 1 #+franz dtpr #-franz consp (|obj| -> |bool|)) ;;; constructors (dml |obj_of_string| 1 Id (|string| -> |obj|)) (dml |obj_of_int| 1 Id (|int| -> |obj|)) (defun Id (x) x) ;Id ;;; --------------------------------------------------------------- ;;; The paired cons function later gets REDEFINED to be a ;;; curried function (in ml/ml-curry.ml) ;;; -------------------------------------------------------------- (dml |cons| 2 cons ((|obj| |#| |obj|) -> |obj|)) ;;; destructors (dml |string_of_obj| 1 ml-string_of_obj (|obj| -> |string|)) (defun ml-string_of_obj (x) (if (ml-is_string x) x (throw-from evaluation '|string_of_obj|))) ;ml-string_of_obj (dml |int_of_obj| 1 ml-int_of_obj (|obj| -> |int|)) (defun ml-int_of_obj (x) (if (numberp x) x (throw-from evaluation '|int_of_obj|))) ;ml-int_of_obj (dml |left| 1 ml-left (|obj| -> |obj|)) (defun ml-left (x) (if (consp x) (car x) (throw-from evaluation '|left|))) ;ml-left (dml |right| 1 ml-right (|obj| -> |obj|)) (defun ml-right (x) (if (consp x) (cdr x) (throw-from evaluation '|right|))) ;ml-right ;;; --------------------------------------------------------------- ;;; These paired functions: set_left, set_right and eq, later get ;;; REDEFINED to be curried functions (in ml/ml-curry.ml) ;;; -------------------------------------------------------------- ;;;updators (dml |set_left| 2 ml-set_left ((|obj| |#| |obj|) -> |obj|)) (defun ml-set_left (x y) (if (consp x) (rplaca x y) (throw-from evaluation '|set_left|))) ;ml-set_left (dml |set_right| 2 ml-set_right ((|obj| |#| |obj|) -> |obj|)) (defun ml-set_right (x y) (if (consp x) (rplacd x y) (throw-from evaluation '|set_rigth|))) ;ml-set_right ;;;equality (dml |eq| 2 eq ((|obj| |#| |obj|) -> |bool|)) ;;;lisp eval, for communication between lisp and ml ;;;use with caution! (dml |lisp_eval| 1 eval (|obj| -> |obj|)) hol88-2.02.19940316/lisp/f-mlprin.l0000640000212700021270000001763705071123427014613 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-mlprin.l ;;; ;;; ;;; ;;; DESCRIPTION: Prints the ML parse tree to a given depth to report ;;; ;;; type errors. Called only from f-typeml.l ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: mlprin (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V4-5: rewritten by Larry Paulson to avoid calling ;;; ;;; eval ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro")) #+franz (declare (localf print-nth print-ml-cases print-ml-match print-ml-funcase print-ml1 print-ml-list print-conditional print-trap)) ;;; macro for printing subtrees (eval-when (compile load) (defun expand-print (x) (cond ((numberp x) `(print-nth ,x)) ((atom x) `(llprinc ',x)) (t x))) (defmacro pml #+franz l #-franz (&rest l) (cons 'progn (mapcar #'expand-print l)))) (defun print-nth (n) (print-ml-cases (car (nthcdr n %ex)) %print-depth)) (defun print-ml-cases (%ex %print-depth) (if (atom %ex) (llprinc %ex) (case (car %ex) (mk-nulltyp (pml |void|)) (mk-inttyp (pml |int|)) (mk-booltyp (pml |bool|)) (mk-toktyp (pml |string|)) (mk-termtyp (pml |term|)) (mk-formtyp (pml |form|)) (mk-typetyp (pml |type|)) (mk-thmtyp (pml |thm|)) (mk-vartyp (pml 1)) (mk-consttyp (cond ((null (cddr %ex)) (llprinc (cadr %ex))) ((null (cdddr %ex)) (print-ml1 (caddr %ex)) (llprinc (cadr %ex))) (t (print-ml-list (cddr %ex) '|(| '|,| '|)| ) (llprinc (cadr %ex))))) (mk-listtyp (pml 1 |list|)) (mk-prodtyp (pml |(| 1 |#| 2 |)| )) (mk-sumtyp (pml |(| 1 |+| 2 |)| )) (mk-funtyp (pml |(| 1 -> 2 |)| )) (mk-boolconst (llprinc (if (cadr %ex) '|true| '|false|))) (mk-intconst (pml 1)) (mk-tokconst (pml |`| 1 |`| )) (mk-tyquot (pml |": ... "| )) (mk-quot (pml |" ... "| )) ((mk-var mk-con mk-con0) (pml 1)) ;new (mk-wildcard (pml |_|)) ;new ;;; (mk-var (pml 1)) (mk-fail (pml |fail| )) (mk-failwith (pml |failwith| | | 1)) (mk-empty (pml |()| )) (mk-dupl (pml |(| 1 |,| 2 |)| )) (mk-list (pml (print-ml-list (cdr %ex) '|[| '|;| '|]| ))) (mk-straint (pml |(| 1 |:| 2 |)| )) (mk-appn (pml |(| 1 | | 2 |)| )) (mk-binop (pml |(| 2) (llprinc (cond ((eq (cadr %ex) '%&) '|&|) ((eq (cadr %ex) '|%or|) '| or |) (t (cadr %ex)))) (pml 3 |)| )) (mk-unop (cond ((eq (cadr %ex) '|%-|) (llprinc '|-|)) (t (llprinc (cadr %ex)) (llprinc '| |))) (pml 2)) (mk-do (pml |do| 1)) (mk-seq (print-ml-list (append (cadr %ex) (cddr %ex)) '| | '|;| '| |)) (mk-assign (pml 1 |:=| 2)) (mk-while (pml |while | 1 | do | 2)) (mk-test (print-conditional (cdr %ex))) (mk-trap 1 (print-trap (cddr %ex))) (mk-abstr (pml \(\\ 1 |.| 2 |)| )) (mk-fun (pml |fun |) (print-ml-match (cadr %ex)) (pml |)|)) (mk-case (pml |case | 1 | of |) (print-ml-match (caddr %ex))) (mk-in (pml 1 | in | 2)) (mk-ind (pml 1 | in | 2)) (mk-ina (pml 1 | in | 2)) (mk-let (pml |let | 1 | = | 2)) (mk-letrec (pml |letrec | 1 | = | 2)) (mk-letref (pml |letref | 1 | = | 2)) (mk-deftype (pml |lettype ... |)) (mk-type (pml |type ... |)) (mk-rectype (pml |rectype ... |)) (mk-abstype (pml |abstype ... |)) (mk-absrectype (pml |absrectype ... |)) (mk-begin (pml |begin | 1)) (mk-end (pml |end | 1)) (t (pml | ... |))))) (defun print-ml-match (funcase-list) (print-ml-funcase (car funcase-list)) (mapc #'(lambda (funcase) (llprinc " | ")(print-ml-funcase funcase)) (cdr funcase-list))) ;print-ml-match (defun print-ml-funcase (funcase) (print-ml1 (car funcase)) (llprinc '| . |) (print-ml1 (cdr funcase))) ;print-ml-funcase ;;; Entry point, binding %print-depth (defun print-ml-text (ex %print-depth) (print-ml1 ex)) ;print-ml-text (defun print-ml1 (ex) (cond ((atom ex) (llprinc ex)) ((zerop %print-depth) (llprinc '| ... |)) (t (print-ml-cases ex (sub1 %print-depth))))) ;print-ml1 ;;; MJCG for HOL88 9/2/89 ;;; Bugfix (] not printed for empty lists before) (defun print-ml-list (l open sep close) (llprinc open) (when l ; just brackets if empty list (print-ml1 (car l)) (mapc #'(lambda (x) (llprinc sep) (print-ml1 x)) (cdr l))) (llprinc close)) ;print-ml-list (defun print-conditional (pt) (mapc #'(lambda (x) (llprinc '|if |) (print-ml1 (cadr x)) (llprinc (if (eq (car x) 'once) '| then | '| loop |)) (print-ml1 (cddr x))) (car pt)) (if (cdr pt) ; optional else part (let ((opn (caadr pt)) (body (cdadr pt))) (llprinc (if (eq opn 'once) '| else | '| loop |)) (print-ml1 body)))) ;print-conditional (defun print-trap (f) (mapc #'(lambda (x) (llprinc (if (eq (car x) 'once) trapif-then-sym trapif-loop-sym)) (print-ml1 (cadr x)) (llprinc '| |) (print-ml1 (cddr x))) (car f)) (if (cdr f) ; optional ? or ! part (let ((opn (caadr f)) (body (cdadr f))) (if (atom opn) (llprinc (if (eq opn 'once) trap-then-sym trap-loop-sym)) (progn (llprinc (if (eq (car opn) 'once) trapbind-then-sym trapbind-loop-sym)) (llprinc (cdr opn)) (llprinc '| |))) (print-ml1 body)))) ;print-trap hol88-2.02.19940316/lisp/f-macro.l0000640000212700021270000001067705071123432014404 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-macro.l ;;; ;;; ;;; ;;; DESCRIPTION: Macros for the LCF system ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l) ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (macros t)) ;;; expand a function call ;;; (function f) ---> (f arg1 ... argn) ;;; others ---> (funcall fun arg1 ... argn) (defun call-fun (fun args) (cond ((or (atom fun) (not (member (car fun) '(function quote)))) `(funcall ,fun ,@args)) (t `(,(cadr fun) ,@args)))) ;;; Print a constant string, computing length at compile-time ;;; for this use flatc rather than flatsize2, ;;; since flatc is standard Franz while flatsize2 is flatc with a bug fixed ;;; the flatc bug concerns bignums, which do not concern this macro (defmacro ptoken (str) `(pstringlen ',str ,(flatc str))) (defmacro failwith (tok) `(throw-from evaluation ,tok)) (defmacro msg-failwith (tok . msgs) ;; fail with appended error message `(throw-from evaluation (concat ,tok " -- " . ,msgs))) (defmacro cond-failwith (tok . code) ;; fail if any of the error messages are not nil `(let ((msg (or . ,code))) (cond (msg (throw-from evaluation (concat ,tok " -- " msg)))))) (defmacro failtrap (failfun . trycode) ;; ML failure trapping : trycode ?\tok failfun (let ((x (gensym))) `((lambda (,x) (cond ((atom ,x) ,(call-fun failfun (list x))) (t (car ,x)))) (catch-throw evaluation (list (progn . ,trycode)))))) (defmacro errortrap (errorfun . trycode) ;; Lisp error trapping (let ((x (gensym))) `((lambda (,x) (cond ((atom ,x) ,(call-fun errorfun (list x))) (t (car ,x)))) (errset (progn . ,trycode))))) ;;; Apply the function to successive list elements and return the first ;;; non-nil value. If none, return nil (defmacro exists (fun . lists) (let ((vars (mapcar #'(lambda (ignore) (gensym)) lists))) (let ((inits (mapcar #'(lambda (v l) `(,v ,l (cdr ,v))) vars lists)) (args (mapcar #'(lambda (v) `(car ,v)) vars))) `(do ,inits ((null ,(car vars)) nil) (cond (,(call-fun fun args) (return (list ,@args)))))))) (defmacro forall (fun . lists) (let ((vars (mapcar #'(lambda (ignore) (gensym)) lists))) (let ((inits (mapcar #'(lambda (v l) `(,v ,l (cdr ,v))) vars lists)) (args (mapcar #'(lambda (v) `(car ,v)) vars))) `(do ,inits ((null ,(car vars)) t) (cond (,(call-fun fun args)) ((return nil))))))) (defmacro dml (ml-fn n lisp-fn mty) `(eval-when (load) (declare-ml-fun (quote ,ml-fn) (quote ,n) (quote ,lisp-fn) (quote ,mty)))) (defmacro dmlc (id exp mty) `(eval-when (load) (declare-ml-const (quote ,id) (quote ,exp) (quote ,mty)))) hol88-2.02.19940316/lisp/f-lis.l0000640000212700021270000001246005071123436014066 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-lis.l ;;; ;;; ;;; ;;; DESCRIPTION: ML list functions ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: lis (lisp 1.6) part of Edinburgh LCF ;;; ;;; by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V3.2: cleaning-up of functions ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro")) #+franz (declare (localf succeeds)) (dml |length| 1 length ((%a |list|) -> |int|) ) (dml |rev| 1 reverse ((%a |list|) -> (%a |list|))) (dml |flat| 1 ml-flat (((%a |list|) |list|) ->(%a |list|))) (defun ml-flat (ll) (apply #'append ll)) ;ml-flat ;;; --------------------------------------------------------------- ;;; PAIRED list utilities which later get REDEFINED to be curried ;;; functions (in ml/ml-curry.ml) ;;; -------------------------------------------------------------- (dml |mem| 2 #+franz member #-franz member-equal-function ((%a |#| (%a |list|)) -> |bool|)) #-franz (defun member-equal-function (x y) (member x y :test #'equal)) (dml |map| 2 ml-map (((%a -> %b) |#| (%a |list|)) -> (%b |list|))) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-map (%%f l) (mapcar #'(lambda (x) (%ap %%f x)) l)) ;ml-map (dml |exists| 2 ml-exists (((%a -> |bool|) |#| (%a |list|)) -> |bool|)) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-exists (p l) ;ml-exists (block found (while l (if (%ap p (pop l)) (return-from found t))) nil)) (dml |forall| 2 ml-forall (((%a -> |bool|) |#| (%a |list|)) -> |bool|)) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-forall (p l) (block found (while l (ifn (%ap p (pop l)) (return-from found nil))) t)) ;ml-forall (dml |find| 2 ml-find (((%a -> |bool|) |#| (%a |list|)) -> %a)) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-find (p l) (block found (while l (let ((x (pop l))) (if (%ap p x) (return-from found x)))) (throw-from evaluation '|find|))) ;ml-find (dml |tryfind| 2 ml-tryfind (((%a -> %b) |#| (%a |list|)) -> %b)) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-tryfind (%%f %l) (block found (while %l (catch-throw evaluation (return-from found (%ap %%f (pop %l))))) (throw-from evaluation '|tryfind|))) ;ml-tryfind (dml |filter| 2 ml-filter (((%a -> |bool|) |#| (%a |list|)) -> (%a |list|))) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-filter (p l) (let ((r nil)) (while l (let ((x (pop l))) (if (%ap p x) (push x r)))) (reverse r))) ;ml-filter (dml |mapfilter| 2 ml-mapfilter (((%a -> %b) |#| (%a |list|)) -> (%b |list|))) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-mapfilter (%%f %l) (let ((r nil)) (while %l (catch-throw evaluation (push (%ap %%f (pop %l)) r))) (reverse r))) ;ml-mapfilter (dml |rev_itlist| 3 ml-rev_itlist (((%a -> (%b -> %b)) |#| ((%a |list|) |#| %b)) -> %b)) ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun ml-rev_itlist (f l x) (while l (setq x (%ap (%ap f (pop l)) x))) x) ;ml-rev_itlist ;;; ap changed to %ap for HOL version 12 [TFM 90.11.11] (defun succeeds (%%f x) (block OK (catch-throw evaluation (%ap %%f x) (return-from OK t)) nil)) ;succeeds hol88-2.02.19940316/lisp/f-help.l0000640000212700021270000001155405071123447014234 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-help.l ;;; ;;; ;;; ;;; DESCRIPTION: On-line help system ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro") (special %search-path %help-search-path)) ;;; Keyword facility deleted: should be replaced by a more sophisticated ;;; method of looking things up. [TFM 90.09.08] ;;; ;;; (dml |keyword| 1 ml-keyword (|string| -> |void|)) ;;; ;;; (defun ml-keyword (tok) ;;; (let ;;; ((file (fileexists 'kwic "hol"))) ;;; (if file ;;; (keyword-search tok file) ;;; (failwith "Could not find HOL keyword file")))) ;;; The variable %help-search-path is the search path for help information. ;;; It is set in Makefile. ;;; Added by MJCG on 7 Dec 1989 ;;; Revised by TFM 90.12.01 (made available in ML) ;;; Initialized to nil (setq %help-search-path nil) ;;; TFM 90.12.01 for version 1.12 ;;; dml-ed function to return the help search path (defun ml-help_search_path () %help-search-path) (dml |help_search_path| 0 ml-help_search_path (|void| -> (|string| |list|))) ;;; TFM 90.12.01 HOL88 version 12 ;;; dml-ed function for setting the help search path from ML (defun ml-set_help_search_path (new-path) (progn %help-search-path (setq %help-search-path new-path) nil)) (dml |set_help_search_path| 1 ml-set_help_search_path ((|string| |list|) -> |void|)) ;;; %help-search-path now set in Makefile. (note %hol-dir no longer used) ;;; (defun set-help-search-path () ;;; (setq ;;; %help-search-path ;;; (list (concat %hol-dir '|/help/Reference/RULES/|) ;;; (concat %hol-dir '|/help/Reference/TACTICS/|) ;;; (concat %hol-dir '|/help/Reference/GENFNS/|) ;;; (concat %hol-dir '|/help/Reference/LOGFNS/|) ;;; (concat %hol-dir '|/help/Reference/LIBRARIES/|)))) (dml |help| 1 ml-help (|string| -> |void|)) ;;; Help system changed to search %help-search-path. ;;; .doc files are looked for first and if found processed ;;; with the sed script help/Reference/doc-to-help.sed. ;;; If no .doc file is found then a .jac file is searched for ;;; and if found processed with help/Reference/jac-to-help.sed ;;; MJCG 7 December 1989 ;;; Old code: ;;; (defun ml-help (tok) ;;; (let ;;; ((file (fileexists 'help tok))) ;;; (if file ;;; (display-file file) ;;; (msg-failwith "help" "No information available on " tok)))) ;;; Chaneged to allow for alias for whacky help files (eg '/.doc') by using an ;;; association list. [JVT 17 March 1991]. ;;; .hat association list entry added [TFM 17.03.91] (defun ml-help (tok) (let ((%search-path %help-search-path) (isothername (assoc tok '((|/| |.div|)(|^| |.hat|))))) (let ((realname (if (null isothername) tok (cadr isothername)))) (let ((doc-file (fileexists 'doc realname))) (if doc-file (display-file doc-file '|doc|) (let ((jac-file (fileexists 'jac realname))) (if jac-file (display-file jac-file '|jac|) (msg-failwith "help" "No information available on " tok)))))))) hol88-2.02.19940316/lisp/f-gp.l0000640000212700021270000001521105407073541013706 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-gp.l ;;; ;;; ;;; ;;; DESCRIPTION: General-purpose functions ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: gp (lisp 1.6) part of Edinburgh LCF ;;; ;;; by M. Gordon, R. Milner and C.Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V3.1 Unix -- added "uniquesym" ;;; ;;; Changed "can" to avoid non-local "return" from "tag" (caused looping);;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (*lexpr concat)) #+franz (declare (localf outq)) (eval-when (compile load eval) (defconstant word-sep (cascii '|%|))) ; word separator for uniquesym (defun triple (x y z) (cons x (cons y z))) ;;; A family of "assoc" functions that match the cdr instead of the car (defun revassoc (x l) (block found (while l (when (equal x (cdar l)) (return-from found (car l))) (setq l (cdr l))))) (defun revassq (x l) (block found (while l (when (#+franz eq #-franz eql x (cdar l)) (return-from found (car l))) (setq l (cdr l))))) ;;; "assoc" functions that return only the opposite element of the pair found (defun revassoc1 (x l) (car (revassoc x l))) ; revassoc1 (defun revassq1 (x l) (car (revassq x l))) ;revassq1 (defun assq1 (x l) (block found (while l (when (#+franz eq #-franz eql x (caar l)) (return-from found (cdar l))) (setq l (cdr l))))) (defun assoc1 (x l) (block found (while l (when (#+franz equal #-franz fast-list-equal x (caar l)) (return-from found (cdar l))) (setq l (cdr l))))) #-franz (defun fast-list-equal (x y) ;; a version of equal that works only for symbols, numbers and lists, ;; i.e. ignores vectors, structures etc for speed since they are never ;; encountered (declare (optimize (speed 3) (safety 0) (space 0))) (tagbody loop (cond ((eql x y) (return-from fast-list-equal t)) ((and (consp x) (consp y) (fast-list-equal (car (the cons x)) (car (the cons y)))) (setq x (cdr (the cons x))) (setq y (cdr (the cons y))) (go loop)) (t (return-from fast-list-equal nil))))) (defun itlist (fn xl x) (let ((rxl (reverse xl))) (while rxl (setq x (funcall fn (pop rxl) x))) x)) ; itlist (defun consprop (i v p) (car (putprop i (cons v (get i p)) p))) ;consprop (defun itrate (ch n) ;; duplicates ch in a list of length n (let ((l nil)) (while (not (zerop n)) (push ch l) (decf n)) l)) ; itrate (defun can (fn args) ;t iff fn[args] does not fail (block canit (catch-throw evaluation (apply fn args) (return-from canit t)) nil)) (defun inq (x l) (if (memq x l) l (cons x l))) ;inq (defun outq (x l) (when l (let ((outtail (outq x (cdr l)))) (if (#+franz eq #-franz eql x (car l)) outtail (cons (car l) outtail))))) ; outq (defun qeval (x) (list 'quote x)) ;qeval ;;; Generates symbols of the form " prefix1 % prefix2 % " ;;; These symbols may be written to the compiler output file, ;;; thus they should be unique even between sessions of LCF. ;;; The first prefix identifies the class of the symbol ;;; The second prefix should contribute to uniqueness of the symbol ;;; The symbol count is started at a random integer [1..100]. (defun uniquesym (prefix1 prefix2) (incf %symcount) (concat prefix1 '|%| prefix2 '|%| %symcount)) ;;; initialization of uniquesym (eval-when (load) (when initial%load (setq %symcount 0))) ;;; Explode an atom into words separated by the "word-sep" ;;; "ML % % " --> ("ML" ) ;;; Needed to identify different kinds of uniquesyms (defun explode-word (at) (when (atom at) (let ((chars (nreverse (cons word-sep (exploden at)))) (wordlist nil)) (while chars (let ((word nil)) (while (not (= (car chars) word-sep)) (push (pop chars) word)) (pop chars) (push (imploden word) wordlist))) wordlist))) ; explode-word (defun split (ll) (ifn ll (cons nil nil) (let* ((consl1l2 (split (cdr ll))) (l1 (car consl1l2)) (l2 (cdr consl1l2))) (cons (cons (caar ll) l1) (cons (cdar ll) l2))))) ; split (defun binarize (ll tag) (if ll (ifn (cdr ll) (car ll) (list tag (car ll) (binarize (cdr ll) tag))))) ;binarize (defun dis-place (p1 p2) ;;; NOT "displace" which is crazy on the Symbolics (rplaca p1 (car p2)) (rplacd p1 (cdr p2))) ;dis-place (defun putpropl (l prop) (mapcar #'(lambda (x) (putprop (car x) (cdr x) prop)) l)) ;putpropl hol88-2.02.19940316/lisp/f-freadth.l0000640000212700021270000002014405222107631014707 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-freadth.l ;;; ;;; ;;; ;;; DESCRIPTION: Fast theory read in CL (except Lucid). NOTE THAT ;;; ;;; THIS CODE IS ONLY FOR COMMON LISP HOL AND NOT FRANZ ;;; ;;; LISP HOL ;;; ;;; AUTHOR: John Carroll, University of Cambridge (May 1990) ;;; ;;; ;;; ;;; USES FILES: f-cl.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; *** Patch to lisp/f-thyfns.l (eval-when (load eval) (warn "lisp/f-freadth.l is redefining function THY-READ")) (eval-when (compile) (include "lisp/f-macro")) (defun thy-read (thy #+franz piport #-franz *standard-input*) (second ; to ignore the (quote ...) (third ; to ignore the (setq %theorydata ...) (errortrap #'(lambda (ertok) (msg-failwith %failtok thy " theory damaged")) ;; Franz-compatible theory reader only applicable in ;; CL - also not much use on non-unix architectures ;; added PC to exclusions (JAC 19.06.92) #+(or franz :macintosh pc lucid) (llread) #-(or franz :macintosh pc lucid) (fast-read-theory *standard-input*)) ))) ;;; *** End of patch to lisp/f-thyfns.l ;;; Following are symbols within theory data to make sure end up in ;;; upper case, to agree with their casing in rest of HOL CL code (defvar *fast-read-upper-case* (make-hash-table :size 40 :test #'equal)) (eval-when (load eval) (mapc '(lambda (str) (setf (gethash str *fast-read-upper-case*) (intern (string-upcase str)))) '("%t" "abs" "comb" "const" "pred" "var"))) ;;; Minimal 'readtable' just for reading in theory files (defvar *fast-read-char-vector* (make-array 256 :initial-element :constituent)) (eval-when (load eval) (mapc '(lambda (char) (setf (svref *fast-read-char-vector* (char-int char)) nil)) ; whitespace '(#\space #\newline #\tab #\linefeed)) (mapc '(lambda (char) (setf (svref *fast-read-char-vector* (char-int char)) :non-constituent)) '(#\( #\))) (setf (svref *fast-read-char-vector* (char-int #\\)) :single-escape) (setf (svref *fast-read-char-vector* (char-int #\|)) :multiple-escape) (setf (svref *fast-read-char-vector* (char-int #\")) :string-quote)) ;;; (eval-when (compile load eval) (defmacro eq-chars (x y) `(char= (the character ,x) (the character ,y)))) (defun fast-peek-skipping (stream) ;; the same as (peek-char t ,stream nil nil) (declare (optimize (speed 3) (safety 0))) (let ((char (read-char stream nil nil))) #+(or kcl akcl) (declare (object char)) (loop (unless char (return)) (when (svref (the simple-vector *fast-read-char-vector*) (the fixnum (char-int (the character char)))) (unread-char char stream) (return)) (setq char (read-char stream nil nil))))) ;;; (defun fast-read-theory (stream) (fast-peek-skipping stream) (fast-read-expr stream (read-char stream) 1)) (defun fast-read-expressions (stream level) (declare (optimize (speed 3) (safety 0))) (let ((exps nil) (char nil)) (loop (setq char (read-char stream)) (cond ((eq-chars char #\)) (fast-peek-skipping stream) (return (nreverse exps))) ((eq-chars char #\.) (fast-peek-skipping stream) (let ((res (nreverse exps))) (rplacd (last res) (fast-read-expr stream (read-char stream) level)) ;; assume followed immediately by right parenthesis (read-char stream) (fast-peek-skipping stream) (return res))) (t (push (fast-read-expr stream char level) exps)))))) (defun fast-read-expr (stream char level) (declare (optimize (speed 3) (safety 0))) (cond ((eq-chars char #\') ;; assume no whitespace after quote (list 'quote (fast-read-expr stream (read-char stream) (1+ level)))) ((eq-chars char #\() ;; assume no whitespace after open parenthesis (let ((exps (fast-read-expressions stream (1+ level)))) (when (= level 4) (setf (car exps) (intern (string (car exps))))) exps)) (t (fast-read-atom stream char)))) ;;; Changed buffer from a static string to being held in a special variable ;;; since IBCL choked on it (JAC 19.06.92) (defvar *fast-read-atom-buffer* (make-string 256)) (defun fast-read-atom (stream char) (declare (optimize (speed 3) (safety 0))) (let ((buffer *fast-read-atom-buffer*) (index 0) (number-p (digit-char-p (the character char))) (string-p nil) (multiple-escape-p nil) (escaped-p nil) type) (declare (fixnum index)) (loop (setq type (svref (the simple-vector *fast-read-char-vector*) (the fixnum (char-int (the character char))))) (cond ((eq type :single-escape) (setq escaped-p t) (setf (schar buffer index) (read-char stream)) (incf index)) ((eq type :multiple-escape) (setq escaped-p t) (setq multiple-escape-p (not multiple-escape-p))) ((eq type :string-quote) (if string-p (return) (setq string-p t))) ((or (eq type :constituent) multiple-escape-p string-p) (setf (schar (the string buffer) (the fixnum index)) char) (setq index (the fixnum (1+ (the fixnum index))))) ((null type) ; whitespace (fast-peek-skipping stream) (return)) (t ; :non-constituent (unread-char char stream) (return)) ) (setq char (read-char stream))) (if number-p (parse-integer buffer :end index) (do* ((res (make-string index)) (x 0 (the fixnum (1+ (the fixnum x))))) ((= (the fixnum x) (the fixnum index)) (cond (string-p res) (escaped-p (intern res)) ((gethash res *fast-read-upper-case*)) (t (intern res)))) (declare (fixnum x)) (setf (schar (the string res) x) (the character (schar (the string buffer) x))))))) ;;; End of file hol88-2.02.19940316/lisp/f-franz.l0000640000212700021270000002602105071123463014415 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-franz.l ;;; ;;; ;;; ;;; DESCRIPTION: Compatibility file for Franz Lisp ;;; ;;; ;;; ;;; USES FILES: (none) ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) (macros t) (*lexpr concat uconcat catenate) (special user-top-level ER%all $gcprint prinlength prinlevel %std-input fin-ligne %debug |%theory_pp-flag| %liszt poport piport inputstack outfiles %outport %directory)) (sstatus translink on) (sstatus ignoreeof t) ;;; Exit from lisp. (quit) is a normal exit. Calling (quit 1) should set ;;; an error return code so that an enclosing OS make will also terminate. (defun quit (&rest args) (apply #'exit args)) ;;; Saving a core image (defun ml-save (tok) (setq tok (cond ((and (boundp '%directory) (symbol-value '%directory)) (catenate (symbol-value '%directory) tok)) (t tok))) ;; set top level loop to be (tml) (gc) (let ((user-top-level 'drain-tml)) (apply 'dumplisp (list tok)))) ;;; LCF must die upon receiving the hangup signal (HUP) ;;; otherwise LCF jobs started under Emacs will remain around causing havoc (defun exit-fun (x) (exit 0)) (signal 1 'exit-fun) ;;; Declarations (defmacro defconstant (x y) `(progn 'compile (eval-when (compile load) (special ,x)) (eval-when (compile load eval) (setq ,x ,y)))) (defmacro synonymq (sym1 sym2) `(putd ',sym1 (getd ',sym2))) ;;; Control constructs (defmacro block (name . body) `(*catch ',name (progn ,@body))) (defmacro return-from (name . body) `(*throw ',name ,(if (cdr body) `(progn ,@body) (car body)))) (defmacro catch-throw (name . body) `(*catch ',name (progn ,@body))) (defmacro throw-from (name . body) `(*throw ',name ,(if (cdr body) `(progn ,@body) (car body)))) (defmacro if (test then . else) `(cond (,test ,then) (t nil ,@else))) (defmacro unless (test . body) `(cond (,test nil) (t ,@body))) (defmacro when (test . body) `(cond (,test ,@body))) (defmacro mapl (fn &rest lsts) `(map ,fn ,@lsts)) ;;; Old version (commented out on 28 Sept 1989 by MJCG) ;;;(defun case-aux (clause var) ;;; (cond ;;; ((memq (car clause) '(t otherwise)) ;;; (cons 't (cdr clause))) ;;; ((atom (car clause)) ;;; (cons (list 'eq var (list 'quote (car clause))) ;;; (cdr clause))) ;;; (t ;;; (cons (list 'memq var (list 'quote (car clause))) ;;; (cdr clause))))) ;;; ;;;(defmacro case (sel . lclauses) ;;; (let ((var (gensym))) ;;; `(let ((,var ,sel)) ;;; (cond ;;; ,@(mapcar ;;; #'(lambda (clause) (case-aux clause var)) ;;; lclauses))))) ;;; New version (prompted by DES bug) MJCG 28 Sept 1989 (defmacro case (sel . lclauses) `(selectq ,sel ,@lclauses)) (defmacro ifn (test then . else) `(cond ((not ,test) ,then) (t nil ,@else))) (defmacro newr (var val) `(setq ,var (cond (,var (nconc ,var (list ,val))) (t (list ,val))))) (defmacro until (test . body) ;; The let avoids double evaluation of test on exit. ;; This will give compiler warnings in Franz compiler, since ;; the go and the return are non-local. (let ((lable (gensym)) (valvar (gensym))) `(prog () ,lable (let ((,valvar ,test)) (cond (,valvar (return ,valvar)) (t ,@body (go ,lable))))))) (defmacro while (test . body) (let ((lable (gensym))) `(prog () ,lable (cond (,test ,@body (go ,lable)) (t (return nil)))))) ;;; Arithmetic ;;; ;;; IMPORTANT! ;;; In franz changed decf, incf, and when to use cond instead of if ;;; decr did not work because "if" was undefined for it ;;; the manifestation of this bug was most obscure. (defmacro decf (var val) `(setq ,var ,(cond ((null val) `(1- ,var)) (t `(- ,var ,val))))) (defmacro incf (var val) `(setq ,var ,(cond ((null val) `(1+ ,var)) (t `(+ ,var ,val))))) (defmacro <= (x y) `(not (greaterp ,x ,y))) (defmacro >= (x y) `(not (lessp ,x ,y))) (defmacro integerp (x) `(fixp ,x)) (defmacro truncate (x y) `(*quo ,x ,y)) ;;; List manipulation (defmacro first (x) `(car ,x)) (defmacro second (x) `(cadr ,x)) (defmacro third (x) `(caddr ,x)) (defmacro fourth (x) `(cadddr ,x)) (defmacro fifth (x) `(car (cddddr ,x))) (synonymq assoc-equal assoc) (synonymq member-equal member) (synonymq subst-equal subst) (defmacro copy-tree (x) `(copy ,x)) (defmacro list* l `(cons ,(car l) ,(cond ((null (cddr l)) (cadr l)) (t `(list* ,@(cdr l)))))) (defmacro pop (var) `(prog1 (car ,var) (setq ,var (cdr ,var)))) (defmacro push (val var) `(setq ,var (cons ,val ,var))) (defun union (x y) ;; union of two lists, without repetitions using eq test (cond ((null x) y) ((memq (car x) y) (union (cdr x) y)) (t (cons (car x) (union (cdr x) y))))) ;;; Misc (defun canonise-case-symbol (x) x) (synonymq probe-file probef) (defmacro gensym-interned nil '(intern (gensym))) (defmacro atomify (x) `(implode (explodec ,x))) ;;; The scanner functions (synonymq imploden implode) (synonymq printint exploden) (synonymq consp dtpr) (defun catenate (&rest l) ;; catenate a list of things into a STRING (get_pname (apply 'uconcat l))) (defun cascii (a) ;; the ascii code of symbol a (getcharn a 1)) ;;; IO functions (defun llterpri () (terpri poport)) (defun llprinc (expr) (princ expr poport)) (defun llprint (expr) ;; changed by MJCG for HOL so that if |%theory_pp-flag| is t ;; then theories are pretty-printed. (if |%theory_pp-flag| (pp-form expr poport) (print expr poport))) (defun llreadcn () (let ((char (readc piport))) (if char (cascii char)))) (defun llread () (read piport)) ;;; Re-direct input from terminal to given file ;;; inputstack holds all previous values of piport (defun infilepush (filespec) (push piport inputstack) (setq piport (infile filespec))) ; infilepush (defun infilepop () ;; Restore previous input file after closing current one (close piport) (setq piport (pop inputstack))) (defun clock () ;; Get absolute time - just for time-stamps (sys:time)) ;;; stupid Franz does not have a symbol bound to standard input (setq %std-input piport) ; for flushing tty ;;; Turn debugging on/off ;;; sets Lisp debugging switches, interrupt handler, and top-level (defun setdebug (flag) (cond (flag (debugging t) (setq $gcprint t) ; monitor garbage collections (setq prinlength 6) ; control printing of circular lists (setq prinlevel 4) (sstatus translink nil) (signal 2 '|sys:int-serv|) ; restore Franz interrupt handler ; was INT in Cambridge version (setq user-top-level nil)) (t (sstatus translink on) (setq $gcprint nil) (setq prinlength nil) (setq prinlevel nil) (setq ER%all nil) ; remove error handler (*rset nil) (signal 2 'handle-interrupt) (setq user-top-level 'tml)))) ;;; make an interrupt cause a break ;;; called when user hits interrupt key (defun handle-interrupt (signal-number) (terpri) (princ "HOL interrupted") (break)) ;;; Function called on returning from tml command loop ;;; Clears user-top-level to prevent automatic re-entry to ML (defun finalize-tml () (setdebug t) (reset)) ;;; Turn off debugging switches and set top level to (tml) ;;; initialize $ldprint, which is the internal value of |%print_fasl-flag| (defun setup nil (setdebug nil) (setq $ldprint nil) ; to turn off ugly fasl messages [TFM 91.01.20] ;; (allocate 'list 500) ; to help gc problems - only for LCF (reset)) ;;; set the internal |%print_fasl-flag| value (defun set-fasl-flag (val) (setq $ldprint val) (setq |%print_fasl-flag| val)) (defun setup-ml nil (setdebug nil) (reset)) ;;; initialize system in experimental mode - turn debug options on (defun experimental-init () (princ "Experimental version!") (terpri) (load "f-franz") (load "f-macro") (load "f-ol-rec") (setdebug t)) ;;; set up batch loading of system via Makefile (defun set-make () (setq ER%all 'make-err-handler)) ;;; report error to log file and abort job (defun make-err-handler (msg) (princ '|error during loading of system:|)(terpri) (let (((type id cont string . data) msg)) (princ string) (mapc #'(lambda (x) (princ '| |) (print x)) data) (terpri) (baktrace) (quit 1))) ;;; get the date as a string ;;; date changed to include year (TFM 88.08.02) (defun date nil (concat (substring (status ctime) 5 6) (substring (status ctime) 20 5))) (defun flatsize2 (str) ;; standard flatc does not work on bignums (if (bigp str) (length (explodec str)) (flatc str))) ;;; Return (jobtime . gctime) where jobtime does not include gctime ;;; in 10ths of seconds (rounded) (defun runtime10th () (let (((proc gc) (ptime))) (cons (quotient (- proc gc) 6) (quotient gc 6)))) (defun bigger (obj size) (> (flatc obj size) size)) (defun drain-tml () ;; throws away junk left in Make commands (stupid Franzlisp!) (drain %std-input) (setq fin-ligne t) (tml)) (defun init-io () (setq piport nil) (setq poport nil) (setq outfiles nil) (setq inputstack nil) (setq %outport nil)) ;;; Call a lisp listener (defun ml-break nil (break)) hol88-2.02.19940316/lisp/f-format.l0000640000212700021270000003011505071123467014570 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-format.l ;;; ;;; ;;; ;;; DESCRIPTION: Pretty printer for ML and OL values and types ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l, f-constants.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Created by L. Paulson in unix version 3.1 ;;; ;;; ;;; ;;; V4.1 added "inconsistent breaks", record macros, depth limit, ;;; ;;; hypenated some names ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; method based on ;;; Oppen, Derek C., "Pretty Printing", ;;; Technical report STAN-CS-79-770, Stanford University, Stanford, CA. ;;; Also in ACM TOPLAS, October 1980, P. 465. (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro") (include "lisp/f-constants") (special %max-depth %margin %output-buffer)) #+franz (declare (localf push-print-stack print-blanks break-new-line break-same-line clear-scan-stack scan-push scan-pop scan-empty scan-top clear-queue enqueue advance-left setsize enqueue-string pbegin-block)) ;;; constant definitions (eval-when (compile load) (defconstant %infinity 999999)) ;large value for default token size ;;; global variables (default changed from 30 to 500 by mjcg for hol) ;;; Buffer output (makes printing quicker in some implementations) ;;; - flush on newline (setq %max-depth 500) ;max be re-set by user (setq %margin 72) ;right margin (setq %output-buffer nil) ;;; %space ; space remaining on this line ;;; %left-total ; total width of tokens already printed ;;; %right-total ; total width of tokens ever put in queue ;;; %pstack ; printing stack with indentation entries ;;; %prettyon ; indicates if pretty-printing is on ;;; %curr-depth ; current depth of "begins" ;;; %max-depth ; max depth of "begins" to print ;;; data structures ;;; a token is one of ;;; ('string text) ;;; ('break width offset) ;;; ('begin indent [in]consistent ) ;;; ('end) (eval-when (compile) (defmacro tok-class (tok) `(car ,tok)) (defmacro get-string-text (tok) `(cadr ,tok)) (defmacro get-break-width (tok) `(cadr ,tok)) (defmacro get-break-offset (tok) `(caddr ,tok)) (defmacro get-block-indent (tok) `(cadr ,tok)) (defmacro get-block-break (tok) `(caddr ,tok))) ;;; the Scan Stack ;;; each stack element is (left-total . qi) ;;; where left-total the value of %left-total when element was entered ;;; and qi is the queue element whose size must later be set (eval-when (compile) (defmacro make-ss-elem (left qi) `(cons ,left ,qi)) (defmacro get-left-total (x) `(car ,x)) (defmacro get-queue-elem (x) `(cdr ,x))) ;;; the Queue ;;; elements (size token len) (eval-when (compile) (defmacro make-queue-elem (size tt len) `(list ,size ,tt ,len)) (defmacro get-queue-size (q) `(car ,q)) (defmacro get-queue-token (q) `(cadr ,q)) (defmacro get-queue-len (q) `(caddr ,q)) (defmacro put-queue-size (q size) `(rplaca ,q ,size))) ;;; the Printing Stack, %pstack ;;; each element is (break . offset) (eval-when (compile) (defmacro get-print-break (x) `(car ,x)) (defmacro get-print-indent (x) `(cdr ,x))) (defun push-print-stack (break offset) (push (cons break offset) %pstack)) (defun flush-output-buffer nil ;; Some data types (e.g. streams) cannot be catenated in franz, so ;; print out items in buffer separately. #+franz (mapc #'llprinc (nreverse %output-buffer)) #-franz (llprinc (apply #'catenate (nreverse %output-buffer))) (setq %output-buffer nil)) ;;; print n blanks (defun print-blanks (n) (do ((i n (1- i))) ((zerop i)) (push " " %output-buffer))) ;;; print a token (defun print-token (tt size) (case (tok-class tt) (string (push (get-string-text tt) %output-buffer) (decf %space size)) (begin (let ((offset (- %space (get-block-indent tt))) (brtype (if (and %prettyon (> size %space)) (get-block-break tt) 'fits))) (push-print-stack brtype offset))) (end (pop %pstack)) (break (case (get-print-break (car %pstack)) (consist (break-new-line tt)) (inconsist (if (> size %space) (break-new-line tt) (break-same-line tt))) (fits (break-same-line tt)) (t (lcferror '|bad break in pretty printer|)))) (t (lcferror (cons tt '(bad print-token type)))))) ; print-token ;;; print a break, indenting a new line (defun break-new-line (tt) (setq %space (- (get-print-indent (car %pstack)) (get-break-offset tt))) (flush-output-buffer) (llterpri) (print-blanks (- %margin %space))) ; break-new-line ;;; print a break that fits on the current line (defun break-same-line (tt) (let ((width (get-break-width tt))) (decf %space width) (print-blanks width))) ; break-same-line ;;; routines for scan stack ;;; determine sizes of blocks (defun clear-scan-stack () (setq %scan-stack (list (make-ss-elem -1 nil)))) ; clear-scan-stack (defun scan-push () (push (make-ss-elem %right-total (car %qright)) %scan-stack) nil) ; scan-push ;;; Pop scan stack and return its value of %qright (defun scan-pop () (get-queue-elem (pop %scan-stack))) ; scan-pop ;;; test if scan stack contains any data that is not obsolete (defun scan-empty () (< (get-left-total (car %scan-stack)) %left-total)) ; scan-empty ;;; return the kind of token pointed to by the top element of the scan stack (defun scan-top () (tok-class (get-queue-token (get-queue-elem (car %scan-stack))))) ; scan-top ;;; the queue ;;; size is set when the size of the block is known ;;; len is the declared length of the token (defun clear-queue () (setq %left-total 1) (setq %right-total 1) (setq %qleft nil) (setq %qright nil)) ; clear-queue ;;; perhaps should use a dummy list header so %qleft is never nil (defun enqueue (tt size len) (incf %right-total len) (let ((newcell (list (make-queue-elem size tt len)))) (if %qleft (rplacd %qright newcell) (setq %qleft newcell)) (setq %qright newcell))) ; enqueue ;;; Print if token size is known or printing is lagging ;;; Size is known if not negative ;;; Printing is lagging if the text waiting in the queue requires ;;; more room to print than exists on the current line (defun advance-left () (while (and %qleft (or (not (< (get-queue-size (car %qleft)) 0)) (> (- %right-total %left-total) %space))) (let* ((listsizetokenlen (pop %qleft)) (size (car listsizetokenlen)) (token (cadr listsizetokenlen)) (len (caddr listsizetokenlen))) (print-token token (if (< size 0) %infinity size)) (incf %left-total len)))) ; advance-left ;;; set size of block on scan stack (defun setsize (tok) (cond ((scan-empty) (clear-scan-stack)) ((eq (scan-top) tok) (let ((qi (scan-pop))) (put-queue-size qi (+ %right-total (get-queue-size qi)))))) nil) ; setsize ;;; ************************************************************* ;;; procedures to control prettyprinter from outside ;;; the user may set the depth bound %max-depth ;;; any text nested deeper is printed as the character & ;;; print a literal string of given length (defun pstringlen (str len) (if (< %curr-depth %max-depth) (enqueue-string str len))) ; pstringlen (defun enqueue-string (str len) (enqueue `(string ,str) len len) (advance-left)) ; enqueue-string ;;; print a string (defun pstring (str) (pstringlen str (flatsize2 str))); pstring ;;; open a new block, indenting if necessary (defun pbegin-block (indent break) (incf %curr-depth) (cond ((< %curr-depth %max-depth) (enqueue `(begin ,indent ,break) (- 0 %right-total) 0) (scan-push)) ((= %curr-depth %max-depth) (enqueue-string '& 1)))) ; pbegin-block ;;; special cases: consistent, inconsistent (defun pbegin (indent) (pbegin-block indent 'consist)) ; pbegin (defun pibegin (indent) (pbegin-block indent 'inconsist)) ; pibegin ;;; close a block, setting sizes of its subblocks (defun pend () (when (< %curr-depth %max-depth) (enqueue '(end) 0 0) (setsize 'break) (setsize 'begin)) (decf %curr-depth)) ; pend ;;; indicate where a block may be broken (defun pbreak (blankspace offset) (when (< %curr-depth %max-depth) (enqueue `(break ,blankspace ,offset) (- 0 %right-total) blankspace) (setsize 'break) (scan-push))) ; pbreak ;;; Initialize pretty-printer. (defun pinit () (clear-queue) (clear-scan-stack) (setq %curr-depth 0) (setq %space %margin) (setq %prettyon t) (setq %pstack nil) (pbegin 0)) ; pinit ;;; Turn formatting on or off ;;; prevents the signalling of line breaks ;;; free space is set to zero to prevent queuing of text (defun setpretty (pp) (setq %prettyon pp) (if pp (setq %space %margin) (setq %space 0))) ; setpretty ;;; Print a new line after printing all queued text (defun pnewline () (pend) (setq %right-total %infinity) (advance-left) (flush-output-buffer) (llterpri) (pinit)) ; pnewline ;;; Print all remaining text in queue. ;;; Reinitialize (or turn off) prettyprinting (defun ml-set_prettymode (pp) (pnewline) (setpretty pp)) ; ml-set_prettymode (eval-when (load) (pinit) (setpretty t)) ;;; Added 16/10/89 by MJCG (defun ml-set_margin (n) (prog1 %margin (setq %margin n))) ; ml-set_margin (dml |set_margin| 1 ml-set_margin (|int| -> |int|)) ;;; changed by mjcg for hol to return old %max-depth (defun ml-max_print_depth (md) (prog1 %max-depth (setq %max-depth md))) ; ml-max_print_depth (dml |max_print_depth| 1 ml-max_print_depth (|int| -> |int|)) ;;; Deleted for HOL88 by MJCG (30/11/88) ;;; turn on pretty-printing of theories (useful for ftp etc.) ;;;(defun ml-prettyprint_theories (x) ;;; (prog1 |%theory_pp-flag| (setq |%theory_pp-flag| x))) ;;;(dml |prettyprint_theories| 1 ml-prettyprint_theories (|bool| -> |bool|)) (dml |set_pretty_mode| 1 ml-set_prettymode (|bool| -> |void|)) (dml |print_newline| 0 pnewline (|void| -> |void|)) (dml |print_begin| 1 pbegin (|int| -> |void|)) (dml |print_ibegin| 1 pibegin (|int| -> |void|)) (dml |print_end| 0 pend (|void| -> |void|)) (dml |print_break| 2 pbreak ((|int| |#| |int|) -> |void|)) hol88-2.02.19940316/lisp/f-constants.l0000640000212700021270000003401305112241653015307 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-constants.l ;;; ;;; ;;; ;;; DESCRIPTION: Various constants (aka LISP specials) in the system ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l) ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz")) (eval-when (compile load) (special poport ;output stream piport ;input stream outfiles ;set of output files inputstack ;stack of input streams %directory ;directory where input file found %debug ;t iff compiler lisp sources files kept ;;; f-gp prop ;holder of property for putpropl initial%load ;t iff initial loading of the system %symcount ;counter for internal gensym %timestamp ;time stamp ;;; site %hol-dir ;path of hol directory %lib-dir ;path of library %liszt ;path to liszt (TFM) %version ;current version (TFM) %build-date ;date %system-name ;LCF, ML, or what have you experimental ;obsolete ;;; f-parser f-parsml spec-toks eq-tok token ;current token tokchs ;list of chars of next tokens toktyp ;type of current token %char-buffer %special-letters %special-alphanums %special-table %ch ; last ascii character read hol-char ;current char ptoken ;previous ptokchs ;previous ptoktyp ;previous pchar ;previous cflag ;glitch to recognize vartypes parsedepth ;depth of parse recursion arg1 ;global used to feed a parse function its arg lang1 ;code of unary operator in current language lang2 ;code of binary operator in current language langlp ;code of operator precedence in current language atom-rtn ;lisp code of atom recognizer in current language juxtlevel ;level of juxt nesting juxt-rtn ;lisp code of juxt operator in current language toklist ;acc of string chars metaprec ;;; typeml %mlprindepth ;max depth of printing for ML %vartypes ;list of vartypes env ;local environnement tenv ;local type environnement asscheck ;check for assignment structcheck ;check for structs glassl ;global assigned vars list %l ;dummy for list %env ;dummy for env %id ;dummy for identifiers %star ;number of stars in vartypes nonloc ;t if not local type%errors ;type errors nullty ;null type boolty ;booleen type intty ;integer type tokty ;string type ;;; objty ;lisp object type[deleted TFM 90.09.09] typety ;ol type type termty ;ol term type formty ;ol formula type thmty ;ol theorem type %thisdec ;t if ML declaration %thistydec ;t if ML type declaration %deftypes ;types defined in current exprs %emt ;global environnement %temt ;global type environnement %sections ;stack of sections ;;; f-mlprint %print-depth ;depth of printing %ex ; ;;; f-DML infixables tracelist ;;; f-TRAN msg1 ;error message for multiple occs of vars in structs msg2 ;used instead of msg1 when mult occs allowed %compfns %p global%env new%%lb rec%env %loop %test %timestamp ;;; f-FORMAT %space ;space remaining on this line %left-total ;total width of tokens already printed %right-total ;total right of tokens ever put in queue %pstack ;printing stack with indentation entries %scan-stack ; %qleft ; %qright ; %prettyon ;indicates if pretty-pretting is on %curr-depth ;current depth of "begins" %max-depth ;max depth of "begins" to print ;;; f-IOX-STAND %%%fn %%%args fin-ligne %prompt-string inputstack prinlevel prinlength ;;; f-TML %f %dev %pt %ty %pr %val new%%lb %compfns global%env %sections %dump %emt %temt %lb %thisdec %thistydec tenv %head new%lb |%timing-flag| ; Changed from %time for HOL88 (30/11/88) %timestamp %symcount %outport |%print_load-flag| ibase base *nopoint instack msgflag eof nullty %char-buffer %parse-tree-buffer |%abort_when_fail-flag| %turnstile %prompt-string %libraries ;;; f-LIS ;;; %%F ; deleted 19/11/91 JAC %theorydata %falsity ;ol-syntax %vtyl ;ol-syntax %thm-count ;ol-syntax term-constrs ;parsol form-constrs ; olinprec %mk=antiquot %empty ;F-typeol %stickylist %canonlist %tyvars %linkcount |%show_types-flag| ;F-writol (HOL88) %varpairs ;F-subst %all %vars %newvars %oldtys ;F-inst %tyvl %used-varnames %changed-types %renames dash ;F-thyfns legalconsts %current %ancestry %kind %loading-thy olreserved legalconst %newconsts %date %theory-data %theorems %failtok %newtypes %current %thy-cache %new-ancestors %sharetypes %sharecount %elem ;F-ol-net %deferred %substl ;F-simpl %insttyl %bv-pairs %type-matches |%theory_pp-flag|)) ;;; f-parser (defconstant cr 13) ;carriage return (defconstant lf 10) ;line feed (defconstant ff 12) ;form feed (defconstant tab 9) ;tab (defconstant cmntchr #/%) (defconstant hol-space #/ ) (defconstant lparen #/() (defconstant rparen #/)) (defconstant period #/.) (defconstant comma #/,) (defconstant colon #/:) (defconstant scolon #/;) (defconstant lbrkt #/[) (defconstant rbrkt #/]) (defconstant multiply #/*) (defconstant tokqt #/`) #+franz (defconstant escape #/\) #-franz (defparameter escape #/\) (defconstant cmnt-start #/<) (defconstant cmnt-end #/>) (defconstant endcnrtok '|"|) (defconstant anticnr-tok '|^|) (defconstant condl-tok '|=>|) (defconstant else-tok '\|) (defconstant lambda-tok '\\) (defconstant ineq-tok '|<<|) (defconstant neg-tok '|~|) (defconstant conj-tok '/\\) (defconstant disj-tok '\\/) (defconstant imp-tok '|==>|) ; (defconstant iff-tok '|<=>|) no longer used [TFM 90.01.20] (defconstant forall-tok '|!|) (defconstant exists-tok '|?|) (defconstant restrict-tok '|::|) ;;; MJCG 24.1.91 (defconstant arrow-tok '|->|) (defconstant sum-tok '|+|) (defconstant prod-tok '|#|) (defconstant cr-sym (imploden (list cr))) ;carriage return (defconstant lf-sym (imploden (list lf))) ;line feed (defconstant ff-sym (imploden (list ff))) ;form feed (defconstant tab-sym (imploden (list tab))) ;tab (defconstant tml-sym '|;;|) (defconstant tokqt-sym '|`|) (defconstant escape-sym '\\) (defconstant exfix-sym '|$|) (defconstant neg-sym '|not|) (defconstant arrow-sym '|->|) (defconstant prod-sym '|#|) (defconstant sum-sym '|+|) (defconstant list-sym '|list|) (defconstant null-sym '|void|) (defconstant cnr-sym '|"|) (defconstant endcnr-sym '|"|) (defconstant mul-sym '|*|) (defconstant div-sym '|/|) (defconstant plus-sym '|+|) (defconstant mns-sym '|-|) (defconstant conc-sym '|@|) (defconstant eq-sym '|=|) (defconstant lt-sym '|<|) (defconstant gt-sym '|>|) (defconstant conj-sym '|&|) (defconstant disj-sym '|or|) (defconstant condl-sym '|=>|) (defconstant lam-sym '\\) (defconstant assign-sym '|:=|) (defconstant wildcard-sym '|_|) (defconstant case-sym '\|) (defconstant else-sym '\|) (defconstant trap-then-sym '|?|) (defconstant trapif-then-sym '|??|) (defconstant trapbind-then-sym '?\\) (defconstant trap-loop-sym '|!|) (defconstant trapif-loop-sym '|!!|) (defconstant trapbind-loop-sym '!\\) (defconstant cmntchr-sym '|%|) (defconstant space-sym '| |) (defconstant lparen-sym '|(|) (defconstant rparen-sym '|)|) (defconstant period-sym '|.|) (defconstant comma-sym '|,|) (defconstant colon-sym '|:|) (defconstant scolon-sym '|;|) (defconstant lbrkt-sym '|[|) (defconstant rbrkt-sym '|]|) (defconstant trap-syms (list trap-then-sym trap-loop-sym trapif-then-sym trapif-loop-sym trapbind-then-sym trapbind-loop-sym)) (defconstant spec-syms (list* div-sym else-sym escape-sym trapbind-then-sym trapbind-loop-sym '(|:| |(| |)| |#| |->| |,| |.| |[| |]| |;| |;;| |:=| |"| |%| |$| |`| |``| |*| |+| |-| |@| |=| |<| |>| |&| |=>| |?| |??| |!| |!!| ))) (defconstant rsvdwds '(|let| |letref| |letrec| |and| |with| |in| |typeabbrev| |deftype| |lettype| |abstype| |absrectype| |type| |rectype| |where| |whereref| |whererec| |wheretype| |whererectype| |wheretypeabbrev| |whereabstype| |whereabsrectype| |fail| |failwith| |begin| |end| |do| |it| |or| |not| |true| |false| |if| |then| |loop| |else| |while|)) (defconstant declnconstrs '(mk-let mk-letrec mk-letref mk-deftype mk-abstype mk-absrectype mk-type mk-rectype)) (defconstant exprconstrs '(mk-boolconst mk-intconst mk-tokconst mk-var mk-wildcard mk-case mk-while mk-fun mk-appn mk-abstr mk-dupl mk-empty mk-fail mk-binop mk-unop mk-assign mk-list mk-seq mk-trap mk-test mk-straint mk-in mk-ind mk-quot mk-tyquot)) (defconstant tokflag '||) ;;; f-parsml f-gnt (defconstant bastypes '(|int| |bool| |string| |token| |tok| |.| |void| |term| |form| |type| |thm|)) ;;; f-dml (defconstant tokempty '|``|) (defconstant mlreserved (append '(|=| |?|) rsvdwds)) ;;; f-tml f-typeml (defconstant lastvalname '|it|) ;;; f-tran, f-tml, f-writml (defconstant nill '%nil) (defconstant empty '%empty) hol88-2.02.19940316/lisp/constp.l0000640000212700021270000000626205071123506014363 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: constp.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions that test for constants ;;; ;;; ;;; ;;; USES FILES: f-cl.l (no need for f-franz.l in Franz Lisp) ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: (none) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; MJCG 8/11/88 for HOL88 ;;; local declaration commented out (tokconstp used in hol-pars.l now) ;;; #+franz (declare (localf tokconstp)) ;;; There must be a better way of doing the stuff below ... ;;; # is mapped to (35) by exploden ;;; ` is mapped to (96) ;;; |0123456789| is mapped to (48 49 50 51 52 53 54 55 56 57) by exploden (defun tokconstp (tok) (let ((l (exploden tok))) (and (= (car l) 96) (= (car (last l)) 96)))) (defun numconstp (tok) (test-list-els (exploden tok) '(48 49 50 51 52 53 54 55 56 57))) #-franz (proclaim '(notinline numconstp)) ; since it gets redefined later (defun wordconstp (tok) (let ((l (exploden tok))) (and (= (car l) 35) (test-list-els (cdr l) '(48 49))))) (defun test-list-els (l els) (or (null l) (and (memq (car l) els) (test-list-els (cdr l) els)))) ;;; Modified TFM 88.04.04 :string instead of :tok ;;; MJCG 7/1/88 for HOL88 ;;; check for hidden constants (defun constp (tok) (cond ((tokconstp tok) '(|string|)) ((numconstp tok) '(|num|)) ((wordconstp tok) (list (imploden (append '(#/w #/o #/r #/d) (exploden (length (cdr (exploden tok)))))))) (t (or (get tok 'const) (and (get tok 'hidden-const) (cdr (assq 'const (get tok 'hidden-const)))))))) hol88-2.02.19940316/lisp/f-dml.l0000640000212700021270000003530205523413541014054 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-dml.l ;;; ;;; ;;; ;;; DESCRIPTION: Various DML'ed ML functions ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-macro.l, f-constants.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: dml (lisp 1.6) part of Edinburgh LCF ;;; ;;; by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V4.3: Added fast arithmetic (smallnums) GC ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-macro") (include "lisp/f-constants") (special %display-function) (*lexpr concat)) #+franz (declare (localf ml-isl trymlinfix)) (setq infixables (list '\\ '|#| '|*| '|+| '|-| '|<| '|=| '|>| '|?| '|@| '|^| '|<<|)) ;;; Part 1: Representation of strings ;;; In general an ml string value tok is represented by ;;; the lisp atom tok. Beware in the old Edinburg LCF we had ;;; two special cases: ;;; (a) the empty string, returned by implode[], is special ;;; (b) the string nil is non-interned (to avoid a stanford ;;; lisp problem that reentering a core image destroys ;;; additional properties we might have given to nil). ;;; In effect, the functions here determine string as an abstract ;;; type with explode, implode, tok_of_int, and int_of_tok as primitive ;;; operations. ;;; tok_of_int and int_of_tok now called tok_of_string and string_of_tok. ;;; Sets Manifests: tokempty ;;; ;;; Convention inter-lisps for coercions atoms-ascii codes ;;; We follow the Lelisp convention of manipulating ascii codes rather ;;; than atomic character objects. We use mainly: ;;; imploden : takes as argument a list of ascii codes and returns an ;;; atomic symbol whose pname is the corresponding string of ;;; characters. ;;; exploden : inverse of imploden. (defun ml-explode (tok) (mapcar #'(lambda (ch) (ascii ch)) (exploden tok))) ;ml-explode (defun ml-implode (l) (if (forall #'(lambda (x) (= (length (exploden x)) 1)) l) (concatl l) (failwith '|implode|))) ;ml-implode ;;; PART 2: functions to set up lisp definitions in ml ;;; define an ML function in terms of a Lisp function of n arguments (defun declare-ml-fun (ml-fn n lisp-fn mty) (putprop ml-fn (cons lisp-fn n) 'numargs) (putprop ml-fn (makety mty) 'mltype) ml-fn) ;declare-ml-fun ;;; define an ML constant in terms of a Lisp constant (defun declare-ml-const (id exp mty) (putprop id (eval exp) 'mlval) (putprop id (makety mty) 'mltype) id) ; declare-ml-const ;;; PART 3: defining ml primitives ;;; Uses manifests: tokempty [Part 1] ;;; initenv [tml] ;;; SETS manifests: infixables, mlreserved ;;; Sets global: tracelist (defun intdiv (x y) (if (zerop y) (failwith '|div|) (#+franz quotient #-franz floor x y))) ;intdiv (dml |*| 2 #+franz times #-franz * ((|int| |#| |int|) -> |int|)) (dml |/| 2 intdiv ((|int| |#| |int|) -> |int|)) (dml |+| 2 #+franz plus #-franz + ((|int| |#| |int|) -> |int|)) (dml |-| 2 #+franz difference #-franz - ((|int| |#| |int|) -> |int|)) (dml |=| 2 equal ((%A |#| %A) -> |bool|)) (dml |<| 2 #+franz lessp #-franz < ((|int| |#| |int|) -> |bool|)) (dml |>| 2 #+franz greaterp #-franz > ((|int| |#| |int|) -> |bool|)) (dml |%-| 1 #+franz minus #-franz - (|int| -> |int|)) ;;; If you want fast arithmetic with smallnums instead of bignums, ;;; then use fast_arith (dml |fast_arith| 1 ml-fast (|bool| -> |.|)) (defun ml-fast (bool) (cond (bool (putprop '|*| '(|*| . 2) 'numargs) (putprop '|/| '(#+franz |/| #-franz floor . 2) 'numargs) (putprop '|+| '(|+| . 2) 'numargs) (putprop '|-| '(|-| . 2) 'numargs) (putprop '|<| '(|<| . 2) 'numargs) (putprop '|>| '(|>| . 2) 'numargs)) (t (putprop '|*| '(#+franz times #-franz * . 2) 'numargs) (putprop '|/| '(intdiv . 2) 'numargs) (putprop '|+| '(#+franz plus #-franz + . 2) 'numargs) (putprop '|-| '(#+franz difference #-franz - . 2) 'numargs) (putprop '|<| '(#+franz lessp #-franz < . 2) 'numargs) (putprop '|>| '(#+franz greaterp #-franz > . 2) 'numargs)))) ;ml-fast (dml |%&| 2 and ((|bool| |#| |bool|) -> |bool|)) (dml |%or| 2 or ((|bool| |#| |bool|) -> |bool|)) (dml |@| 2 append (((%A |list|) |#| (%A |list|)) -> (%A |list|))) (dml |.| 2 cons ((%A |#| (%A |list|)) -> (%A |list|))) (dml |not| 1 not (|bool| -> |bool|)) (dml |null| 1 null ((%A |list|) -> |bool|)) (dml |fst| 1 car ((%A |#| %B) -> %A)) (dml |snd| 1 cdr ((%A |#| %B) -> %B)) (dml |do| 1 ml-do (%A -> |void|)) (defun ml-do (x) x ;unused nil) ;ml-do (dml |hd| 1 ml-hd ((%A |list|) -> %A)) (defun ml-hd (x) (if x (car x) (failwith '|hd|))) ;ml-hd (dml |tl| 1 ml-tl ((%A |list|) -> (%A |list|))) (defun ml-tl (x) (if x (cdr x) (failwith '|tl|))) ;ml-tl (dml |isl| 1 car ((%A |+| %B) -> |bool|)) ;;; for Lisp code that handles sums (defun ml-isl (x) (car x)) ; ml-isl ;;; this slow version is only good for debugging the system ;;; may use instead of car in ml-outl and ml-outr ;;; t = left, nil = right ;;;(defun ml-isl (x) ;;; (if (and (not (atom x)) (memq (car x) '(t nil))) ;;; (car x) ;;; (lcferror (cons x '(bad mlsumtype))) ;;; )) ;ml-isl (dml |outl| 1 ml-outl ((%A |+| %B) -> %A)) (defun ml-outl (x) (if (car x) (cdr x) (failwith '|outl|))) ;ml-outl (dml |outr| 1 ml-outr ((%A |+| %B) -> %B)) (defun ml-outr (x) (if (car x) (failwith '|outr|) (cdr x))) ;ml-outr (dml |inl| 1 ml-inl (%A -> (%A |+| %B))) (defun ml-inl (x) (cons t x)) ;ml-int (dml |inr| 1 ml-inr (%B -> (%A |+| %B))) (defun ml-inr (x) (cons nil x)) ;ml-inr (dml |explode| 1 ml-explode (|string| -> (|string| |list|))) (dml |implode| 1 ml-implode ((|string| |list|) -> |string|)) (dml |string_of_int| 1 concat (|int| -> |string|)) ;;; Superseded by string_of_int. [TFM 90.05.06] ;;; (dml |tok_of_int| 1 concat (|int| -> |string|)) (dml |int_of_string| 1 ml-int_of_string (|string| -> |int|)) ;;; Superseded by int_of_string. [TFM 90.05.06] ;;; (dml |int_of_tok| 1 ml-int_of_string (|string| -> |int|)) ;;; Franz bug: (readlist (exploden '|;|)) goes into a loop ;;; this makes the original definition of ml-int_of_string (given below) ;;; dangerous (e.g. new_constant(`;`, ...) crashes HOL). ;;; ;;; (defun ml-int_of_string (s) ;;; (errortrap #'(lambda (x) (failwith "int_of_string")) ;;; (let ((n (readlist (exploden s)))) ;;; (unless (fixp n) (failwith "int_of_string")) ;;; n))) ;;; ;;; (defun ml-int_of_string (s) ;;; (if (numconstp s) ;;; (readlist (exploden s)) ;;; (failwith "int_of_string"))) ;;; Modified TFM 88.04.20 ;;; to include bug fix in franz for (readlist (exploden |;|))... which loops ;;; Modified JVT 90.01.08 ;;; to fix problem with (exploden |\||)... which loops (defun ml-int_of_string (s) (let ((n #+franz (errortrap #'(lambda (x) (failwith '|int_of_string|)) (if (or (eq s (ascii 124)) (eq s '|,|) (eq s '|;|)) t (readlist (exploden s)))) #-franz (parse-integer (string s) :junk-allowed t) )) (if (integerp n) n (failwith '|int_of_string|)))) ;;; The following trace functions are relics from the old days of Edinburgh LCF ;;; ;;; (defvar tracelist nil) ;;; ;;; (defun checktraceable (F) ;;; (cond ;;; ((atom (cdr F)) ;;; (llprinc '|closure not traceable: |) ;;; (llprinc (cdr F)) ;;; (llterpri) ;;; (exit-from evaluation 'TRACE)) ;;; (t F))) ;checktraceable ;;; ;;; (dml |TRACE| 1 ml-TRACE ;;; (((%A -> %B) -> ((%A -> %B) |#| %C)) -> ((%A -> %B) -> %C))) ;;; ;;; (defun ml-TRACE (phi) ;;; (cons ;;; (function ;;; (lambda (%e) ;;; (let ((F (checktraceable (car %e))) ;;; (Fcopy (cons nil nil)) ;;; (phi (cadr %e))) ;;; (dis-place Fcopy F) ;;; (let ((x (ap phi Fcopy))) ;;; (dis-place F (car x)) ;;; (push (cons F Fcopy) tracelist) ;;; (cdr x))))) ;;; (cons phi initenv))) ;ml-TRACE ;;; ;;; (dml |UNTRACE| 1 ml-UNTRACE ((%A -> %B) -> |bool|)) ;;; ;;; (defun ml-UNTRACE (F) ;;; (let ((x (assoc-equal F tracelist))) ;;; (if (null x) ;;; nil ;;; (setq tracelist (outq x tracelist)) ;;; (dis-place F (cdr x)) ;;; t))) ;ml-UNTRACE ;;; MJCG 3/3/1992 Added legalconstants to mlinfixables (defun trymlinfix (fun tok sort) (when (or (memq tok mlreserved) (not (or (idenp tok) (memq tok infixables) (memq tok legalconsts)))) (ptoken |can't infix |) (ml-print_tok tok) (pnewline) (failwith fun)) (mlinfix2 tok sort)) ;trymlinfix (dml |ml_paired_infix| 1 ml-ml_paired_infix (|string| -> |.|)) (defun ml-ml_paired_infix (tok) (trymlinfix '|ml_paired_infix| tok 'paired)) ;ml-ml_paired_infix (dml |ml_curried_infix| 1 ml-ml_curried_infix (|string| -> |.|)) (defun ml-ml_curried_infix (tok) (trymlinfix '|ml_curried_infix| tok 'curried)) ;ml-ml_curried_infix ;;; MJCG 19/2/91 ;;; ML function for detecting ML infixes ;;; (built-in and user defined) (defun ml-is_ml_infix (x) (and (get x 'ml2) (memq (car (get x 'ml2)) '(mlcinf-rtn mlinf-rtn appl-rtn)))) (dml |is_ml_infix| 1 ml-is_ml_infix (|string| -> |bool|)) ;;; MJCG 01.02.94 ;;; Make a HOL variables infixed ;;; olvarinfix defined in f-parsol.l (dml |infix_variable| 1 olvarinfix (|string| |->| |void|)) ;;; RJB 4/3/91 ;;; ML function for detecting user defined curried ML infixes (defun ml-is_ml_curried_infix (x) (and (get x 'ml2) (eq (car (get x 'ml2)) 'mlcinf-rtn))) (dml |is_ml_curried_infix| 1 ml-is_ml_curried_infix (|string| -> |bool|)) ;;; RJB 4/3/91 ;;; ML function for detecting user defined paired ML infixes (defun ml-is_ml_paired_infix (x) (and (get x 'ml2) (eq (car (get x 'ml2)) 'mlinf-rtn))) (dml |is_ml_paired_infix| 1 ml-is_ml_paired_infix (|string| -> |bool|)) ;;; Return ascii code of a non-empty string. Fail on an empty one. ;;; MJCG 19/2/91 (defun ml-ascii_code (x) (if (eq x '||) (failwith '|ascii_code|) (cascii x))) ;;; gives the ascii code of the first char of its arg (dml |ascii_code| 1 ml-ascii_code (|string| -> |int|)) ;;; gives the unit string consisting of the char with ascii code its arg (dml |ascii| 1 ml-ascii (|int| -> |string|)) (defun ml-ascii (n) (if (or (< n 0) (> n 127)) (failwith '|ascii|) (ascii n))) ; ml-ascii ;;; MJCG 14/11/88 for HOL88 ;;; dml-ed versions of some Unix dependent commands ;;; defined in F-unix.l (dml |system| 1 exec-system-command (|string| -> |int|)) (dml |getenv| 1 ml-getenv (|string| -> |string|)) (dml |host_name| 0 ml-host_name (|void| -> |string|)) (dml |link| 2 ml-link ((|string| |#| |string|) -> |void|)) (dml |unlink| 1 ml-unlink (|string| -> |void|)) (dml |openi| 1 ml-openi (|string| -> |string|)) (dml |openw| 1 outfile (|string| -> |string|)) (dml |append_openw| 1 ml-append_openw (|string| -> |string|)) (dml |read| 1 readc (|string| -> |string|)) (dml |write| 2 write-and-drain ((|string| |#| |string|) -> |void|)) (dml |tty_read| 0 readc (|void| -> |string|)) (dml |tty_write| 1 tty-write-and-drain (|string| -> |void|)) (dml |close| 1 close (|string| -> |void|)) ;;; MJCG 2/3/89 for HOL88.1.01 ;;; ML function to compute address of a value ;;; Deleted [04.03.91 JVT] ;;; (dml |address| 1 maknum (|*| -> |int|)) ;;; MJCG 2/3/89 for HOL88.1.01 ;;; ML funtion to compare values ;;; Lexical ordering of lists (defun ml-ord (l1 l2) (if (atom l1) (if (null l1) (not(null l2)) (or (listp l2) (if (numberp l1) (and (numberp l2) (lessp l1 l2)) (or (numberp l2) (alphalessp l1 l2))))) (and (consp l2) (if (equal (car l1) (car l2)) (ml-ord (cdr l1) (cdr l2)) (ml-ord (car l1) (car l2)))))) (dml |<<| 2 ml-ord ((|*| |#| |**|) -> |bool|)) ;;; MJCG 2/3/89 for HOL88.1.01 ;;; ML function to return the HOL88 version number ;;; (as an integer less than 1000) ;;; ;;; changed 100 to 100.001 to compensate for ;;; Franz rounding error [TFM 92.06.26] (defun ml-version () (fix (times #+franz (readlist (exploden %version)) #-franz (read-from-string %version) 100.001))) (dml |version| 0 ml-version (|void| -> |int|)) ;;; Set %display-function, the system utility used to dislay help files. ;;; Default "cat" set in f-system.l. ;;; MJCG 12/11/90 (defun ml-set_help (x) (prog1 %display-function (setq %display-function x))) (dml |set_help| 1 ml-set_help (|string| -> |string|)) hol88-2.02.19940316/lisp/f-writol.l0000640000212700021270000004173705237210540014625 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-writol.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions for pretty printing OL ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l, genmacs.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: writol (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981. ;;; ;;; ;;; ;;; V2.2: exit instead of err ;;; ;;; ;;; ;;; to do: right-associative infixes ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (include "lisp/genmacs")) #+franz (declare (localf prep-pair prep-cond prep-curr prep-pred-form prep-conn-form print-abs print-pair print-conn-form print-neg-form print-infix-pred print-quant-form print-named-type)) ;;; %printtypes changed to |%show_types-flag| for HOL88 (30/11/88) (setq |%show_types-flag| nil) ;;; Changed to return old value of flag for HOL88 (30/11/88) (dml |show_types| 1 ml-show_types (|bool| -> |bool|)) (defun ml-show_types (b) (prog1 |%show_types-flag| (setq |%show_types-flag| b))) ;ml-show_types (dml |print_term| 1 ml-print_term (|term| -> |void|)) (defun ml-print_term (tm) (ptoken |"|) (print-tm (prep-tm tm) t t) (ptoken |"|) ) ;ml-print_term ;;; No formulas in HOL: print_form deleted [TFM 90.04.20] ;;; (dml |print_form| 1 ml-print_form (|form| -> |void|)) (defun ml-print_form (w) (ptoken |"|) (print-fm (prep-fm w) t) (ptoken |"|) ) ;ml-print_form (dml |print_thm| 1 ml-print_thm (|thm| -> |void|)) (defun ml-print_thm (th) (mapc #'(lambda (x) x (ptoken |.|)) (car th)) (ptoken "|-") (ml-print_form (cdr th)) ) ;ml-print_thm (dml |print_type| 1 ml-print_type (|type| -> |void|)) (defun ml-print_type (ty) (ptoken |":|) (print-ty ty t) (ptoken |"|) ) ;ml-print_type ;;; RJB 1.7.92 ;;; Function to print a type without quotes and without the leading colon (dml |print_unquoted_type| 1 ml-print_unquoted_type (|type| -> |void|)) (defun ml-print_unquoted_type (ty) (print-ty ty t) ) ;ml-print_unquoted_type ;;; precedence information for when to print brackets ;;; the left symbol binds more tightly than the right symbols ;;; associativity logic is not stored here, but included in printing functions ;;; the symbols include those introduced by prep-tm/fm (eval-when (load) (mapc #'(lambda (x) (putprop (car x) (cdr x) 'closes)) '((neg . (forall exists conj disj imp)) ; iff deleted [TFM 90.01.20] (conj . (forall exists conj disj imp)) ; iff deleted [TFM 90.01.20] (disj . (forall exists disj imp)) ; iff deleted [TFM 90.01.20] (imp . (forall exists imp)) ; iff deleted [TFM 90.01.20] ;;; (iff . (forall exists iff)) ; iff deleted [TFM 90.01.20] (pair . (abs pair)) (then . (then)) (else . (abs then pair)) (listcomb . (abs listcomb infixcomb then pair typed)) (infixcomb . (abs listcomb infixcomb then pair typed)) (typed . (infixcomb)) (|fun| . (|fun|)) (|sum| . (|sum| |fun|)) (|prod| . (|prod| |sum| |fun|)) ))) ;;; are parens needed around "X op2 Y" if a neighboring infix is op1? (defun closes (op1 op2) (memq op2 (get op1 'closes))) ;closes ;;; prepare pairs for printing ;;; put the combination ((PAIR X) Y) into a special format (defun prep-pair (rator rand ty) (if (and (is-comb rator) (eq (get-const-name (get-rator rator)) 'PAIR)) (make-prep-term 'pair (list (prep-tm (get-rand rator)) (prep-tm rand)) ty)) ) ;prep-pair ;;; prepare conditional for printing ;;; put the combination (((COND P) X) Y) into a special format (defun prep-cond (rator rand ty) (if (is-comb rator) (let ((ratrat (get-rator rator))) (if (is-comb ratrat) (let ((ratratrat (get-rator ratrat))) (if (and (is-const ratratrat) (eq (get-const-name ratratrat) 'COND)) (make-prep-term 'cond (list (prep-tm (get-rand ratrat)) (prep-tm (get-rand rator)) (prep-tm rand)) ty))))))) ; prep-cond ;;; detect infixes and long combinations (defun prep-comb (rator rand ty) (let ((prator (prep-tm rator))(prand (prep-tm rand))) (cond ((and (is-const prator) (eq (get (get-const-name prator) 'olinfix) 'paired) (eq (term-class prand) 'pair)) (make-prep-term 'infixcomb (cons prator (get-term-list prand)) ty)) ((eq (term-class prator) 'listcomb) (prep-curr (get-term-list prator) prand ty)) ((make-prep-term 'listcomb (list prator prand) ty))) )) ;prep-comb ;;; see if ((tm1 tm2 ...) y) is the curried infix "tm2 y" ;;; otherwise return (tm1 tm2 ... y) (defun prep-curr (tml y ty) (let ((tm1 (car tml)) (tm2 (cadr tml)) (tmtail (cddr tml))) (if (and (null tmtail) (is-const tm1) (eq (get (get-const-name tm1) 'olinfix) 'curried)) (make-prep-term 'infixcomb (list tm1 tm2 y) ty) (make-prep-term 'listcomb (append tml (list y)) ty) ))) ;prep-curr ;;; preprocess a term for easier printing ;;; locate all conditionals, pairs, infixes, and long combinations (defun prep-tm (tm) (case (term-class tm) ((var const) tm) (abs (make-abs (get-abs-var tm)(prep-tm (get-abs-body tm)) (get-type tm))) (comb (let ((rator (get-rator tm)) (rand (get-rand tm)) (ty (get-type tm))) (or (prep-pair rator rand ty) (prep-cond rator rand ty) (prep-comb rator rand ty)))) (t (lcferror 'prep-tm))) ) ;prep-tm ;;; preprocess a formula (defun prep-fm (fm) (case (form-class fm) (pred (prep-pred-form (get-pred-sym fm) (prep-tm (get-pred-arg fm)))) ((conj disj imp) ; iff deleted [TFM 90.01.20] (prep-conn-form (get-conn fm) (prep-fm(get-left-form fm)) (prep-fm(get-right-form fm)))) ((forall exists) (make-quant-form (get-quant fm) (get-quant-var fm) (prep-fm(get-quant-body fm)))) (t (lcferror 'prep-fm)) )) ;prep-fm ;;; re-build a predicate, changing equiv(x,y) to x==y, likewise for inequiv (defun prep-pred-form (sym arg) (if (and (memq sym '(|equiv| |inequiv|)) (eq 'pair (term-class arg))) (cons 'infixpred (cons sym (get-term-list arg))) (make-pred-form sym arg)) ) ; prep-pred-form ;;; re-build a connective formula, changing A ==> FALSITY() to ~A (defun prep-conn-form (conn left right) (if (and (eq 'imp conn) (eq 'pred (form-class right)) (eq 'FALSITY (get-pred-sym right))) (list 'neg left) (make-conn-form conn left right) )) ; prep-conn-form ;;; is the OL type polymorphic? (defun opoly (ty) (or (is-vartype ty) (exists 'opoly (get-type-args ty)))) ;opoly ;;; print a term ;;; op1 is the operator that will be printed before or after ;;; for deciding whether to print disambiguating parentheses ;;; needty tells print-tm to print enough type information to deduce the ;;; type of this term, perhaps from the types of its subterms ;;; method for minimizing types that are printed: ;;; for long combinations whose rator is a polymorphic constant, ;;; print types of result and operands, but not type of constant ;;; Without optimization, redundant types would cause an exponential amount ;;; of printing. (defun print-tm (tm op1 needty) (let ((op2 (term-class tm)) (tml (get-term-list tm)) (ty (get-type tm))) (let ((pcrator ; is rator a polymorphic constant? (and |%show_types-flag| (memq op2 '(listcomb infixcomb)) (let ((r (first tml))) ; find innermost operator (if (eq (term-class r) 'infixcomb) (setq r (first (get-term-list r)))) (and (is-const r) (opoly (constp (get-const-name r)))))))) (let ((tyflag ; print type of this particular term? (and needty |%show_types-flag| (case op2 (var t) (const (opoly (constp (get-const-name tm)))) ((listcomb infixcomb) pcrator) (t nil))))) ; possibly one pair of parens for precedence, another for typing (let ((cl1 (closes op1 (if tyflag 'typed op2))) (cl2 (and tyflag (closes 'typed op2)))) (if cl1 (ptoken |(|)) (if cl2 (ptoken |(|)) (pbegin 0) (case op2 (var (pstring (get-var-name tm))) (const (print-const (get-const-name tm))) (abs (print-abs tm needty)) (cond (print-cond tml needty)) (pair (print-pair tm needty)) (listcomb (print-listcomb tml pcrator)) (infixcomb (print-infixcomb tml pcrator)) (t (lcferror 'print-tm))) (cond (tyflag ; print type (if cl2 (ptoken |)|) (ifn (memq op2 '(var const)) (ptoken | |))) (pbreak 0 0) (ptoken |:|) (print-ty ty t))) (if cl1 (ptoken |)|)) (pend)))))) ;print-tm ;;; print a constant (may be infix standing alone) (defun print-const (name) (if (get name 'olinfix) (ptoken |$|)) (pstring name)) ; print-const ;;; print an abstraction (defun print-abs (tm needty) (ptoken \\) ; i.e. lambda (print-tm (get-abs-var tm) 'abs nil) (ptoken |.|) (pbreak 0 0) (print-tm (get-abs-body tm) 'abs needty)) ; print-abs ;;; print a conditional (defun print-cond (tml needty) (ptoken |(|) (print-tm (first tml) 'then nil) (ptoken | => |) (pbreak 0 1) (print-tm (second tml) 'else nil) (ptoken " | ") ; vertical bar (pbreak 0 1) (print-tm (third tml) 'else needty) (ptoken |)|)) ; print-cond ;;; print a pair or n-tuple, suppressing parentheses using associativity (defun print-pair (tm needty) (while (eq 'pair (term-class tm)) (print-tm (first (get-term-list tm)) 'pair needty) (ptoken |,|) (pbreak 0 0) (setq tm (second (get-term-list tm)))) (print-tm tm 'pair needty)) ; print-pair ;;; print a long combination (f x1 ... xn) (defun print-listcomb (tml pcrator) (let ((y (pop tml)) (prev nil)) (print-tm y 'listcomb (not pcrator)) (while tml (setq prev y) (setq y (pop tml)) (if (and(memq (term-class prev) '(var const)) (memq (term-class y) '(var const))) (ptoken | |)) ; space between two identifiers (pbreak 0 0) (print-tm y 'listcomb pcrator) ))) ; print-listcomb ;;; print a user-defined infix operator (defun print-infixcomb (tml pcrator) (print-tm (second tml) 'infixcomb pcrator) (ptoken | |) (pstring (get-const-name (first tml))) (pbreak 1 0) (print-tm (third tml) 'infixcomb pcrator)) ; print-infixcomb ;;; print a formula (defun print-fm (fm op1) (let ((op2 (form-class fm))) (let ((cl (closes op1 op2))) (if cl (ptoken |(|)) (pbegin 0) (case op2 ((conj disj imp) (print-conn-form fm)) ; iff deleted [TFM 90.01.20] (neg (print-neg-form fm)) (pred (print-pred-form fm)) (infixpred (print-infix-pred fm)) ((forall exists) (print-quant-form fm)) (t (lcferror 'print-fm))) (pend) (if cl (ptoken |)|)) ))) ;print-fm ;;; print a formula built from a connective ;;; suppress parentheses using right-associativity (defun print-conn-form (fm) (let ((conn (get-conn fm))) (while (eq conn (get-conn fm)) (print-fm (get-left-form fm) conn) (case (get-conn fm) (conj (ptoken \ \ /\\)) ; = | /\| (disj (ptoken \ \ \\/)) ; = | \/| (imp (ptoken | ==>|))) ;;; (iff (ptoken | <=>|))) ; iff deleted [TFM 90.01.20] (pbreak 2 0) (setq fm (get-right-form fm))) (print-fm fm conn))) ; print-conn-form ;;; print negation (defun print-neg-form (fm) (ptoken |~ |) (print-fm (second fm) 'neg)) ; print-neg-form ;;; print an infix predicate (defun print-infix-pred (fm) (let ((sym (cadr fm)) (arg1 (caddr fm)) (arg2 (cadddr fm))) (print-tm arg1 nil nil) (case sym (|equiv| (ptoken | ==|)) (|inequiv| (ptoken | <<|)) (t (ptoken | |) (pstring sym))) (pbreak 1 0) (print-tm arg2 nil t))) ; print-infix-pred ;;; print a predicate formula (defun print-pred-form (fm) (pstring (get-pred-sym fm)) (pbreak 1 0) (print-tm (get-pred-arg fm) t t)) ; print-pred-form ;;; print !x y z.w instead of !x. !y. !z. w ;;; this makes a big difference if the formula is broken over several lines (defun print-quant-form (fm) (let ((quant (get-quant fm))) (pbegin 1) (if (eq quant 'forall) (ptoken |!|) (ptoken |?|)) (print-tm (get-quant-var fm) quant t) (let ((body (get-quant-body fm))) (while (eq (form-class body) quant) (pbreak 1 0) (print-tm (get-quant-var body) quant t) (setq body (get-quant-body body))) (ptoken |.|) (pend) (pbreak 1 1) (print-fm body quant)))) ;prquant ;;; print a type (defun print-ty (ty op1) (let ((op2 (type-class ty))) (case op2 (%VARTYPE (pstring(get-vartype-name ty))) ((|prod| |sum| |fun|) (let ((cl (closes op1 op2)) (tyargs (get-type-args ty))) (if cl (ptoken |(|)) (pbegin 0) (print-ty (first tyargs) op2) (case op2 (|prod| (ptoken | #|)) (|sum| (ptoken | +|)) (|fun| (ptoken | ->|)) (t (lcferror "bad type - print-ty"))) (pbreak 1 0) (print-ty (second tyargs) op2) (pend) (if cl (ptoken |)|)))) (t (print-named-type ty))))) ;print-ty ;;; Print named type, with its type arguments (defun print-named-type (ty) (let ((tyname (get-type-op ty)) (tyargs (get-type-args ty))) (cond ((null tyargs) (pstring tyname)) (t (pbegin 0) (pbegin 1) (ptoken |(|) (print-ty (first tyargs) nil) ; nil added V3.2 (mapc #'(lambda (ty) (ptoken |,|) (pbreak 0 0) (print-ty ty nil)) (cdr tyargs)) (pend) (ptoken |)|) (pbreak 0 0) (pstring tyname) (pend))))) ;print-named-type ;;; These functions in this file get redefined later #-franz (proclaim '(notinline prep-tm print-tm print-const print-cond print-infixcomb print-pred-form ml-print_thm prep-comb prep-curr)) hol88-2.02.19940316/lisp/f-writml.l0000640000212700021270000001624505203470156014623 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-writml.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions for pretty printing ML types ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: writml (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (special %top-print)) #+franz (declare (localf isconctype print_list print_sum print_prod print_conc)) ;;; Print new top-level definitions ;;; MJCG 11 May 1992. Eliminated third argument (ty) of prlet. ;;; This fixes a bug discovered by JG. ;;; prlet is called in f-tml.l (defun prlet (s x) (cond ((memq s (list nill empty))) ((atom s) (unless (eq s '%con) (pstring s) (ptoken | = |) (pbreak 0 0) ;; tidy added so start from one * for each binding ;; tidy changed into tidy1 GH 2/2/82 because tenv unbound (prvalty x (tidy1 (assoc1 s (cdr %thisdec)))))) (t (prlet (car s) (car x)) (prlet (cdr s) (cdr x)) ))) ;prlet ;;; Print value, type of top-level expression (defun prvalty (x ty) (prinml x ty nil) (pbreak 1 0) (ptoken |: |) (printmty ty) (pnewline)) ;prvalty ;;; Print result of "lettype" (defun prdefty (idtyl) (ptoken |type |) (mapc #'(lambda (idty) (pstring (car idty)) (pbreak 1 0)) idtyl) (ptoken |defined|) (pnewline)) ;prdefty ;;; Print result of type or rectype (defun prconstrs (idtyl) (pnewline) (ptoken |New constructors declared:|) (pnewline) (mapc #'(lambda (idty) (pstring (car idty)) (ptoken | : |) (printmty (tidy1 (cdr idty))) (pnewline)) idtyl)) ; prconstrs (dml |print_int| 1 ml-print_int (|int| -> |.|)) (defun ml-print_int (n) (pstring n)) ; ml-print_int (dml |print_tok| 1 ml-print_tok (|string| -> |.|)) (defun ml-print_tok (tok) (ptoken |`|) (pstring tok) (ptoken |`|)) ;ml-print_tok (dml |print_string| 1 pstring (|string| -> |.|)) (dml |print_bool| 1 ml-print_bool (|bool| -> |.|)) (defun ml-print_bool (b) (if b (ptoken |true|) (ptoken |false|))) ;ml-print_bool (dml |print_void| 1 ml-print_void (|.| -> |.|) ) (defun ml-print_void (ignore) (ptoken |()| )) ;ml-print_void ;;; MJCG 30/1/89 for HOL88 ;;; Alist of type/prin-function pairs (setq %top-print nil) ;;; MJCG 30/1/89 for HOL88 ;;; Kludge function to grab argument and type and ad to %top-print (defun ml-top_print (x) (setq %top-print (cons (cons (cadr %ty) (car x)) %top-print)) x) ;;; MJCG 30/1/89 for HOL88 ;;; ML function to grab argument and type ;;; only works at top-level (dml |top_print| 1 ml-top_print ((* -> **) -> (* -> **))) ;;; the parameter "cl" requests surrounding parentheses ;;; MJCG 25 Jan 1989 for HOL88 ;;; Separated out and improved printing of concrete types. ;;; Fixed for HOL88 to look up type in %top-print. (defun prinml (x ty cl) (let ((prfn (assoc-equal ty %top-print))) (if prfn (funcall (cdr prfn) (list x)) (case (if (isconctype ty) 'conctype (car ty)) (mk-nulltyp (ml-print_void x)) (mk-inttyp (ml-print_int x)) (mk-toktyp (ml-print_tok x)) (mk-booltyp (ml-print_bool x)) (mk-termtyp (ml-print_term x)) (mk-formtyp (ml-print_form x)) (mk-typetyp (ml-print_type x)) (mk-thmtyp (ml-print_thm x)) (mk-listyp (print_list x (cadr ty))) (mk-sumtyp (print_sum x ty cl)) (mk-prodtyp (print_prod x ty cl)) (conctype (print_conc x ty cl)) (t (if cl (ptoken |(-)|) (ptoken |-|))))))) ;printml (defun isconctype (ty) (eq (car (explode-word (car ty))) 'CONC)) ;;; Print a list x whose ELEMENTS have type ty (defun print_list (x ty) (pbegin 1) (ptoken |[|) (cond (x (prinml(car x) ty nil) (mapc #'(lambda (y) (ptoken |;|) (pbreak 1 0) (prinml y ty nil)) (cdr x)))) (ptoken |]|) (pend)) ; print_list ;;; Print value x of sum type ty (defun print_sum (x ty cl) (if cl (ptoken |(|)) (cond ((car x) (ptoken |inl |) (prinml (cdr x) (cadr ty) t)) (t (ptoken |inr |) (prinml (cdr x) (caddr ty) t))) (if cl (ptoken |)|))) ;;; Print value x of product type ty ;;; MJCG 25/1/89 for HOL88 improved printing of tuples ;;; tuples now always enclosed in brackets (defun print_prod (x ty cl) (prog () (pbegin 1) (ptoken |(|) loop (if (atom x) (go exit)) (prinml (car x) (cadr ty) t) (ptoken |,|) (pbreak 1 0) (setq x (cdr x)) (setq ty (caddr ty)) (if (eq (car ty) 'mk-prodtyp) (go loop) (go exit)) exit (prinml x ty nil) (ptoken |)|) (pend))) ;;; MJCG 25 jan 1989 for HOL88 ;;; Function for printing concrete types ;;; code moved out of writml (same action as before, but works ;;; better due to improved tuple printing) ;;; MJCG 29.10.90: extra space printed after constructor with atomic arg (defun print_conc (x ty cl) (if (atom x) (ifn cl (pstring x) (ptoken |(|) (pstring x) (ptoken |)|)) (progn (when cl (ptoken |(|)) (pstring (car x)) (if (atom (cdr x)) (ptoken | |)) (prinml (cdr x) (cadr (get (car x) 'mltype)) t) (when cl (ptoken |)|))))) hol88-2.02.19940316/lisp/f-typeml.l0000640000212700021270000007401605203501336014612 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-typeml.l ;;; ;;; ;;; ;;; DESCRIPTION: Functions for typechecking ML ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: typeml (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V2.2 :new-exit instead of err ;;; ;;; ;;; ;;; V4.3 : (\x.e)e' typechecks like let x=e' in e GH ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (special |%print_lettypes-flag|)) #+franz (declare (localf structon structoff genmlink listtyping typing adjust-fundef adjust-abstraction is-constructor is-local-constructor record-abstype record-conctype abstract-typing concrete-typing test-trap-typing parserr tidycdrs varbindings layer layerl gettype get-builtin gettypeid mutant mutant1 immut isdeftype getdeftype rectyping newdeftype gettypet tyscoperr checkabst gettypetid typebindings popenv poptenv tidy tidyup condpstring printabstype printtytail make-atom-ty mlink instof prune occursbt polyb unifyt unifybt unifytl)) ;;; make a circular list (x x x x ...) (defun twistlist (x) (let ((lx (list x))) (rplacd lx lx))) ;twistlist (defun structon (x) (setq structcheck t) x) ;structon (defun structoff (x) (setq structcheck nil) x) ;structoff ;;; Generate a type variable (defun genmlink () (list '%MLINK)) ;genmlink ;;; Check the types of several objects, recording all type errors ;;; (listtyping (ob1 ... obn) (ty1 .. tyn) ty) ;;; unifies the type of each obi with type tyi, finally returns ty ;;; if type errors occur, return a new type variable to prevent error cascade (defun listtyping (obl tyl ty) (let ((OK t)) (while obl (let ((ty$ (typing (car obl)))) (when (and (car tyl) (not (unifyt ty$ (car tyl)))) (incf type%errors) (setq OK nil) (llterpri) (llprinc '|ill-typed phrase: |) (print-ml-text (car obl) %mlprindepth) (llterpri) (let ((%temt tenv)) (ptoken |has an instance of type|) (pbreak 2 4) (printmty (tidy ty$)) (pnewline) (ptoken |which should match type|) (pbreak 2 4) (printmty (tidy (car tyl))) (pnewline)))) (setq obl (cdr obl)) (setq tyl (cdr tyl))) (if OK ty (genmlink)))) ; listtyping ;;; Deduce types of ML syntax tree ;;; also deduces ML types inside quotations, for typing of antiquotations (defun typing (ob) (let ((c (car ob)) (l (cdr ob)) (ty (genmlink)) (ty$ (genmlink))) (case c (mk-empty (if structcheck ty nullty)) (mk-boolconst boolty) (mk-intconst intty) (mk-tokconst tokty) (MK=VARTYPE typety) ((MK=VAR MK=CONST) termty) (mk-fail ty) (mk-failwith (listtyping l (list tokty) ty)) ((mk-con mk-con0) (gettype (car l))) (mk-wildcard (if structcheck (genmlink) (progn (llprinc '|wildcard allowed only in patterns|) (llterpri) (throw-from typecheck nil)))) (mk-var (let ((c-arity (is-constructor (car l)))) (when c-arity (rplaca ob (if (zerop c-arity) 'mk-con0 'mk-con))) (gettype (car l)))) (mk-consttyp (if (checkabst l) (cons (gettypet (car l)) (mapcar #'typing (cdr l))) (gettypet (car l)))) (mk-vartyp (cond ((assoc1 (car l) %vartypes)) ((push (cons (car l) ty) %vartypes) ty))) ;;; mk-objtyp deleted from the following list [TFM 90.09.09] ;;; MJCG 11 May 1992. ;;; Test for badly formed list types (e.g. (bool,bool)list) added. (mk-listyp (cond ((cdr l) (llprinc '|too many args to list |) (llterpri) (throw-from typecheck nil)) (t (cons c (list(typing(car l))))))) ((mk-inttyp mk-booltyp mk-termtyp mk-formtyp mk-typetyp mk-thmtyp mk-toktyp mk-nulltyp ;;; mk-listyp ;;; Commented out by MJCG 11 May 1992 mk-prodtyp mk-funtyp mk-sumtyp) (cons c (mapcar #'typing l))) (mk-straint (let ((ty (typing (cadr l)))) (listtyping (list (car l)) (list ty) ty))) (mk-dupl `(mk-prodtyp ,(typing (car l)) ,(typing (cadr l)))) (mk-seq (listtyping (car l) (twistlist nil) (typing (cadr l)))) (mk-list (listtyping l (twistlist ty) (list 'mk-listyp ty))) (mk-appn (ifn (eq (caar l) 'mk-abstr) (listtyping l (list (list 'mk-funtyp ty ty$) ty) ty$) (dis-place (cadr ob) (adjust-abstraction (cadadr ob) (caddadr ob))) (typing `(mk-let (,(cadar l) . ,(cadr l)))) (popenv (typing (caddar l))))) ;;; types (\x.e1)e2 like let x=e2 in e1 [GH] ;;; maybe %pt should be changed accordingly, so that the translator may ;;; take advantage of the transformation too. (mk-binop (ifn structcheck (typing `(mk-appn (mk-var ,(car l)) (mk-dupl ,@(cdr l)))) (setq ty$ `(mk-listyp ,ty)) (listtyping (cdr l) (list ty ty$) ty$))) (mk-unop (typing `(mk-appn (mk-var ,(car l)) ,(cadr l)))) (mk-assign (let ((ty nil)) (structon (setq asscheck t)) (setq ty (typing (car l))) (structoff (setq asscheck nil)) (listtyping (cdr l) (list ty) ty))) ((mk-test mk-trap) (test-trap-typing c l ty ty$)) (mk-while (listtyping (list (car l)) (twistlist boolty) nil) (typing (cadr l)) nullty) (mk-case (typing `(mk-appn (mk-fun ,(cadr l)) ,(car l)))) (mk-abstr (dis-place ob (adjust-abstraction (car l) (cadr l))) (setq l (cdr ob)) (varbindings (car l) c) (popenv (list 'mk-funtyp (structoff (typing (structon (car l)))) (typing (cadr l))))) (mk-fun (listtyping (mapcar #'(lambda (funcase) `(mk-abstr ,(car funcase) ,(cdr funcase))) (car l)) (twistlist ty) ty)) (mk-in (typing (car l)) (popenv (typing (cadr l)))) (mk-ind (typing (car l)) (poptenv (typing (cadr l)))) ((mk-ina mk-inc) (typing (car l)) (typescopechk (popenv (poptenv (typing (cadr l)))))) ((mk-let mk-letref) (let* ((consl1l2 (split (mapcar #'adjust-fundef l))) (l1 (car consl1l2)) (l2 (cdr consl1l2))) (rplacd ob (list (binarize l1 'mk-dupl) (binarize l2 'mk-dupl)))) (setq l (cdr ob)) (let ((ty (typing (cadr l)))) (prog2 (varbindings (car l) c) (structoff (listtyping (structon (list (car l))) (list ty) ty)) (if (eq c 'mk-let) (rplaca (car env) 'let))))) (mk-letrec (let* ((consl1l2 (split (mapcar #'adjust-fundef l))) (l1 (car consl1l2)) (l2 (cdr consl1l2))) (rplacd ob (list (binarize l1 'mk-dupl) (binarize l2 'mk-dupl))) (setq l (cdr ob)) (varbindings (car l) c) (rectyping l))) ((mk-abstype mk-absrectype) (abstract-typing c l)) ((mk-type mk-rectype) (concrete-typing c l)) (mk-deftype (typebindings (mapcar #'newdeftype (car l))) nullty) ((mk-tyquot mk-quot MK=ANTIQUOT MK=TYPE=ANTIQUOT) (typing (car l))) (MK=TYPE (listtyping (cdr l) (twistlist typety) typety)) (MK=TYPED (listtyping l (list termty typety) termty)) ((MK=COMB MK=PAIR MK=ABS MK=COND) (listtyping l (list termty termty termty ) termty)) (MK=NEG (listtyping l (list formty) formty)) ;;; MK=IFF deleted in the following list ((MK=CONJ MK=DISJ MK=IMP) (listtyping l (list formty formty) formty)) ((MK=FORALL MK=EXISTS) (listtyping l (list termty formty) formty)) (MK=PREDICATE (listtyping (cdr l) (list termty) formty)) ((MK=EQUIV MK=INEQUIV) (listtyping l (list termty termty) formty)) (t (parserr c)) ))) ;typing ;;; parse-failed removed by MJCG to avoid crashing into lisp (defun adjust-fundef (paire) (let ((x (car paire)) (y (cdr paire))) (case (car x) (mk-straint (adjust-fundef (cons (cadr x) `(mk-straint ,y ,(caddr x))))) (mk-appn (if (and (eq (caadr x) 'mk-var) (is-constructor (cadadr x))) (cons x y) (adjust-fundef (cons (cadr x) `(mk-abstr ,(caddr x) ,y))))) ((mk-var mk-binop mk-dupl mk-list mk-empty) (cons x y)) (t (princ '|Syntax error detected by typechecker.|) (terpri) (princ '|Bad left hand side of definition: |) (print-ml-text x %mlprindepth) (llterpri)(throw-from typecheck nil))))) ; adjust-fundef (defun adjust-abstraction (a b) (if (or (not (eq (car a) 'mk-appn)) (and (eq (caadr a) 'mk-var) (is-constructor (cadadr a)))) `(mk-abstr ,a ,b) (adjust-abstraction (cadr a) `(mk-abstr ,(caddr a) ,b)))) ; adjust-abstraction (defun is-constructor (f) (or (get f 'constructor) (is-local-constructor f env))) ; is-constructor (defun is-local-constructor (f e) (when e (if (and (eq (caar e) 'CONC) (assoc-equal f (car e))) (if (eq (car (assoc-equal f (car e))) 'mk-funtyp) 1 0) (is-local-constructor f (cdr e))))) ; is-local-constructor ;;; generate an atom and store abstype info on its property list (defun record-abstype (eqn) (let ((tysym (uniquesym "ABS" (car eqn)))) (eval-remember `(progn (putprop (quote ,tysym) (quote ,(length (cadr eqn))) 'arity) (putprop (quote ,tysym) (quote ,(car eqn)) 'abstyname))) (cons (car eqn) tysym))) ; record-abstype ;;; similar for concrete types (defun record-conctype (eqn) (let ((tysym (uniquesym "CONC" (car eqn)))) (eval-remember `(progn (putprop (quote ,tysym) (quote ,(length (cadr eqn))) 'arity) (putprop (quote ,tysym) (quote ,(car eqn)) 'tyname))) (cons (car eqn) tysym))) ; record-conctype ;;; processing of abstract types (defun abstract-typing (c l) (let ((eqnl (car l))) (let ((tyops (mapcar #'record-abstype eqnl)) (isoms nil)) (if (eq c 'mk-absrectype) (typebindings tyops)) (mapc #'(lambda (eqn) (let ((%vartypes (mapcar #'(lambda (v) (cons v (genmlink))) (cadr eqn))) (ty2 (typing (cddr eqn))) (ty1 (cons (assoc1 (car eqn) tyops) (mapcar #'cdr %vartypes)))) (unless (= (length (cadr eqn)) (length %vartypes)) (llprinc '|free vartype in abstype equation|) (llterpri) (throw-from typecheck nil)) (push (list (concat '|rep_| (car eqn)) 'mk-funtyp ty1 ty2) isoms) (push (list (concat '|abs_| (car eqn)) 'mk-funtyp ty2 ty1) isoms))) eqnl) (if (eq c 'mk-abstype) (typebindings tyops)) (push (cons 'abs isoms) env) (prog1 (typing (cadr l)) (popenv (rplacd (cadr env) (cdar env)))))) ) ; abstract-typing ;;; processing of concrete types (defun concrete-typing (c eqnl) (let ((tyops (mapcar #'record-conctype eqnl)) (constrs nil)) (if (eq c 'mk-rectype) (typebindings tyops)) (mapc #'(lambda (eqn) (let ((%vartypes (mapcar #'(lambda (v) (cons v (genmlink))) (cadr eqn)))) (let ((ty1 (cons (assoc1 (car eqn) tyops) (mapcar #'cdr %vartypes)))) (mapc #'(lambda (constr-def) (let ((ty (ifn (cdr constr-def) ty1 (list 'mk-funtyp (typing (cdr constr-def)) ty1)))) (push (cons (car constr-def) ty) constrs))) (reverse (cdddr eqn)))))) eqnl) (if (eq c 'mk-type) (typebindings tyops)) (push (cons 'constructors constrs) env) (binarize (mapcar #'cdr (cdar env)) 'mk-prodtyp))) ; concrete-typing (defun test-trap-typing (c l ty ty$) (cond ((eq c 'mk-trap) (setq l (cons (cons (triple 'once '(mk-list) (car l)) (cadr l)) (cddr l))))) (listtyping (mapcar #'cadr (car l)) (twistlist (if (eq c 'mk-test) boolty (list 'mk-listyp tokty))) nil) (let ((b nil) (e nil)) (cond ((cdr l) (setq e (cdadr l)) (setq b (caadr l)) (unless (atom b) (setq e `(mk-in (mk-let ((mk-var ,(cdr b)) . (mk-tokconst))) ,e)) (setq b (car b))) (setq ty$ (typing e)) (if (eq b 'once) (setq ty ty$))) (t (if (eq c 'mk-test) (setq ty nullty))))) (listtyping (mapcar #'cddr (car l)) (mapcar #'(lambda (x) (if (eq (car x) 'once) ty)) (car l)) ty)) ; test-trap-typing (defun parserr (c) (lcferror (catenate '|bad parser constructor | c))) ;parserr (defun initmltypenv () (setq nullty '(mk-nulltyp)) (setq boolty '(mk-booltyp)) (setq intty '(mk-inttyp)) (setq tokty '(mk-toktyp)) ;;;(setq objty '(mk-objtyp)) deleted: [TFM 90.09.09] (setq typety '(mk-typetyp)) (setq termty '(mk-termtyp)) (setq formty '(mk-formtyp)) (setq thmty '(mk-thmtyp)) (setq %emt nil) (setq %temt nil) (setq %deftypes nil)) ;inittmltypenv (eval-when (load) (cond (initial%load (initmltypenv)))) ;;; Top-level type checker (defun typecheck (ob) (let ((ph (car ob)) (env %emt) (tenv %temt) (type%errors 0) (asscheck nil) (structcheck nil) (glassl nil) (%vartypes nil)) (let ((ty (tidy (typing ob)))) (unless (zerop type%errors) (llprinc type%errors) (llprinc '| error|) (if (> type%errors 1) (llprinc '|s|)) (llprinc '| in typing|) (llterpri) (throw-from typecheck nil)) (typescopechk ty) (when (and (eq ph 'mk-letref) (poly ty)) (llprinc '|top-level letref has polytype |) (printmty ty) (pnewline) (throw-from typecheck nil)) (mapc #'(lambda (x) (cond ((poly (cdr x)) (llprinc '|non-local assignment to polytyped variable |) (llprinc (car x)) (llterpri) (throw-from typecheck nil)))) glassl) (unless (eq tenv %temt) (setq %thistydec (car tenv))) (unless (eq env %emt) (tidycdrs (cdr (setq %thisdec (car env))))) ty))) ; typecheck (defun tidycdrs (l) (mapc #'(lambda(x) (rplacd x (tidy (cdr x)))) l)) ;tidycdrs (defun updatetypes () (cond (%sections (if %thisdec (push %thisdec %emt)) (if %thistydec (push %thistydec %temt))) (t (setq %deftypes (append %thistydec %deftypes)) (when %thisdec (putpropl (cdr %thisdec) 'mltype) (mapc #'(lambda (x) (if (eq 'mk-letref (car %thisdec)) (putprop (car x) t 'refvar) (remprop (car x) 'refvar))) (cdr %thisdec)) (mapc #'(lambda (x) (if (eq 'constructors (car %thisdec)) (putprop (car x) (if (eq (cadr x) 'mk-funtyp) 1 0) 'constructor))) (cdr %thisdec)))))) ;updatetypes ;;; Push a new layer of bindings onto the environment ;;; "binder" tells how binders were created; mk-let, mk-letrec, etc. (defun varbindings (st binder) (push (cons binder (layer st)) env)) ;varbindings (defun layer (st) (case (car st) (mk-var (ifn (is-constructor (cadr st)) (list (cons (cadr st) (genmlink))))) (mk-appn (layerl (cdr st))) (mk-straint (layer (cadr st))) ((mk-dupl mk-list) (layerl (cdr st))) (mk-binop (layerl (cddr st))) (t nil))) ;layer (defun layerl (stl) (cond (stl (append (layer (car stl)) (layerl (cdr stl)))))) ;layerl ;;; get the type of the identifier ;;; if unbound, print message and assume identifier is bound by "letref" (defun gettype (%id) (cond ((let ((nonloc nil)) (gettypeid env))) (t (incf type%errors) (llterpri) (llprinc '|unbound or non-assignable variable |) (llprinc %id) (llterpri) (varbindings (list 'mk-var %id) 'mk-letref) (genmlink)))) ; gettype ;;; Look up "it", or a dmlc'd constant (defun get-builtin () (when (and (eq %id lastvalname) (assq 'mk-abstr env)) (llprinc '|May not use '|) (llprinc lastvalname) (llprinc '|' in a function body|) (llterpri) (throw-from typecheck nil)) (get %id 'mltype)) ; get-builtin ;;; Get type type of %id in environment e ;;; asscheck is true if this is the left-hand of an assignment ;;; nonloc is true if e was found underneath a mk-abstr binding (defun gettypeid(e) (ifn e (let ((ty (get-builtin))) (cond ((get %id 'refvar)ty) (asscheck (if (is-constructor %id) ty)) (ty (mutant ty nil)))) (let ((ty (assoc1 %id (cdar e)))) (cond ((null ty) (cond ((eq (caar e) 'mk-abstr) (setq nonloc t))) (gettypeid (cdr e))) ((eq (caar e) 'mk-letref) (cond ((and asscheck nonloc) (push (cons %id ty) glassl))) ty) (asscheck nil) ; assignable variable needed? ((memq (caar e) '(let abs)) (mutant ty (cdr e))) (t ty) )))) ; gettypeid ;;; Rename type variables for different uses of a let-bound identifier ;;; (also abstract type isomorphisms) (defun mutant (ty %env) (if (poly ty) (let ((%l nil)) (mutant1 ty)) ty)) ;mutant (defun mutant1 (ty) (cond ((instof ty) (mutant1 (instof ty)) ) ((or (atom ty) (mlink ty)) (cond ((assq1 ty %l)) ((immut ty %env) ty) ((cdar (push (cons ty (genmlink)) %l))))) ((cons (car ty) (mapcar #'mutant1 (cdr ty)))))) ;mutant1 ;;; A type variable is immutable only if all its uses are in let-bound ;;; identifiers (or abstract type isomorphisms) (defun immut (tyv e) (and e (or (and (not (memq (caar e) '(let abs))) (exists #'(lambda (x) (occurst tyv (cdr x))) (cdar e))) (immut tyv (cdr e))))) ;immut ;;; See if a synonym exists for a given type, returns (tok . ty) or nil ;;; This test is used to see if the type is monomorphic. The token returned ;;; may actually be out of scope. (defun isdeftype (ty te) (cond ((null te) (revassoc ty %deftypes)) ((revassoc ty (car te))) ((isdeftype ty (cdr te))))) ; isdeftype ;;; Get the current synonym for type ty in environment te ;;; Returns nil if none, else (tok . ty) ;;; "nil" is a legal type name (defun getdeftype (ty te) (let ((typair (isdeftype ty te))) (if (and typair (equal ty (gettypetid (car typair) te))) typair))) ; getdeftype (defun rectyping (l) (let ((ty (structoff (typing (structon (car l)))))) (listtyping (cdr l) (list ty) ty) (rplaca (car env) 'let) ty)) ;retyping (defun newdeftype (ob) (let ((id (car ob)) (ty (typing (cdr ob)))) (cond ((poly ty) (llprinc '|type variable in DEFTYPE|) (llterpri) (throw-from typecheck nil)) ((cons id (tidy ty)))))) ; newdeftype ;;; See if the abstract or concrete types in ty are still accessible (defun typescopechk (ty) (prog (%l) (atch ty) (return ty))) ;typescopechk (defun atch (ty) (cond ((assq ty %l) nil) ((instof ty) (atch (instof ty))) ((mlink ty) nil) ((atom ty) nil) (t (push ty %l) ;;;;; built-in type operator or user-defined abstract type (let ((arity (get (car ty) 'arity)) (name (or (get (car ty) 'abstyname) (get (car ty) 'tyname)))) (if (and arity (not (eq (gettypet name) (car ty)))) (tyscoperr name))) (exists 'atch (cdr ty))))) ; atch (defun gettypet (tyid) (cond ((gettypetid tyid tenv)) ((tyscoperr tyid)))) ;gettypet (defun tyscoperr (x) (llprinc '| type |) (llprinc x) (llprinc '| out of scope |) (llterpri) (throw-from typecheck nil)) ;tyscoperr ;;; MJCG: Reorganization and bugfix 4 May 1992 ;;; Old code: ;;; (defun checkabst (idargs) ;;; (let ((ty (gettypet (car idargs)))) ;;; (cond ;;; ((atom ty) ;;; (cond ;;; ((or (= (get ty 'arity) (length (cdr idargs))) ;;; (llprinc '|bad args for abstype |) (llprinc (car idargs)) (llterpri) ;;; (throw-from typecheck nil)) ;;; t)))))) (defun checkabst (idargs) (let ((ty (gettypet (car idargs)))) (cond ((atom ty) (cond ((= (get ty 'arity) (length (cdr idargs))) t) (t (llprinc '|bad args for abstype |) (llprinc (car idargs)) (llterpri) (throw-from typecheck nil))))))) ;checkabst ;;; Look up the type tyid in environment te or %deftypes (defun gettypetid (tyid te) (cond ((null te) (assq1 tyid %deftypes)) ((assq1 tyid (car te))) ((gettypetid tyid (cdr te))))) ;gettypetid (defun typebindings (l) (push l tenv)) ;typebindings (defun popenv (x) (pop env) x) ;popenv (defun poptenv (x) (pop tenv) x) ;poptenv ;;; Strip out links, replace type variables with stars (defun tidy (ty) (let ((%l nil) (%star '||)) (tidyup ty))) ;tidy (defun tidy1 (ty) (let ((tenv %temt)) (tidy ty))) ;tidy1 (defun tidyup (ty) (cond ((instof ty) (tidyup (instof ty))) ((assq1 ty %l)) ((or (atom ty) (mlink ty)) (setq %star (concat '|*| %star)) (push (cons ty %star) %l) %star) ((cons (car ty) (mapcar #'tidyup (cdr ty)))))) ;tidyup ;;; Print (car string) if non-nil, return value of string (defun condpstring (str) (if str (pstring (car str))) str) ;condpstring ;;; MJCG 7/2/89 for HOL88 ;;; Function to filter the output of getdeftype if ;;; |%print_lettypes-flag| is nil ;;; This only filters the top level of defined types. ;;; To filter all levels the recursive calls of ;;; getdeftype must also be filtered (i.e. the definition ;;; of getdeftype must be changed instead of just wrapping ;;; a filter around its call in printmty). (setq |%print_lettypes-flag| t) (defun lettype-filter (x) (cond (|%print_lettypes-flag| x) (t (if (atom(cdr x)) x)))) ;;; MJCG 7/2/89 for HOL88 ;;; lettype-filter wrapped around getdeftype (defun printmty (tidyty) (cond ((condpstring (lettype-filter(getdeftype tidyty %temt)))) ((atom tidyty) (pstring tidyty)) ((case (car tidyty) (mk-nulltyp (ptoken |void|)) (mk-inttyp (ptoken |int|)) (mk-booltyp (ptoken |bool|)) (mk-toktyp (ptoken |string|)) ; used to be tok GH 7/28/83 ;;; (mk-objtyp (ptoken |obj|)) ; obj deleted [TFM 90.09.09] (mk-typetyp (ptoken |type|)) (mk-termtyp (ptoken |term|)) (mk-formtyp (ptoken |form|)) (mk-thmtyp (ptoken |thm|)) (t (let ((abs (getdeftype (car tidyty) %temt))) (cond (abs (printabstype (cdr tidyty) (car abs))) ((eq (car tidyty) 'mk-listyp) (printabstype (cdr tidyty) '|list|)) (t (pbegin 1) (ptoken |(|) (printmty (cadr tidyty)) (printtytail (car tidyty) (caddr tidyty)) (ptoken |)|) (pend))))))))) ; printmty (defun printabstype (args name) (pbegin 0) (cond ((cdr args) ; more than one arg, so print brackets (pbegin 1) (ptoken |(|) (printmty (car args)) (mapc #'(lambda (arg) (ptoken |,|) (printmty arg)) (cdr args)) (ptoken |)|) (pend) (pbreak 1 0)) (args (printmty (car args)) (pbreak 1 0))) (pstring name) (pend)) ; printabstype ;;; supress parentheses in t1 op t2 op t3 op t4, for any one op (defun printtytail (op ty) (case op (mk-prodtyp (ptoken | #|)) (mk-sumtyp (ptoken | +|)) (mk-funtyp (ptoken | ->|)) (t (lcferror '|bad type to print|))) (pbreak 1 0) (cond ((condpstring (getdeftype ty %temt))) ((and (consp ty) (eq op (car ty))) (printmty (cadr ty)) (printtytail op (caddr ty))) (t (printmty ty)))) ; printtytail ;;; convert a human-readable Lisp form into an ML type (defun makety (e) (cond ((null e) nullty) ((atom e) (make-atom-ty e)) ((eq (cadr e) '|list|) ; bars added JAC 7/89 (list 'mk-listyp (makety (car e)))) ((eq (cadr e) arrow-sym) (list 'mk-funtyp (makety (car e)) (makety (caddr e)))) ((eq (cadr e) sum-sym) (list 'mk-sumtyp (makety (car e)) (makety (caddr e)))) ((eq (cadr e) prod-sym) (list 'mk-prodtyp (makety (car e)) (makety (caddr e)))) (t (lcferror 'makety)))) ;makety ;;; look up a type name (defun make-atom-ty (e) (case e ((|void| |.|) nullty) (|int| intty) (|bool| boolty) ((|string| |tok| |token|) tokty) ;;; (|obj| objty) deleted : [TFM 90.09.09] (|type| typety) (|term| termty) (|form| formty) (|thm| thmty) (t e))) ; make-atom-ty ;;; check for a type variable (defun mlink (ty) (ifn (atom ty) (eq (car ty) '%MLINK))) ;mlink ;;; See if type variable has been unified with some type (defun instof (ty) (if (mlink ty) (cdr ty))) ;instof (defun prune (ty) (if (instof ty) (prune (instof ty)) ty)) ;prune (defun occurst (v ty) (occursbt v (prune ty))) ;occurst (defun occursbt (tyv bty) (if (mlink bty) (eq tyv bty) (exists #'(lambda (ty) (occurst tyv ty)) (cdr bty)))) ;occurstb ;;; See if the type is polymorphic (defun poly (ty) (polyb (prune ty))) ;poly (defun polyb (bty) (or (atom bty) (mlink bty) (exists 'poly (cdr bty)))) ;polyb ;;; Return t if types can be unified. ;;; side-effect -- link certain type variables to types (defun unifyt (ty1 ty2) (unifybt (prune ty1) (prune ty2))) ;unifyt (defun unifybt (bty1 bty2) (cond ((eq bty1 bty2)) ((mlink bty1) (cond ((occursbt bty1 bty2) nil) (t (rplacd bty1 bty2)))) ((mlink bty2) (cond ((occursbt bty2 bty1) nil) (t (rplacd bty2 bty1)))) ((eq (car bty1) (car bty2)) (unifytl (cdr bty1) (cdr bty2))))) ;unifybt ;;; unify corresponding types in each list ;;; returns t if each pair can be unified (defun unifytl (tyl1 tyl2) (cond ((null tyl1)) ((unifyt (car tyl1) (car tyl2)) (unifytl (cdr tyl1) (cdr tyl2))) )) ;unifytl hol88-2.02.19940316/lisp/hol-pars.l0000640000212700021270000010430105525716755014615 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: hol-pars.l ;;; ;;; ;;; ;;; DESCRIPTION: Modified version of f-parsol.l to parse HOL ;;; ;;; ;;; ;;; USES FILES: f-franz.l (or f-cl.l), f-constants.l, f-macro.l., ;;; ;;; f-ol-rec.l, genmacs.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Bugfix by MJCG on 08.02.94 ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; hol-pars.l ;;; Modified version of F-parsol.l to parse HOL. ;;; See mk_HOL.ml for more details. (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (include "lisp/genmacs") (special ol-lam-sym select-tok pair-tok toklbearer constrs zeros-count %interface-map |%interface_print-flag| %interface-props %hidden-consts %name |%read_sexpr-flag| %sexpression %syntax-block-enabled)) #+franz (declare (localf build-lam-vstruc quant-wrap checkbit mk-zeros-list)) (setq spec-toks '(\\ \| |:| |(| |)| |^| |=>| |.| |"|)) ;;; parse an OL quotation (for ML) ;;; HOL: test for "dangling predicate symbols" modified to use constrs ;;; instead of term-constrs and form-constrs (defun parse-ol () (let ((lang1 'ol1)(lang2 'ol2)(langlp 'ollp)(atom-rtn '(ol-atomr)) (juxtlevel 120) ; precedence of application (%mk=antiquot 'MK=ANTIQUOT) (juxt-rtn '(oljuxt arg1))(ibase 10)(parsedepth 0)) (parse-level 0) ; this check catches dangling predicate symbols (if (memq (car arg1) constrs) arg1 (parse-failed "syntax error in quotation")) )) ;parse-ol ;;; declare a user-defined OL infix ;;; called from theory package ;;; HOL: not changed (defun olinfix (x typ) (let ((lang1 'ol1)(lang2 'ol2)(langlp 'ollp)) (putprop x typ 'olinfix) (binop x (+ olinprec 5) ; right-associative (list (if (eq typ 'paired) 'olinf-rtn 'olcinf-rtn)(list 'quote x))) )) ;olinfix ;;; parse paired OL infix ;;; HOL: term-check removed (defun olinf-rtn (x) (list 'MK=COMB (mk-ol-atom x) (list 'MK=PAIR arg1 (parse-level olinprec)))) ;;; parse curried OL infix ;;; HOL: term-check removed (defun olcinf-rtn (x) (list 'MK=COMB (list 'MK=COMB (mk-ol-atom x) arg1) (parse-level olinprec))) ;;; handle parentheses, also special token () ;;; HOL: not changed (defun lpar-rtn () (cond ((eq token rparen-sym) (gnt) '(MK=CONST |()|)) (t (check rparen-sym (parse-level 0) "bad paren balance"))) ) ;lpar-rtn ;;; MJCG 20/10/88 for HOL88 ;;; term-rtn changed ;;; logical connectives ;;; HOL: (term-rtn const a b) --> `(MK=COMB (MK=COMB ,const ,a) ,b) (defun term-rtn (const a b) `(list 'MK=COMB (list 'MK=COMB (mk-ol-atom (quote ,const)) ,a) ,b)) ;;; routine for OL atoms, linked to atom-rtn ;;; HOL: not changed yet ;;; (modification for numbers and bitstrings in other files) (defun ol-atomr () (mk-ol-atom ptoken)) ;ol-atomr ;;; determine the use of an OL atom : constant or variable ;;; for OL, numbers are scanned as symbols ;;; HOL: clause for predicates deleted ;;; MJCG 19/10/88 for HOL88 ;;; Added applying interface map (including code for syn-const) ;;; It applies an interface map to variables and constants on-the-fly as ;;; they are parsed. I am not convinced it is fully correct! ;;; MJCG 8/11/88 for HOL88 ;;; changed from using constp to has-const to handle hidden constants. (eval-when (compile) (defmacro has-const (tok) `(get ,tok (quote const)))) ;;; MJCG for HOL88.1.02 on 28/3/1989 ;;; Check for parsing hol strings before type ":string" defined added ;;; MJCG for HOL88.1.12 on 24/7/1990. Bugfix to allow nil to be mapped. (defun mk-ol-atom (x) (cond ((memq x spec-toks) (parse-failed (concat x '| cannot be a term|))) ((numberp x) (list 'MK=CONST (atomify x))) ((or (has-const x) (tokconstp x) (numconstp x) (wordconstp x)) (let ((p (get x 'interface-parse))) (if p (list 'MK=CONST (car p)) (list 'MK=CONST x)))) ((eq x tokflag) (if (equal (get '|string| 'canon) '(|string|)) (list 'MK=CONST (let ((tok (car toklist))) (setq toklist (cdr toklist)) (imploden (append '(96) (append (exploden tok) '(96)))))) (parse-failed '|type ":string" not defined -- load library string?|))) (t (let ((p (get x 'interface-parse))) (cond (p (list 'MK=CONST (car p))) ((get x 'syn-const) (list 'MK=CONST x)) (t (list 'MK=VAR x))))))) ;;; routine for juxtaposed OL objects, linked to juxt-rtn ;;; handles predicates and combinations ;;; HOL: code for predicates removed and term-check removed (defun oljuxt (x) (list 'MK=COMB x (parse-level juxtlevel))) ;;; Parse lambda or quantifier ;;; HOL: rewritten to allow "\(x:num) (y:bool,z) ..." etc ;;; extra argument (const-name) for better error messages ;;; MJCG for HOL88 10/2/89 ;;; Bugfix: to prevent Alex Bronstein's bug ;;; (i.e. "!x.\y.t" parsing as "!x y.t") ;;; build-lam-struc takes const-name instead of const ;;; Modified by MJCG 24.1.91 for restrictions ;;; Period precedence is stacked to cope with "!x y::(\z. Q z). x |string|)) ;;; MJCG 10/2/88 for HOL88 ;;; Bugfix: to prevent Alex Bronstein's bug ;;; (i.e. "!x.\y.t" parsing as "!x y.t") ;;; quant-wrap inserted into build-lam-struc ;;; instead of second pass using (now deleted) mk-quant-pt (defun quant-rtn (const-name) (lamq-rtn const-name 'MK=ABS 5)) ;;; makes a token a binder - declared as ML function: parse_as_binder (defun binder-rtn (tok) (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp)) (putprop tok t 'binder) (unop tok `(quant-rtn (quote ,tok))) tok)) ;;; Moved here from parse_as_binder.l [TFM 92.10.01 for HOL88 2.01] ;;; |tok| changed to |string| (dml |parse_as_binder| 1 binder-rtn (|string| -> |string|)) ;;; negation -- extends over predicates only ;;; HOL: "~t" --> "NOT t" (defun neg-rtn () `(MK=COMB (MK=CONST ,neg-tok) ,(parse-level 59))) ;;; HOL: Convert "(t => e1 | e2)" to "COND t e1 e2" (defun hol-cond-rtn (p) `(MK=COMB (MK=COMB (MK=COMB (MK=CONST COND) ,p) ,(check else-tok (parse-level 80) "need 2 nd branch to conditional")) ,(parse-level 80))) ;;; antiquotation of terms/forms (MK=ANTIQUOT) or types (MK=TYPE=ANTIQUOT) ;;; HOL: not changed (defun metacall () (list %mk=antiquot (progn (gnt) (cond ((eq ptoken lparen-sym) (check rparen-sym (parseml metaprec) "bad antiquotation")) ((= ptoktyp 1) (mlatomr)) ((parse-failed "junk in antiquotation")))))) ;metacall ;;; type constraint on term ;;; HOL: term-check removed (defun oltyp-rtn () (list 'MK=TYPED arg1 (olt))) ;oltyp-rtn ;;; free-standing type quotation ;;; this is presumably a separate recursive descent parser (defun olt () (let ((%mk=antiquot 'MK=TYPE=ANTIQUOT)) (olt1 (olt2 (olt3 (olt4)))))) ;olt (defun olt1 (x) (cond ((eq token arrow-tok) (gnt) (list 'MK=TYPE '|fun| x (olt))) (t x))) ;olt1 ;;; PPLAMBDA does not have any built-in "sum" type, but user may define it (defun olt2 (x) (cond ((eq token sum-tok) (gnt) (list 'MK=TYPE '|sum| x (olt2 (olt3 (olt4))))) (t x))) ;olt2 (defun olt3 (x) (cond ((eq token prod-tok) (gnt) (list 'MK=TYPE '|prod| x (olt3 (olt4)))) (t x))) ;olt3 ;;; vartype-rtn (from ~lcp/lcf/franz/f-parser.l) needs to be modified ;;; to cope with gnt returning ** etc. as a single token (defun vartype-rtn () (prog (n) ;;; (if cflag (return mul-sym)) replaced by line below (ISD/TFM bug) (if cflag (return ptoken)) (setq n (length(exploden ptoken))) loop (ifn (or (numberp token) (= toktyp 1) (test-list-els (exploden token) '(42))) (return (imploden (itrate multiply n)))) (gnt) (when (and (test-list-els (exploden ptoken) '(42)) (not cflag)) (setq n (+ n (length(exploden ptoken)))) (go loop)) (return (imploden (nconc (itrate multiply n) (exploden ptoken))))) ) ;vartype-rtn (defun olt4 () (prog (x) (gnt) (when (eq ptoken lparen-sym) (setq x (cond ((eq token rparen-sym) (gnt) nil) (t (olt5)))) (go l)) (setq x (list (cond ((eq ptoken anticnr-tok) (metacall)) ((test-list-els (exploden ptoken) '(42)) (list 'MK=VARTYPE (vartype-rtn))) ((not (= ptoktyp 1)) (parse-failed (catenate ptoken " is not allowed in a type"))) (t (list 'MK=TYPE ptoken))))) l (cond ((= toktyp 1) (gnt)) ((and x (null (cdr x))) (return (car x))) (t (parse-failed "missing type constructor"))) (setq x (list (cons 'MK=TYPE (cons ptoken x)))) (go l))) ;olt4 (defun olt5 () (prog (x) (setq x (list (olt))) loop (cond ((eq token rparen-sym) (gnt) (return x)) ((eq token comma-sym) (gnt) (setq x (append x (list (olt)))) (go loop)) (t (parse-failed "missing separator or terminator in type"))) )) ;olt5 ;;; set up OL symbols and precedences (setq select-tok '|@|) (setq eq-tok '|=|) (setq pair-tok comma-sym) ;;; MJCG for HOL88 2/11/1988 ;;; mark certain symbols to always parse as a constant (eval-when (load) (putprop conj-tok t 'syn-const) (putprop disj-tok t 'syn-const) ;;;(putprop iff-tok t 'syn-const) DELETED [TFM 90.01.20] (putprop imp-tok t 'syn-const) (putprop eq-tok t 'syn-const) (putprop neg-tok t 'syn-const) (putprop pair-tok t 'syn-const) (putprop forall-tok t 'syn-const) (putprop exists-tok t 'syn-const) (putprop select-tok t 'syn-const) (putprop '|?!| t 'syn-const) (let ((lang1 'ol1) (lang2 'ol2) (langlp 'ollp)) (putprop endcnrtok 0 'ollp) (putprop rparen-sym 0 'ollp) (unop lparen-sym '(lpar-rtn)) (unop neg-tok '(neg-rtn)) (binder-rtn forall-tok) (binder-rtn exists-tok) (binder-rtn select-tok) (binder-rtn 'OUTER_FREE_VARIABLE) ; in OL, all infixes associate to RIGHT ; iff-tok deleted [TFM 90.01.20] (binop eq-sym 15 (term-rtn eq-tok 'arg1 '(parse-level 10))) ;;;(binop iff-tok 25 (term-rtn iff-tok 'arg1 '(parse-level 20))) (binop imp-tok 35 (term-rtn imp-tok 'arg1 '(parse-level 30))) (binop disj-tok 45 (term-rtn disj-tok 'arg1 '(parse-level 40))) (binop conj-tok 55 (term-rtn conj-tok 'arg1 '(parse-level 50))) (binop comma-sym 95 (term-rtn pair-tok 'arg1 '(parse-level 90))) ;;; Old definitions (for debugging) ;;; (setq PAIR-pt `(MK=CONST ,pair-tok)) ;;; (defun old-term-rtn (const a b) `(MK=COMB (MK=COMB ,const ,a) ,b)) ;;; (binop comma-sym 95 '(old-term-rtn PAIR-pt arg1 (parse-level 90))) (binop condl-tok 85 '(hol-cond-rtn arg1)) (unop lambda-tok '(lam-rtn)) (putprop else-tok 10 'ollp) ; the value of the number seems irrelevant (binop colon-sym 105 '(oltyp-rtn)) (unop anticnr-tok '(metacall)) (unop exfix-sym '(progn (gnt) (mk-ol-atom ptoken))) ) (putprop neg-tok t 'prefix) (setq olinprec 100) ;;; HOL: term-constrs and form-constrs are merged to constrs (and many removed) (setq constrs '(MK=ANTIQUOT MK=CONST MK=VAR MK=COMB MK=ABS MK=TYPED MK=ANTIQUOT)) ) ;;; The code that follows is for parsing numbers and bitstrings (defun checkbit (x) (cond ((or (= x #/1) (= x #/0)) x) (t (parse-failed '|non-bit in word|)))) (defun mk-zeros-list (n) (cond ((zerop n) nil) (t (cons #/0 (mk-zeros-list (sub1 n)))))) ;;; Bugfix by MJCG 08.02.94 ;;; Maybe support for "#..." notation for ":word" types can be deleted. (setq zeros-count 0) (defun word-rtn (x) (if (eq (car x) 'MK=CONST) (list 'MK=CONST (imploden (cons #/# (append (mk-zeros-list zeros-count) (cond ((eq (cadr x) '|0|) nil) (t (mapcar #'checkbit (exploden (cadr x))))))))) (parse-failed '|non-word after #|))) (defun hol-persetup () (putprop period-sym 650 'ollp)) ;;; Added 23.1.91 by MJCG to support variable restrictions ;;; Used in f-parser.l (defun hol-restrictsetup () (putprop restrict-tok 105 'ollp)) (eval-when (load) (let ((lang1 'ol1)(lang2 'ol2)(langlp 'ollp)) (unop prod-tok '(word-rtn (parse-level 1000))))) (eval-when (load) (put-double '|=| '(#/> #/=)) (put-double '|-| '(#/>)) (put-double '|:| '(#/=)) (put-double '|;| '(#/;)) (put-double '|/| '(#/\)) (put-double '\\ '(#//)) (put-double '|>| '(#/< #/> #/=)) (put-double '|<| '(#/< #/> #/- #/=)) (put-double '|-| '(#/- #/>)) (put-double '|--| '(#/> #/-)) (put-double '|==| '(#/= #/>)) (put-double '|<-| '(#/- #/>)) (put-double '|<=| '(#/= #/>)) (put-double '|?| '(#/! #/? #/\)) (put-double '|!| '(#/! #/? #/\)) (put-double '|+| '(#/+)) (put-double '|*| '(#/*)) (put-double '|/| '(#// #/\))) (setq infixables '(|/| |#| |*| |+| |-| |<| |=| |>| /\\ \\/ |==>| |<=>| |,| |^| |++| |**| |--| |//| |<-| |<--| |<=| |<==| |<<| |>>| |<>| |><|)) ;;; := added TFM 88.03.31 (setq legalconsts '(|/| |#| |*| |+| |-| |<| |=| |>| |;| |&| |==>| |<=>| |~| /\\ \\/ |,| |!| |?| |@| |??| |!!| |?!| |!?| |==| |<<| |>>| |<=| |>=| |<>| |><| |-->| |++| |**| |--| |//| |<-| |<--| |<=| |<==| |<<| |>>| |:=|)) ;;; MJCG 21/10/88 for HOL88 ;;; Code to support interface maps ;;; %interface-map is a list ((a1.v1) ... (an.vn)) where each ai is ;;; translated to vi by the parser, and vi to ai by the pretty printer. ;;; Each vi must be a HOL constant. ;;; Each ai can be either a variable or constant. ;;; When an interface map is activated eah vi is made an interface-parse ;;; property of ai, and each ai is made an interface-print property of vi. (setq %interface-map nil) ;;; |%interface_print-flag| determines whether the inverse interface map ;;; is applied when printing (setq |%interface_print-flag| t) ;;; MJCG 19/10/88 for HOL88 ;;; dml-ed function for setting interface printing status from ML ;;; old value returned ;;;(defun ml-interface_printing (x) ;;; (prog1 |%interface_print-flag| (setq |%interface_print-flag| x))) ;;;(dml |interface_printing| ;;; 1 ;;; ml-interface_printing ;;; (|bool| -> |bool|)) ;;; MJCG 17/10/88 for HOL88 ;;; dml-ed function for getting interface map from ML (defun ml-interface_map () %interface-map) (dml |interface_map| 0 ml-interface_map (|void| -> ((|string| |#| |string|) |list|))) ;;; MJCG 21/10/88 for HOL88 ;;; Properties moved from a constant to its new name ;;; paired with property old values are saved under. ;;; MJCG 24/1/91 -- restrict and unrestrict saved (setq %interface-props '((ollp . ollp-save) (ol1 . ol1-save) (ol2 . ol2-save) (olinfix . olinfix-save) (binder . binder-save) (restrict . restrict-save) (unrestrict . unrestrict-save))) ;;; MJCG 21/10/88 for HOL88 ;;; Function for moving properties, saving old values is necessary. ;;; The property saved indicates that the properties have been saved ;;; MJCG for HOL88.1.12 on 24/7/1990. Bugfix to allow nil to be mapped. ;;; -- (list val) instead of val. (defun put-save (name val) (if (has-const name) (putprop name t 'saved)) (mapc (function (lambda (pp) (let ((prop (car pp)) (saveprop (cdr pp))) (if (has-const name) (putprop name (get name prop) saveprop)) (putprop name (subst-equal `(quote ,name) `(quote ,val) (get val prop)) prop)))) ;;; subst above an awful hack -- sorry! %interface-props) (putprop name (list val) 'interface-parse) (putprop val name 'interface-print)) ;;; MJCG 21/10/88 for HOL88 ;;; Function for restoring old values. ;;; MJCG 9/1/89 for HOL88 ;;; Bugfix (bug report from David Shepherd) ;;; new-name and old-name added as parameters. ;;; interface-print property removed from old-name (defun restore-prop (new-name old-name) (mapc (function (lambda (pp) (let ((prop (car pp)) (saveprop (cdr pp))) (cond ((get new-name 'saved) (putprop new-name (get new-name saveprop) prop) (remprop new-name saveprop)) ((not (has-const new-name)) (remprop new-name prop) (remprop new-name saveprop)))))) %interface-props) (remprop new-name 'interface-parse) (remprop old-name 'interface-print) (remprop new-name 'saved)) ;;; MJCG 4/1/89 for HOL88 (bugfix from David Shepherd of Inmos) ;;; distinctp defined here as it is a local function of genfns.l ;;;(distinctp (x1 ... xn)) is t if x1, ... ,xn are distinct and nil otherwise. (defun distinctp (x) (cond ((null x) t) (t (and (not(memq (car x) (cdr x))) (distinctp (cdr x)))))) ;;; MJCG 17/10/88 for HOL88 ;;; dml-ed function for setting an interface map from ML ;;; The old interface map is undone and returned. ;;; The code for propagating properties from a constant to its new ;;; name is pretty awful .. but it seems to work. ;;; MJCG 9/1/89 for HOL88 ;;; Bugfix (bug report from David Shepherd) ;;; new and old name passed to restore-prop ;;; (previously just the new name was passed) (defun ml-set_interface_map (new-map) (prog (pair map old-map source range) (if (null new-map) (go undo)) (setq map (reverse new-map)) (setq source nil) (setq range nil) loop (if (null map) (go test)) ; unzip new-map into source and range (setq pair (car map)) (setq source (cons (car pair) source)) (setq range (cons (cdr pair) range)) (setq map (cdr map)) (go loop) test (if (not (distinctp source)); test map single valued (failwith "interface map not single valued")) (if (not (distinctp range)); test map 1-1 (failwith "interface map not 1-1")) (mapc ; prevent existing constants becoming hidden (function (lambda (a) (if (and (has-const a) (not(memq a range))) (failwith (concat a " would become hidden"))))) source) (mapc ; check range consists of constants (function (lambda (v) (if (not(has-const v)) (failwith (concat v " not a constant"))))) range) undo (mapc ; undo old interface (function(lambda (p) (restore-prop (car p) (cdr p)))) %interface-map) (mapc ; set up infix and binder status (function(lambda (p) (put-save (car p) (cdr p)))) new-map) (setq old-map %interface-map) (setq %interface-map new-map) (return old-map))) (dml |set_interface_map| 1 ml-set_interface_map (((|string| |#| |string|) |list|) -> ((|string| |#| |string|) |list|))) ;;; MJCG 17/10/88 for HOL88 ;;; dml-ed function for testing whether a string is a constant (defun ml-is_constant (str) (not (null (constp str)))) (dml |is_constant| 1 ml-is_constant (|string| -> |bool|)) ;;; MJCG 17/10/88 for HOL88 ;;; dml-ed function for testing whether a string is an infix (defun ml-is_infix (str) (not (null (get str `ol2)))) (dml |is_infix| 1 ml-is_infix (|string| -> |bool|)) ;;; MJCG 17/10/88 for HOL88 ;;; dml-ed function for testing whether a string is a binder (defun ml-is_binder (str) (get str `binder)) (dml |is_binder| 1 ml-is_binder (|string| -> |bool|)) ;;; MJCG 22/01/90 for HOL88 ;;; dml-ed function for testing whether a string is a type (defun ml-is_type (str) (get str `olarity)) (dml |is_type| 1 ml-is_type (|string| -> |bool|)) ;;; MJCG 22/01/90 for HOL88 ;;; dml-ed function for getting the arity of a type operator ;;; from its name (defun ml-arity (str) (let ((n (get str `olarity))) (if (null n) (failwith '|arity|) n))) (dml |arity| 1 ml-arity (|string| -> |int|)) ;;; MJCG 22/01/90 for HOL88 ;;; dml-ed function for getting the HOL type of a constant from ;;; its name (failure if not a constant) (defun ml-get_const_type (str) (let ((val (get str `const))) (if (null val) (failwith '|get_const_type|) val))) (dml |get_const_type| 1 ml-get_const_type (|string| -> |type|)) ;;; MJCG 27/10/88 for HOL88 (defun ml-is_letter (x) (let ((l (exploden x))) (if (lessp 1 (length l)) (failwith '|is_letter|) (letterp (car l))))) (dml |is_letter| 1 ml-is_letter (|string| -> |bool|)) (defun ml-new_letter (x) (let ((l (exploden x))) (if (lessp 1 (length l)) (failwith '|new_letter|) (setq %special-letters (cons (car l) %special-letters))))) (dml |new_letter| 1 ml-new_letter (|string| -> |void|)) ;;; MJCG 27/10/88 for HOL88 (defun ml-is_alphanum (x) (let ((l (exploden x))) (if (lessp 1 (length l)) (failwith '|is_alphanum|) (alphanump (car l))))) (dml |is_alphanum| 1 ml-is_alphanum (|string| -> |bool|)) (defun ml-new_alphanum (x) (let ((l (exploden x))) (if (lessp 1 (length l)) (failwith '|new_alphanum|) (setq %special-alphanums (cons (car l) %special-alphanums))))) (dml |new_alphanum| 1 ml-new_alphanum (|string| -> |void|)) ;;; MJCG 27/10/88 for HOL88 ;;; Function for converting %special-table to formal for ML ;;; First a function for converting a pair (c . (m1 ... mn)) ;;; to (cm1' ... cmn') where cmi' is c concatenated onto ;;; the character represented by mi. (defun make-special-list (c l) (prog (l1 r) (setq l1 l) (setq r nil) loop (if (null l1) (return (reverse r))) (setq r (cons (concat c (ascii (car l1))) r)) (setq l1 (cdr l1)) (go loop))) (defun ml-special_symbols () (prog (lisp-table ml-table) (setq lisp-table #+franz (cdr %special-table) #-franz %special-table) (setq ml-table nil) loop (if (null lisp-table) (return ml-table)) (setq ml-table (append ml-table (make-special-list (car lisp-table) (cadr lisp-table)))) (setq lisp-table (cddr lisp-table)) (go loop))) (dml |special_symbols| 0 ml-special_symbols (|void| -> (|string| |list|))) ;;; MJCG 27/10/88 for HOL88 ;;; Add a new special symbol ;;; MJCG 29/3/89 for HOL88.1.02 ;;; new special symbols added to legalconsts (defun ml-new_special_symbol (string) (let ((l (exploden string))) (if (lessp (length l) 2) (failwith "new special symbol must have more than one character")) (if (letterp (car l)) (failwith "special symbol can't start with a letter")) (if (alphanump (car l)) (failwith "special symbol can't start with an alphanumeric")) (if (not (memq string legalconsts)) (setq legalconsts (cons string legalconsts))) (mapl (function (lambda (x) (if (cdr x) (let ((str (imploden (reverse (cdr x))))) (if (not (memq str legalconsts)) (setq legalconsts (cons str legalconsts))) (put-double str (list (car x))))))) (reverse l))) nil) (dml |new_special_symbol| 1 ml-new_special_symbol (|string| -> |void|)) ;;; MJCG 7/11/88 for HOL88 ;;; Commands for removing constants (setq %hidden-consts '(const ollp ol1 ol2 olinfix binder)) ;;; Test data: (mapc #'(lambda(x) (putprop 'foo t x)) %hidden-consts) ;;; MJCG 1/2/89 for HOL88.1.01 ;;; Bugfix: saving of empty properties suppressed (defun ml-hide_constant (%name) (if (has-const %name) (prog (saved-props) (mapcar (function (lambda (prop) (let ((val (get %name prop))) (cond (val (setq saved-props (cons (cons prop val) saved-props)) (remprop %name prop)))))) %hidden-consts) (putprop %name saved-props 'hidden-const)) (failwith (concat %name " not a constant that can be hidden")))) ;;; MJCG 1/2/89 for HOL88.1.01 ;;; Bugfix: hidden-const property not removed in HOL88.1.00 (defun ml-unhide_constant (%name) (let ((props (get %name 'hidden-const))) (cond (props (mapc (function (lambda (p) (if (cdr p) (putprop %name (cdr p) (car p))))) props) (remprop %name 'hidden-const) nil) (t (failwith (concat %name " is not a hidden constant")))))) (dml |hide_constant| 1 ml-hide_constant (|string| -> |void|)) (dml |unhide_constant| 1 ml-unhide_constant (|string| -> |void|)) ;;; MJCG 1/2/89 for HOL88.1.01 ;;; ML function for telling whether a constant is hidden (defun ml-is_hidden (tok) (not(null(get tok 'hidden-const)))) (dml |is_hidden| 1 ml-is_hidden (|string| -> |bool|)) ;;; MJCG 1/2/90 for HOL88.1.12 ;;; Function to change the escape character in strings ;;; (default `\`, i.e. ascii 92) (defun ml-set_string_escape (n) (prog1 escape (setq escape n))) (dml |set_string_escape| 1 ml-set_string_escape (|int| -> |int|)) ;;; Added 2.2.90 by MJCG ;;; Defines new syntax blocks (defun ml-new_syntax_block (beg end mlfun) (setq %syntax-block-enabled t) (putprop beg (cons mlfun end) 'syntax-block)) (dml |new_syntax_block| 3 ml-new_syntax_block ((|string| |#| (|string| |#| |string|)) |->| |void|)) ;;; MJCG 24.1.91 (defun ml-associate_restriction (x y) (putprop x y 'restrict) (putprop y x 'unrestrict)) (dml |associate_restriction| 2 ml-associate_restriction ((|string| |#| |string|) |->| |void|)) (putprop forall-tok 'RES_FORALL 'restrict) (putprop exists-tok 'RES_EXISTS 'restrict) (putprop select-tok 'RES_SELECT 'restrict) (putprop lambda-tok 'RES_ABSTRACT 'restrict) (putprop 'RES_FORALL forall-tok 'unrestrict) (putprop 'RES_EXISTS exists-tok 'unrestrict) (putprop 'RES_SELECT select-tok 'unrestrict) (putprop 'RES_ABSTRACT lambda-tok 'unrestrict) ;;; MJCG 10.12.90 for Centaur: ;;; Defines new S-expression blocks (defun new-sexpression-block (beg end lispfun) (putprop beg (cons lispfun end) 'sexpression-block)) ;;; MJCG 10.12.90 for Centaur: identity function (defun Id (x) x) ;;; MJCG 10.12.90 for Centaur: set up parse tree input (new-sexpression-block '|begin_parse_tree| '|end_parse_tree| '|Id|) ;;; MJCG 10.12.90 for Centaur: ;;; Function to convert a type value to a parse tree ;;; that will evaluate to the type (defun ty-to-pt (ty) (cond ((is-vartype ty) `(MK=VARTYPE ,(get-vartype-op ty))) (t `(MK=TYPE ,(get-type-op ty) ,@(mapcar (function ty-to-pt) (get-type-args ty)))))) ;;; MJCG 10.12.90 for Centaur: ;;; Function to convert a reshaped term value into the parse tree ;;; of an expression that evaluates to the value (defun rtm-to-pt (rtm) (case (car rtm) (var `(MK=TYPED (MK=VAR ,(cadr rtm)) ,(ty-to-pt(caddr rtm)))) (const `(MK=TYPED (MK=CONST ,(cadr rtm)) ,(ty-to-pt(caddr rtm)))) (comb `(MK=TYPED (MK=COMB ,(rtm-to-pt(cadr rtm)) ,(rtm-to-pt(caddr rtm))) ,(ty-to-pt(cadddr rtm)))) (abs `(MK=TYPED (MK=ABS (MK=VAR ,(cadr(cadr rtm))) ,(rtm-to-pt(caddr rtm))) ,(ty-to-pt(cadddr rtm)))))) ;;; MJCG 10.12.90 for Centaur: ;;; Convert a reshaped term value to a quotation parse tree (defun rtm-to-qt (rtm) `(mk-quot ,(rtm-to-pt rtm))) ;;; MJCG 10.12.90 for Centaur: set up reshaped term input (new-sexpression-block '|begin_term| '|end_term| '|rtm-to-qt|) hol88-2.02.19940316/lisp/f-typeol.l0000640000212700021270000003511705145014340014612 0ustar cammcamm;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; HOL 88 Version 2.0 ;;; ;;; ;;; ;;; FILE NAME: f-typeol.l ;;; ;;; ;;; ;;; DESCRIPTION: Checks types in quotations, and puts them into ;;; ;;; canonical form ;;; ;;; ;;; ;;; USES FILES: f-franz (or f-cl.l), f-constants.l, f-macro.l, ;;; ;;; f-ol-rec.l ;;; ;;; ;;; ;;; University of Cambridge ;;; ;;; Hardware Verification Group ;;; ;;; Computer Laboratory ;;; ;;; New Museums Site ;;; ;;; Pembroke Street ;;; ;;; Cambridge CB2 3QG ;;; ;;; England ;;; ;;; ;;; ;;; COPYRIGHT: University of Edinburgh ;;; ;;; COPYRIGHT: University of Cambridge ;;; ;;; COPYRIGHT: INRIA ;;; ;;; ;;; ;;; REVISION HISTORY: Original code: typeol (lisp 1.6) part of Edinburgh ;;; ;;; LCF by M. Gordon, R. Milner and C. Wadsworth (1978) ;;; ;;; Transported by G. Huet in Maclisp on Multics, Fall ;;; ;;; 1981 ;;; ;;; ;;; ;;; V2.2 : quotch and tyquotch rewritten using tag ;;; ;;; ;;; ;;; V4 : quotations redone, eliminating fexprs ;;; ;;; ;;; ;;; April 1987: all instances of "trunc" replaced by ;;; ;;; "hol-trunc" to prevent problems with redefining ;;; ;;; the system "trunc" -- J. Joyce ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (eval-when (compile) #+franz (include "lisp/f-franz") (include "lisp/f-constants") (include "lisp/f-macro") (include "lisp/f-ol-rec") (special %term %sticky-types %linkcount %stickylist |%show_types-flag| %canonlist |%type_error-flag| %tyvars |%sticky-flag|)) #+franz (declare (localf unifyb hol-trunc occb set-sticky use-sticky canon-quot-fm canon-ty omutant1)) (setq %linkcount 0) ;;; generate a type link, an internal type variable for matching ;;; explicit type variables such as * are not matched (defun genlink () (cons '%LINK (incf %linkcount))) ;genlink ;;; Unify two OL types for checking types in quotations (defun unify (ty1 ty2) (unifyb (hol-trunc ty1) (hol-trunc ty2))) ;unify ;;; Unify "base types" -- no intervening %LINK nodes (defun unifyb (bty1 bty2) (and bty1 bty2 (cond ((eq bty1 bty2)) ((is-linktype bty1) (if (occb bty1 bty2) nil (rplacd bty1 bty2))) ((is-linktype bty2) (if (occb bty2 bty1) nil (rplacd bty2 bty1))) ((is-vartype bty1) nil) ; since vartypes are eq ((is-vartype bty2) nil) ((and (eq (get-type-op bty1) (get-type-op bty2)) (forall 'unify (get-type-args bty1) (get-type-args bty2)))))) ) ;unifyb ;;; skip past antiquotes and resolved links in a type (defun hol-trunc (ty) (cond ((and (is-linktype ty) (not (atom (cdr ty)))) (hol-trunc (cdr ty))) ((is-antiquot ty) (hol-trunc (cdr ty))) (ty))) ;hol-trunc ;;; For unification : see if type variable v occurs in ty (defun occ (v ty) (occb v (hol-trunc ty))) ;occ (defun occb (v bty) (or (eq v bty) (case (type-class bty) ((%LINK %VARTYPE %ANTIQUOT) nil) (t (exists #'(lambda (ty) (occ v ty)) (get-type-args bty)))))) ; occb ;;; set sticky types -- called after successful evaluation of a quotation ;;; Sets sticky types of all variables to their most recent type ;;; MJCG 13/11/88 for HOL88 ;;; Record sticktypes in %sticky-types (defun set-sticky (styl) (mapc #'(lambda (vty) (let ((sty (q-mk_antiquot (cdr vty)))) (putprop (car vty) sty 'stickytype) #+franz (putprop %sticky-types sty (car vty)) #-franz (setf (getf %sticky-types (car vty)) sty))) styl)) ; set-sticky ;;; Apply sticky types to those variables whose type is still undefined ;;; In previous LCF, the sticky type was always used, requiring a hack ;;; in MK=TYPED to override it. (defun use-sticky () (mapc #'(lambda (vty) (let ((v (car vty)) (ty (hol-trunc (cdr vty)))) (if (eq (car ty) '%LINK) (rplacd ty (get v 'stickytype))))) %vtyl)) ; use-sticky ;;; Map canon-ty over all types of a formula (or term). ;;; Nodes from antiquotations are already in proper form. ;;; Retain sticky types of variables (but don't set yet) (defun canon-quot-fm (fm) (case (form-class fm) (%ANTIQUOT (cdr fm)) (pred (make-pred-form (get-pred-sym fm) (canon-quot-tm (get-pred-arg fm)))) ((conj disj imp) ; iff deleted [TFM 90.01.20] (make-conn-form (get-conn fm) (canon-quot-fm (get-left-form fm)) (canon-quot-fm (get-right-form fm)))) ((forall exists) (make-quant-form (get-quant fm) (canon-quot-tm (get-quant-var fm)) (canon-quot-fm (get-quant-body fm)))) (t (canon-quot-tm fm)) )) ;canon-quot-fm ;;; MJCG 2/12/88 for HOL88 ;;; Make %term a special variable useable for error messages. ;;; for terms only. (defun canon-quot-tm (%term) (case (term-class %term) (%ANTIQUOT (cdr %term)) (comb (make-comb (canon-quot-tm (get-rator %term)) (canon-quot-tm (get-rand %term)) (canon-ty (get-type %term)))) (abs (make-abs (canon-quot-tm (get-abs-var %term)) (canon-quot-tm (get-abs-body %term)) (canon-ty (get-type %term)))) (var (let ((tok (get-var-name %term)) (ty (canon-ty(get-type %term)))) (push (cons tok ty) %stickylist) (mk_realvar tok ty))) (const (ml-mk_const (get-const-name %term) (canon-ty(get-type %term)))) (t (lcferror 'canon-quot-tm)) )) ;canon-quot-tm ;;; MJCG 1/12/88 for HOL88 ;;; Function for printing types indeterminate error messages (defun print-indeterminate-error (tm) (prog (save-flag) (setq save-flag |%show_types-flag|) (setq |%show_types-flag| t) (ptoken "Indeterminate types:") (pbreak 2 4) (ml-print_term(prep-term-for-print tm)) (pnewline) (pnewline) (setq |%show_types-flag| save-flag))) ;;; Strip all links from a type, complain if any are still undefined. ;;; To prevent expanding the DAG of links into a tree (which is exponential), ;;; retain before/after pairs of types in %canonlist ;;; Types beginning with %ANTIQUOT are already in canonical form. ;;; MJCG 1/12/88 for HOL88 ;;; Printer of error message added ;;; (defun canon-ty (ty) ;;; (cond ((assq1 ty %canonlist)) ;;; ((case (type-class ty) ;;; (%ANTIQUOT (cdr ty)) ;;; (%LINK (if (atom (cdr ty)) ;;; (prog2 (if |%type_error-flag| ;;; (print-indeterminate-error %term)) ;;; (throw-from evaluation "types indeterminate")) ;;; (canon-ty (cdr ty)))) ;;; (%VARTYPE ty) ;;; (t (let ((cty (make-type (get-type-op ty) ;;; (mapcar #'canon-ty (get-type-args ty))))) ;;; (if (get-type-args ty) (push (cons ty cty) %canonlist)) ;;; cty))))) ;;; ) ; canon-ty ;;; Optimized version from David Shepherd ;;; (optimization only works for Common Lisp) ;;; [DES] 9may91 ;;; for lists push sticks 1 element on %canonlist for *each* list ;;; element even though all are identical which causes problems with ;;; list search funs like assq1 later! ;;; pushnew with equality test fast-list-equal only puts distinct ;;; elements on the list ! ;;; ;;; (defun canon-ty (ty) ;;; (cond ((assq1 ty %canonlist)) ;;; ((case (type-class ty) ;;; (%ANTIQUOT (cdr ty)) ;;; (%LINK (if (atom (cdr ty)) ;;; (prog2 (if |%type_error-flag| ;;; (print-indeterminate-error %term)) ;;; (throw-from evaluation "types indeterminate")) ;;; (canon-ty (cdr ty)))) ;;; (%VARTYPE ty) ;;; (t (let ((cty (make-type (get-type-op ty) ;;; (mapcar #'canon-ty (get-type-args ty))))) ;;; (if (get-type-args ty) ;;; #+franz (push (cons ty cty) %canonlist) ;;; #-franz (pushnew (cons ty cty) %canonlist :test 'fast-list-equal) ;;; ) ;;; cty))))) ;;; ) ; canon-ty ;;; Another optimized version from David Shepherd ;;; ;;; the problem is that %canonlist introduces more complexity than it ;;; reduces. without it canon-izing a given type takes o(n) where n is the ;;; number of nodes in the type. if we save this in %canonlist then we also ;;; potentially have we have o(n) comparisons on each element of %canonlust ;;; to see if its there already and if it isn't something similar to put it ;;; into the list. ;;; ;;; i.e. the benefit (in number of calls) of not recursing down a type and ;;; getting the result out of %canonlist is similar to the number of extra ;;; calls used in checking the type against the keys in %canonlist in ;;; assq1. Since canon-ty does very little on each node then this call ;;; count is equivalent to speed. ;;; ;;; hence replace canon-ty with following code. ;;; ;;; on the term i was infuriated with it has reduced its retrieval from ;;; 120s to 3s and the maximum call count to 280,000 :-) ;;; the original version (before my mod of 9may91) took 350s and had a ;;; maximum call count of 120 million calls to EQL ! ;;; naturally this fix will apply to all versions of lisp. ;;; ;;; [Installed by TFM, Feb 8 1992 for version 2.01] (defun canon-ty (ty) (case (type-class ty) (%ANTIQUOT (cdr ty)) (%LINK (if (atom (cdr ty)) (prog2 (if |%type_error-flag| (print-indeterminate-error %term)) (throw-from evaluation "types indeterminate")) (canon-ty (cdr ty)))) (%VARTYPE ty) (t (make-type (get-type-op ty) (mapcar #'canon-ty (get-type-args ty)))) ) ) ; canon-ty ;;; Convert all type variables to type links (defun omutant (ty) (let ((%tyvars nil)) (omutant1 ty))) ;omutant (defun omutant1 (ty) (if (is-vartype ty) (or (assq1 ty %tyvars) (let ((newty (genlink))) (push (cons ty newty) %tyvars) newty)) (make-type (get-type-op ty) (mapcar #'omutant1 (get-type-args ty))) )) ;omutant1 ;;; Functions called in ML object code ;;; Report errors found during evaluation of a quotation ;;; x is either a failure token or a list containing the quotation (defun qtrap (x) (if (atom x) (throw-from evaluation (catenate x " in quotation")) (car x)) ) ;qtrap ;;; clean up a quotation ;;; if quotation is OK then sets sticky types and returns a singleton list. ;;; MJCG 13/11/88 for HOL88 ;;; stop sticktypes from being set if |%sticky-flag| is nil ;;; %sticky-types is a disembodied property list holding the sticky types ;;; of variables (setq |%sticky-flag| nil) (setq %sticky-types #+franz '(sticky-types) #-franz nil) (defun quotation (qob) (use-sticky) (let ((%stickylist nil) (%canonlist nil)) (prog1 (list (canon-quot-fm qob)) (if |%sticky-flag| (set-sticky %stickylist)) )) ) ; quotation ;;; MJCG 13/11/88 for HOL88 ;;; ML functions for setting and removing sticky types (defun ml-set_sticky_type (var ty) (let ((sty (q-mk_antiquot ty))) (putprop var sty 'stickytype) #+franz (putprop %sticky-types sty var) #-franz (setf (getf %sticky-types var) sty) nil)) (dml |set_sticky_type| 2 ml-set_sticky_type ((|string| |#| |type|) |->| |void|)) (defun ml-remove_sticky_type (var) (let ((ty (get var 'stickytype))) (if ty (prog1 (cdr ty) (remprop var 'stickytype) #+franz (remprop %sticky-types var) #-franz (remf %sticky-types var)) (failwith '|remove_sticky_type|)))) (dml |remove_sticky_type| 1 ml-remove_sticky_type (|string| |->| |type|)) ;;; Get list of sticky-types (defun ml-sticky_list () (prog (temp res) (setq temp #+franz (cdr %sticky-types) #-franz %sticky-types) (setq res nil) loop (if (null temp) (return res)) (setq res (cons (cons (car temp) (cdadr temp)) res)) (setq temp (cddr temp)) (go loop))) (dml |sticky_list| 0 ml-sticky_list (|void| -> ((|string| |#| |type|) |list|))) ;;; Switch old stickytypes on ;;;(defun ml-sticky_types (x) ;;; (prog1 |%sticky-flag| (setq |%sticky-flag| x))) ;;;(dml |sticky_types| ;;; 1 ;;; ml-sticky_types ;;; (|bool| -> |bool|)) ;;; Convert a preterm to a term (defun eval-preterm (pt) (case (car pt) (|preterm_var| (q-mk_var (cdr pt))) (|preterm_const| (q-mk_const (cdr pt))) (|preterm_comb| (q-mk_comb (eval-preterm(cadr pt)) (eval-preterm(cddr pt)))) (|preterm_abs| (q-mk_abs (eval-preterm(cadr pt)) (eval-preterm(cddr pt)))) (|preterm_typed| (q-mk_typed (eval-preterm(cadr pt)) (cddr pt))) (|preterm_antiquot| (q-mk_antiquot (cdr pt))) (t (failwith '|preterm_to_term|)))) (defun ml-preterm_to_term (pt) (let ((%vtyl nil)(%sharetypes nil)) (car (quotation (eval-preterm pt))))) (dml |preterm_to_term| 1 ml-preterm_to_term (|preterm| |->| |term|)) hol88-2.02.19940316/ml/0000750000212700021270000000000005541570663012346 5ustar cammcammhol88-2.02.19940316/ml/drul.ml0000640000212700021270000011330105521007545013636 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: drul.ml % % % % DESCRIPTION: This file contains what used to be in drul.ml and % % pplemmas.ml % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-rule.ml, hol-drule.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also depends on hol-rule.ml, and hol-drule.ml % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`);; % Generalise a theorem over all variables free in conclusion but not in hyps A |- t[x1,...,xn] ---------------------------- A |- !x1...xn.t[x1,...,xn] % let GEN_ALL th = itlist GEN (subtract (frees(concl th)) (freesl (hyp th))) th;; % Discharge all hypotheses A, t1, ... , tn |- t ------------------------------- A |- t1 ==> ... ==> tn ==> t You can write a simpler version using "itlist DISCH (hyp th) th", but this may discharge two equivalent (alpha-convertible) assumptions. % letrec DISCH_ALL th = DISCH_ALL (DISCH (hd (hyp th)) th) ? th;; % |- !x. t ----> x', |- t[x'/x] % let SPEC_VAR th = let bv,() = dest_forall (concl th) in let bv' = variant (freesl (hyp th)) bv in bv', SPEC bv' th;; % A |- t1 ==> ... ==> tn ==> t ------------------------------- A, t1, ..., tn |- t % letrec UNDISCH_ALL th = if is_imp (concl th) then UNDISCH_ALL (UNDISCH th) else th;; % --------------------------------------------------------------------- % % SPEC_ALL : thm -> thm % % % % A |- !x1 ... xn. t[xi] % % ------------------------ where the xi' are distinct % % A |- t[xi'/xi] and not free in the input theorem % % % % BUGFIX: added the "distinct" part and code to make the xi's not free % % in the conclusion !x1...xn.t[xi]. [TFM 90.10.04] % % % % OLD CODE: % % % % let SPEC_ALL th = % % let vars,() = strip_forall(concl th) in % % SPECL (map (variant (freesl (hyp th))) vars) th;; % % --------------------------------------------------------------------- % let SPEC_ALL = let f v (vs,l) = let v' = variant vs v in (v'.vs,v'.l) in \th. let hvs,con = (freesl # I) (dest_thm th) in let fvs = frees con and vars = fst(strip_forall con) in SPECL (snd(itlist f vars (hvs @ fvs,[]))) th;; % Use the conclusion of ath to delete a hypothesis of bth A |- t1 B, t1 |- t2 ----------------------- A u B |- t2 % let PROVE_HYP ath bth = MP (DISCH (concl ath) bth) ath;; % --------------------------------------------------------------------- % % A |- t1/\t2 ---> A |- t1, A |- t2 % % New failure string added. [TFM 90.05.06] % % --------------------------------------------------------------------- % let CONJ_PAIR th = (CONJUNCT1 th, CONJUNCT2 th) ? failwith `CONJ_PAIR: input thm not a conjunction`;; % ["A1|-t1"; ...; "An|-tn"] ---> "A1u...uAn|-t1 /\ ... /\ tn", where n>0 % let LIST_CONJ = end_itlist CONJ ;; % "A |- t1 /\ (...(... /\ tn)...)" ---> [ "A|-t1"; ...; "A|-tn"], where n>0 Inverse of LIST_CONJ : flattens only right conjuncts. You must specify n, since tn could itself be a conjunction % letrec CONJ_LIST n th = if n=1 then [th] else CONJUNCT1 th . (CONJ_LIST (n-1) (CONJUNCT2 th)) ? failwith `CONJ_LIST`;; % --------------------------------------------------------------------- % % CONJUNCTS: % % % % "A |- t1 /\ ... /\ tn" ---> [ "A|-t1"; ...; "A|-tn"], where n>0 % % % % Flattens out all conjuncts, regardless of grouping % % --------------------------------------------------------------------- % letrec CONJUNCTS th = (CONJUNCTS (CONJUNCT1 th) @ CONJUNCTS(CONJUNCT2 th)) ? [th];; % "|- !x. (t1 /\ ...) /\ ... (!y. ... /\ tn)" ---> [ "|-t1"; ...; "|-tn"], where n>0 Flattens out conjuncts even in bodies of forall's % letrec BODY_CONJUNCTS th = if is_forall (concl th) then BODY_CONJUNCTS (SPEC_ALL th) if is_conj (concl th) then BODY_CONJUNCTS (CONJUNCT1 th) @ BODY_CONJUNCTS (CONJUNCT2 th) else [th];; % --------------------------------------------------------------------- % % IMP_CANON Puts a theorem % % % % |- !x. t1 ==> !y. t2 ==> ... ==> tm ==> t % % % % into canonical form by stripping out quantifiers and splitting % % conjunctions apart. % % % % t1 /\ t2 ---> t1, t2 % % (t1/\t2)==>t ---> t1==> (t2==>t) % % (t1\/t2)==>t ---> t1==>t, t2==>t % % (?x.t1)==>t2 ---> t1[x'/x] ==> t2 % % !x.t1 ---> t1[x'/x] % % (?x.t1)==>t2 ---> t1[x'/x] ==> t2) % % % % --------------------------------------------------------------------- % letrec IMP_CANON th = let w = concl th in if is_conj w then IMP_CANON (CONJUNCT1 th) @ IMP_CANON (CONJUNCT2 th) else if is_imp w then let ante,conc = dest_neg_imp w in if is_conj ante then let a,b = dest_conj ante in IMP_CANON (DISCH a (DISCH b (NOT_MP th (CONJ (ASSUME a) (ASSUME b))))) else if is_disj ante then let a,b = dest_disj ante in IMP_CANON (DISCH a (NOT_MP th (DISJ1 (ASSUME a) b))) @ IMP_CANON (DISCH b (NOT_MP th (DISJ2 a (ASSUME b)))) else if is_exists ante then let x,body = dest_exists ante in let x' = variant (thm_frees th) x in let body' = subst [x',x] body in IMP_CANON (DISCH body' (NOT_MP th (EXISTS (ante, x') (ASSUME body')))) else map (DISCH ante) (IMP_CANON (UNDISCH th)) else if is_forall w then IMP_CANON (SPEC_ALL th) else [th];; % A1 |- t1 ... An |- tn A |- t1==>...==>tn==>t ----------------------------------------------------- A u A1 u ... u An |- t % let LIST_MP = rev_itlist (\x y.MP y x) ;; % A |-t1 ==> t2 ----------------- A |- ~t2 ==> ~t1 (Rewritten by MJCG to return "~t2 ==> ~t1" rather than "~t2 ==> t1 ==>F") % let CONTRAPOS impth = (let a,b = dest_imp (concl impth) in let notb = "~ ^b" in DISCH notb (EQ_MP (el 5 (CONJUNCTS (SPEC a IMP_CLAUSES))) (DISCH a (NOT_MP (ASSUME notb) (MP impth (ASSUME a))))) ) ? failwith `CONTRAPOS`;; % A |- t1 \/ t2 -------------------- A |- ~ t1 ==> t2 % let DISJ_IMP dth = (let a,b = dest_disj (concl dth) in let nota = "~ ^a" in DISCH nota (DISJ_CASES dth (CONTR b (NOT_MP (ASSUME nota) (ASSUME a))) (ASSUME b)) ) ? failwith `DISJ_IMP`;; % A |- t1 ==> t2 --------------- A |- ~t1 \/ t2 % let IMP_ELIM th = (let t1,t2 = dest_imp (snd (dest_thm th)) in DISJ_CASES (SPEC t1 EXCLUDED_MIDDLE) (DISJ2 "~^t1" (MP th (ASSUME t1))) (DISJ1 (ASSUME "~^t1") t2) ) ? failwith `IMP_ELIM`;; % --------------------------------------------------------------------- % % NOT_CLAUSES = |- (~~t = t) /\ (~T = F) /\ (~F = T) % % --------------------------------------------------------------------- % let NOT_CLAUSES = (CONJ (GEN "t:bool" (IMP_ANTISYM_RULE (DISJ_IMP(IMP_ELIM(DISCH "t:bool" (ASSUME "t:bool")))) (DISCH "t:bool" (NOT_INTRO(DISCH "~t" (UNDISCH (NOT_ELIM(ASSUME "~t")))))))) (CONJ (IMP_ANTISYM_RULE (DISCH "~T" (MP (MP (SPEC "T" F_IMP) (ASSUME "~T")) TRUTH)) (SPEC "~T" FALSITY)) (IMP_ANTISYM_RULE (DISCH "~F" TRUTH) (DISCH "T" (MP (SPEC "F" IMP_F) (SPEC "F" FALSITY))))));; % --------------------------------------------------------------------- % % A |- t1 \/ t2 A1, t1 |- t3 A2, t2 |- t4 % % ------------------------------------------------ % % A u A1 u A2 |- t3 \/ t4 % % --------------------------------------------------------------------- % let DISJ_CASES_UNION dth ath bth = DISJ_CASES dth (DISJ1 ath (concl bth)) (DISJ2 (concl ath) bth);; % --------------------------------------------------------------------- % % FORWARD CHAINING: (from LCF) [TFM 90.04.24] % % % % deleted until found useful and properly reimplemented for HOL. % % % % Forward chain using an inference rule on top-level sub-parts of a % % theorem. Could be extended to handle other connectives % % % % let SUB_CHAIN rule th = % % let w = concl th in % % if is_conj w then % % CONJ (rule(CONJUNCT1 th)) (rule(CONJUNCT2 th)) % % else if is_disj w then % % let a,b = dest_disj w in % % DISJ_CASES_UNION th (rule (ASSUME a)) (rule (ASSUME b)) % % else if is_imp w then % % let a,b = dest_imp w in % % DISCH a (rule (UNDISCH th)) % % else if is_forall w then % % let x', sth = SPEC_VAR th in % % GEN x' (rule sth) % % else th;; % % % % Repeatedly apply the rule (looping if it never fails) % % % % letrec REDEPTH_CHAIN rule x = % % (SUB_CHAIN (REDEPTH_CHAIN rule) thenf % % ((rule thenf (REDEPTH_CHAIN rule)) orelsef I)) % % x;; % % % % Apply the rule no more than once in any one place % % % %letrec ONCE_DEPTH_CHAIN rule x = % % (rule orelsef SUB_CHAIN (ONCE_DEPTH_CHAIN rule)) % % x;; % % % % DSPEC : Specialize a theorem whose quantifiers are buried inside % % % % let DSPEC x = ONCE_DEPTH_CHAIN (SPEC x);; % % let DSPECL = rev_itlist DSPEC;; % % % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % let CLOSE_UP = GEN_ALL o DISCH_ALL;; % % let save_thm (name, th) = save_open_thm (name, CLOSE_UP th);; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % EQ_REFL: |- !x. x=x % % --------------------------------------------------------------------- % let EQ_REFL = GEN "x:*" (REFL "x:*");; % --------------------------------------------------------------------- % % REFL_CLAUSE |- !x. (x=x) = T % % --------------------------------------------------------------------- % let REFL_CLAUSE = GEN "x:*" (EQT_INTRO(SPEC "x:*" EQ_REFL));; % --------------------------------------------------------------------- % % EQ_SYM : |- !x y. x=y ==> y=x % % --------------------------------------------------------------------- % let EQ_SYM = GEN "x:*" (GEN "y:*" (DISCH "x:* = y:*" (SYM(ASSUME "x:* = y:*"))));; % --------------------------------------------------------------------- % % EQ_SYM_EQ: |- !x y. (x = y) = (y = x) % % --------------------------------------------------------------------- % let EQ_SYM_EQ = GEN "x:*" (GEN "y:*" (IMP_ANTISYM_RULE (SPEC "y:*" (SPEC "x:*" EQ_SYM)) (SPEC "x:*" (SPEC "y:*" EQ_SYM))));; % --------------------------------------------------------------------- % % |- !f g. (!x. f x = g x) ==> f=g % % --------------------------------------------------------------------- % let EQ_EXT = let f = "f: * -> **" and g = "g: * -> **" and t = "!x:*. (f:*->**) (x:*) = (g:*->**) (x:*)" in GEN f (GEN g (DISCH t (EXT(ASSUME t))));; % --------------------------------------------------------------------- % % EQ_TRANS |- !x y z. x=y /\ y=z ==> x=z % % --------------------------------------------------------------------- % let EQ_TRANS = let x,y,z = "x:*","y:*","z:*" and xyyz = "(x:*=y:*) /\ (y:*=z:*)" in GEN x (GEN y (GEN z (DISCH xyyz (CONJUNCT1(ASSUME xyyz) TRANS (CONJUNCT2(ASSUME xyyz)))))) ;; % --------------------------------------------------------------------- % % BOOL_EQ_DISTINCT |- ~(T=F) /\ ~(F=T) % % --------------------------------------------------------------------- % let BOOL_EQ_DISTINCT = CONJ (NOT_INTRO(DISCH "T=F" (EQ_MP (ASSUME "T=F") TRUTH))) (NOT_INTRO(DISCH "F=T" (EQ_MP (SYM(ASSUME "F=T")) TRUTH)));; % --------------------------------------------------------------------- % % EQ_CLAUSES: proof rewritten to make clauses 1-4 local % % % % |- !t. (T = t) = t /\ % % (t = T) = t /\ % % (F = t) = ~t /\ % % (t = F) = ~t TFM 90.04.20 % % --------------------------------------------------------------------- % let EQ_CLAUSES = let t = "t:bool" in let cl1 = % (T = t) = t % let th1 = DISCH "T = ^t" (EQ_MP (ASSUME "T = ^t") TRUTH) and th2 = DISCH t (SYM(EQT_INTRO(ASSUME t))) in (IMP_ANTISYM_RULE th1 th2) and cl2 = % (t = T) = t % let th1 = DISCH "^t = T" (EQ_MP (SYM (ASSUME "^t = T")) TRUTH) and th2 = DISCH t (EQT_INTRO(ASSUME t)) in (IMP_ANTISYM_RULE th1 th2) and cl3 = % (F = t) = ~t % let th1 = DISCH "F = ^t" (MP (SPEC t IMP_F) (DISCH t (EQ_MP(SYM(ASSUME "F = ^t"))(ASSUME t)))) and th2 = IMP_TRANS (SPEC t NOT_F) (DISCH "^t = F" (SYM(ASSUME "^t = F"))) in (IMP_ANTISYM_RULE th1 th2) and cl4 = % (t = F) = ~t % let th1 = DISCH "^t = F" (MP (SPEC t IMP_F) (DISCH t (EQ_MP(ASSUME "^t = F")(ASSUME t)))) and th2 = SPEC t NOT_F in (IMP_ANTISYM_RULE th1 th2) in GEN t (end_itlist CONJ [cl1;cl2;cl3;cl4]);; % --------------------------------------------------------------------- % % MK_COMB: % % % % A1 |- f = g , A2 |- x = y % % --------------------------- % % A1 u A2 |- f x = g y % % % %< let MK_COMB (funth,argth) = (let f = lhs (concl funth) and x = lhs (concl argth) in SUBS_OCCS [([2], funth); ([2], argth)] (REFL (mk_comb(f,x)))) ? failwith `MK_COMB`;; >% % --------------------------------------------------------------------- % let MK_COMB (funth,argth) = (let f,g = dest_eq (concl funth) and x,y = dest_eq (concl argth) in (RecordStep(MkCombStep(funth,argth)); mk_thm(union (hyp funth) (hyp argth), mk_eq(mk_comb(f,x),mk_comb(g,y)))) ) ? failwith `MK_COMB`;; % A |- !x. (t1 = t2) ---------------------- A |- (\x.t1) = (\x.t2) let MK_ABS qth = (let x,body = dest_forall (concl qth) in let ufun = mk_abs(x, lhs body) and vfun = mk_abs(x, rhs body) in let gv = genvar (type_of x) in EXT (GEN gv ((BETA_CONV (mk_comb(ufun,gv))) TRANS (SPEC gv qth) TRANS (SYM (BETA_CONV (mk_comb(vfun,gv))))))) ? failwith `MK_ABS`;; % let MK_ABS th = (let x,(t1,t2) = ((I # dest_eq) o dest_forall o concl) th in (RecordStep(MkAbsStep th); mk_thm(hyp th, mk_eq(mk_abs(x,t1),mk_abs(x,t2)))) ) ? failwith `MK_ABS`;; % A |- !x. t1 x = t2 ------------------ A |- t1 = \x.t2 % let HALF_MK_ABS qth = (let x,body = dest_forall (concl qth) in let t = rhs body and gv = genvar (type_of x) in let tfun = mk_abs(x,t) in EXT (GEN gv % |- !gv. u gv =< (\x.t) gv % ((SPEC gv qth) TRANS (SYM (BETA_CONV (mk_comb(tfun,gv))))))) ? failwith `HALF_MK_ABS`;; % --------------------------------------------------------------------- % % ALPHA_CONV: Rename the bound variable of a lambda-abstraction % % % % ALPHA_CONV "x" "(\y.t)" ---> |- "\y.t = \x. t[x/y]" % % % % OLD VERSION: % % % % let ALPHA_CONV x t = % % (let x' = variant (frees t) x in % % HALF_MK_ABS (GEN x'(BETA_CONV(mk_comb(t,x'))))) % % ? failwith `ALPHA_CONV`;; % % % % replaced in version 1.12 by an optimized proof. [TFM 90.06.12] % % --------------------------------------------------------------------- % let ALPHA_CONV x t = (let x' = variant (frees t) x in let cmb = mk_comb(t,x') in let th1 = SYM(ETA_CONV(mk_abs(x',cmb))) and th2 = ABS x' (BETA_CONV cmb) in TRANS th1 th2) ? failwith `ALPHA_CONV`;; % Equivalence of alpha-convertable terms t1, t2 alpha-convertable ------------------------- |- t1 = t2 letrec ALPHA t1 t2 = (if t1=t2 then REFL t1 if is_comb t1 & is_comb t2 then (let t11,t12 = dest_comb t1 and t21,t22 = dest_comb t2 in let th1 = ALPHA t11 t21 and th2 = ALPHA t12 t22 in (AP_THM th1 t12) TRANS (AP_TERM t21 th2)) if is_abs t1 & is_abs t2 then (let x1,() = dest_abs t1 and x2,t2' = dest_abs t2 in let th1 = ALPHA_CONV x2 t1 in let (),t1' = dest_abs(rhs(concl th1)) in let th2 = ALPHA t1' t2' in th1 TRANS (ABS x2 th2)) else fail ) ? failwith `ALPHA`;; % let ALPHA t1 t2 = if aconv t1 t2 then (RecordStep(AlphaStep(t1,t2)); mk_thm([],mk_eq(t1,t2))) else failwith `ALPHA`;; % --------------------------------------------------------------------- % % GEN_ALPHA_CONV: rename bound variables % % % % "x" "(\y.t)" ---> |- "\y.t = \x. t[x/y]" % % "x" "(!y.t)" ---> |- "!y.t = !x. t[x/y]" % % "x" "(?y.t)" ---> |- "?y.t = ?x. t[x/y]" % % "x" "(@y.t)" ---> |- "@y.t = @x. t[x/y]" % % "x" "(?!y.t)" ---> |- "?!y.t = ?!x. t[x/y]" % % % % REVISED: to also deal with ?! quantifier. [TFM 91.02.24] % % % % Revised to work with any term of the form "B \x.M", where B is a % % binder constant (according to is_binder). [TFM 92.03.09] % % --------------------------------------------------------------------- % let GEN_ALPHA_CONV = let check = assert (is_binder o fst o dest_const) in \x t. if (is_abs t) then ALPHA_CONV x t else (let (c,body) = (check # I) (dest_comb t) in AP_TERM c (ALPHA_CONV x body)) ? failwith `GEN_ALPHA_CONV`;; % --------------------------------------------------------------------- % % COND_CLAUSES: proof rewritten to make clauses 1 and 2 local % % % % |- !t1:*.!t2:*. ((T => t1 | t2) = t1) /\ ((F => t1 | t2) = t2) % % % % TFM 90.04.20 % % --------------------------------------------------------------------- % let COND_CLAUSES = let x,t1,t2,v = "x:*","t1:*","t2:*",genvar":bool" in let cl1 = let th0 = RIGHT_BETA(AP_THM COND_DEF "T") in let th1 = RIGHT_BETA(AP_THM th0 t1) in let th2 = RIGHT_BETA(AP_THM th1 t2) in let TT = EQT_INTRO(REFL "T") in let th3= SUBST[SYM TT,v] "(^v ==> (^x=^t1))=(^x=^t1)" (CONJUNCT1 (SPEC "^x=^t1" IMP_CLAUSES)) and th4 = DISCH "T=F" (MP (SPEC "^x=^t2" FALSITY) (UNDISCH (MP (SPEC "T=F" F_IMP) (CONJUNCT1 BOOL_EQ_DISTINCT)))) in let th5 = DISCH "^x=^t1" (CONJ(EQ_MP(SYM th3)(ASSUME "^x=^t1"))th4) and th6 = DISCH "((T=T) ==> (^x=^t1))/\((T=F) ==> (^x=^t2))" (MP (CONJUNCT1 (ASSUME "((T=T) ==> (^x=^t1))/\((T=F) ==> (^x=^t2))")) (REFL "T")) in let th7 = MP (MP (SPEC "((T=T) ==> (^x=^t1))/\((T=F) ==> (^x=^t2))" (SPEC "^x=^t1" IMP_ANTISYM_AX)) th5) th6 in let th8 = TRANS th2 (SYM(SELECT_EQ x th7)) in let th9 = EQ_MP (SYM(BETA_CONV "(\^x.^x = ^t1) ^t1")) (REFL t1) in let th10 = MP (SPEC t1 (SPEC "\^x.^x = ^t1" SELECT_AX)) th9 in (TRANS th8 (EQ_MP (BETA_CONV(concl th10)) th10)) and cl2 = let th0 = RIGHT_BETA(AP_THM COND_DEF "F") in let th1 = RIGHT_BETA(AP_THM th0 t1) in let th2 = RIGHT_BETA(AP_THM th1 t2) in let FF = EQT_INTRO(REFL "F") in let th3 = SUBST[SYM FF,v] "(^v ==> (^x=^t2))=(^x=^t2)" (CONJUNCT1 (SPEC "^x=^t2" IMP_CLAUSES)) and th4 = DISCH "F=T" (MP (SPEC "^x=^t1" FALSITY) (UNDISCH(MP (SPEC "F=T" F_IMP) (CONJUNCT2 BOOL_EQ_DISTINCT)))) in let th5 = DISCH "^x=^t2" (CONJ th4 (EQ_MP(SYM th3)(ASSUME "^x=^t2"))) and th6 = DISCH "((F=T) ==> (^x=^t1)) /\ ((F=F) ==> (^x=^t2))" (MP (CONJUNCT2(ASSUME "((F=T) ==> (^x=^t1)) /\ ((F=F) ==> (^x=^t2))")) (REFL "F")) in let th7 = MP (MP (SPEC "((F=T) ==> (^x=^t1)) /\ ((F=F) ==> (^x=^t2))" (SPEC "^x=^t2" IMP_ANTISYM_AX)) th5) th6 in let th8 = TRANS th2 (SYM(SELECT_EQ x th7)) in let th9 = EQ_MP (SYM(BETA_CONV "(\^x.^x = ^t2) ^t2")) (REFL t2) in let th10 = MP (SPEC t2 (SPEC "\^x.^x = ^t2" SELECT_AX)) th9 in (TRANS th8 (EQ_MP (BETA_CONV(concl th10)) th10)) in GEN t1 (GEN t2 (CONJ cl1 cl2));; % --------------------------------------------------------------------- % % COND_ID: % % % % |- b. !t:*. (b => t | t) = t % % % % TFM 90.07.23 % % --------------------------------------------------------------------- % let COND_ID = let b = "b:bool" and t = "t:*" in let def = INST_TYPE [":*",":**"] COND_DEF in let th1 = itlist (\x.RIGHT_BETA o (C AP_THM x)) [t;t;b] def in let p = genvar ":bool" in let asm1 = ASSUME ("((^b=T)==>^p) /\ ((^b=F)==>^p)") in let th2 = DISJ_CASES (SPEC b BOOL_CASES_AX) (UNDISCH (CONJUNCT1 asm1)) (UNDISCH (CONJUNCT2 asm1)) in let imp1 = DISCH (concl asm1) th2 in let asm2 = ASSUME p in let imp2 = DISCH p (CONJ (DISCH "^b=T" (ADD_ASSUM "^b=T" asm2)) (DISCH "^b=F" (ADD_ASSUM "^b=F" asm2))) in let lemma = SPEC "x:* = ^t" (GEN p (IMP_ANTISYM_RULE imp1 imp2)) in let th3 = TRANS th1 (SELECT_EQ "x:*" lemma) in let th4 = EQ_MP (SYM(BETA_CONV "(\x.x = ^t) ^t")) (REFL t) in let th5 = MP (SPEC t (SPEC "\x.x = ^t" SELECT_AX)) th4 in let lemma2 = EQ_MP (BETA_CONV(concl th5)) th5 in GEN b (GEN t (TRANS th3 lemma2));; % --------------------------------------------------------------------- % % IMP_CONJ implements the following derived inference rule: % % % % A1 |- P ==> Q A2 |- R ==> S % % --------------------------------- IMP_CONJ % % A1 u A2 |- P /\ R ==> Q /\ S % % --------------------------------------------------------------------- % let IMP_CONJ th1 th2 = let A1,C1 = dest_imp (concl th1) and A2,C2 = dest_imp (concl th2) in let a1,a2 = CONJ_PAIR (ASSUME (mk_conj(A1,A2))) in DISCH (mk_conj(A1,A2)) (CONJ (MP th1 a1) (MP th2 a2));; % --------------------------------------------------------------------- % % EXISTS_IMP : existentially quantify the antecedent and conclusion % % of an implication. % % % % A |- P ==> Q % % -------------------------- EXISTS_IMP "x" % % A |- (?x.P) ==> (?x.Q) % % % % --------------------------------------------------------------------- % let EXISTS_IMP x = if (not (is_var x)) then failwith `EXISTS_IMP: first argument not a variable` else \th. let ante,cncl = dest_imp(concl th) in let th1 = EXISTS (mk_exists(x,cncl),x) (UNDISCH th) in let asm = mk_exists(x,ante) in DISCH asm (CHOOSE (x,ASSUME asm) th1) ? failwith `EXISTS_IMP: variable free in assumptions`;; % ------------------------------------------------------------------------- % % Distributive laws: % % % % LEFT_AND_OVER_OR |- !t1 t2 t3. t1 /\ (t2 \/ t3) = t1 /\ t2 \/ t1 /\ t3 % % % % RIGHT_AND_OVER_OR |- !t1 t2 t3. (t2 \/ t3) /\ t1 = t2 /\ t1 \/ t3 /\ t1 % % % % LEFT_OR_OVER_AND |- !t1 t2 t3. t1 \/ t2 /\ t3 = (t1 \/ t2) /\ (t1 \/ t3) % % % % RIGHT_OR_OVER_AND |- !t1 t2 t3. t2 /\ t3 \/ t1 = (t2 \/ t1) /\ (t3 \/ t1) % % ------------------------------------------------------------------------- % let LEFT_AND_OVER_OR = let t1 = "t1:bool" and t2 = "t2:bool" and t3 = "t3:bool" in let th1,th2 = CONJ_PAIR(ASSUME (mk_conj(t1,mk_disj(t2,t3)))) in let th3 = CONJ th1 (ASSUME t2) and th4 = CONJ th1 (ASSUME t3) in let th5 = DISJ_CASES_UNION th2 th3 th4 in let imp1 = DISCH (mk_conj(t1,mk_disj(t2,t3))) th5 in let th1,th2 = (I # C DISJ1 t3) (CONJ_PAIR (ASSUME (mk_conj(t1,t2)))) in let th3,th4 = (I # DISJ2 t2) (CONJ_PAIR (ASSUME (mk_conj(t1,t3)))) in let th5 = CONJ th1 th2 and th6 = CONJ th3 th4 in let th6 = DISJ_CASES (ASSUME (rand(concl imp1))) th5 th6 in let imp2 = DISCH (rand(concl imp1)) th6 in GEN t1 (GEN t2 (GEN t3 (IMP_ANTISYM_RULE imp1 imp2)));; let RIGHT_AND_OVER_OR = let t1 = "t1:bool" and t2 = "t2:bool" and t3 = "t3:bool" in let th1,th2 = CONJ_PAIR(ASSUME (mk_conj(mk_disj(t2,t3),t1))) in let th3 = CONJ (ASSUME t2) th2 and th4 = CONJ (ASSUME t3) th2 in let th5 = DISJ_CASES_UNION th1 th3 th4 in let imp1 = DISCH (mk_conj(mk_disj(t2,t3),t1)) th5 in let th1,th2 = (C DISJ1 t3 # I) (CONJ_PAIR (ASSUME (mk_conj(t2,t1)))) in let th3,th4 = (DISJ2 t2 # I) (CONJ_PAIR (ASSUME (mk_conj(t3,t1)))) in let th5 = CONJ th1 th2 and th6 = CONJ th3 th4 in let th6 = DISJ_CASES (ASSUME (rand(concl imp1))) th5 th6 in let imp2 = DISCH (rand(concl imp1)) th6 in GEN t1 (GEN t2 (GEN t3 (IMP_ANTISYM_RULE imp1 imp2)));; let LEFT_OR_OVER_AND = let t1 = "t1:bool" and t2 = "t2:bool" and t3 = "t3:bool" in let th1 = ASSUME (mk_disj(t1,mk_conj(t2,t3))) in let th2 = CONJ (DISJ1 (ASSUME t1) t2) (DISJ1 (ASSUME t1) t3) in let th3,th4 = CONJ_PAIR (ASSUME(mk_conj(t2,t3))) in let th5 = CONJ (DISJ2 t1 th3) (DISJ2 t1 th4) in let imp1 = DISCH (concl th1) (DISJ_CASES th1 th2 th5) in let th1,th2 = CONJ_PAIR (ASSUME (rand(concl imp1))) in let th3 = DISJ1 (ASSUME t1) (mk_conj(t2,t3)) in let th4,th5 = CONJ_PAIR (ASSUME (mk_conj(t2,t3))) in let th4 = DISJ2 t1 (CONJ (ASSUME t2) (ASSUME t3)) in let th5 = DISJ_CASES th2 th3 (DISJ_CASES th1 th3 th4) in let imp2 = DISCH (rand(concl imp1)) th5 in GEN t1 (GEN t2 (GEN t3 (IMP_ANTISYM_RULE imp1 imp2)));; let RIGHT_OR_OVER_AND = let t1 = "t1:bool" and t2 = "t2:bool" and t3 = "t3:bool" in let th1 = ASSUME (mk_disj(mk_conj(t2,t3),t1)) in let th2 = CONJ (DISJ2 t2 (ASSUME t1)) (DISJ2 t3 (ASSUME t1)) in let th3,th4 = CONJ_PAIR (ASSUME(mk_conj(t2,t3))) in let th5 = CONJ (DISJ1 th3 t1) (DISJ1 th4 t1) in let imp1 = DISCH (concl th1) (DISJ_CASES th1 th5 th2) in let th1,th2 = CONJ_PAIR (ASSUME (rand(concl imp1))) in let th3 = DISJ2 (mk_conj(t2,t3)) (ASSUME t1) in let th4,th5 = CONJ_PAIR (ASSUME (mk_conj(t2,t3))) in let th4 = DISJ1 (CONJ (ASSUME t2) (ASSUME t3)) t1 in let th5 = DISJ_CASES th2 (DISJ_CASES th1 th4 th3) th3 in let imp2 = DISCH (rand(concl imp1)) th5 in GEN t1 (GEN t2 (GEN t3 (IMP_ANTISYM_RULE imp1 imp2)));; % --------------------------------------------------------------------- % % IMP_DISJ_THM % % % % |- !t1 t2. t1 ==> t2 = ~t1 \/ t2 % % % % Moved from arithmetic theory RJB 92.09.26 % % --------------------------------------------------------------------- % let IMP_DISJ_THM = let [_;IMP2;_;_;IMP4] = map GEN_ALL (CONJUNCTS (SPEC_ALL IMP_CLAUSES)) and [_;OR2;_;OR4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL OR_CLAUSES)) in let thT1 = (SPEC "t1:bool" IMP2) TRANS (SYM (SPEC "~t1" OR2)) and thF1 = (SPEC "t1:bool" IMP4) TRANS (SYM (SPEC "~t1" OR4)) in let tm = "t1 ==> t2 = ~t1 \/ t2" in let thT2 = SUBST_CONV [(ASSUME "t2 = T","t2:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "t2 = F","t2:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "t2:bool" BOOL_CASES_AX) thT3 thF3);; % --------------------------------------------------------------------- % % IMP_F_EQ_F % % % % |- !t. t ==> F = (t = F) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let IMP_F_EQ_F = GEN_ALL (TRANS (el 5 (CONJUNCTS (SPEC_ALL IMP_CLAUSES))) (SYM (el 4 (CONJUNCTS (SPEC_ALL EQ_CLAUSES)))));; % --------------------------------------------------------------------- % % AND_IMP_INTRO % % % % |- !t1 t2 t3. t1 ==> t2 ==> t3 = t1 /\ t2 ==> t3 % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let AND_IMP_INTRO = let [IMP1;IMP2;IMP3;_;IMP4] = map GEN_ALL (CONJUNCTS (SPEC_ALL IMP_CLAUSES)) and [AND1;AND2;AND3;AND4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) in let thTl = SPEC "t2 ==> t3" IMP1 and thFl = SPEC "t2 ==> t3" IMP3 in let thTr = AP_THM (AP_TERM "$==>" (SPEC "t2:bool" AND1)) "t3:bool" and thFr = TRANS (AP_THM (AP_TERM "$==>" (SPEC "t2:bool" AND3)) "t3:bool") (SPEC "t3:bool" IMP3) in let thT1 = thTl TRANS (SYM thTr) and thF1 = thFl TRANS (SYM thFr) in let tm = "t1 ==> t2 ==> t3 = t1 /\ t2 ==> t3" in let thT2 = SUBST_CONV [(ASSUME "t1 = T","t1:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "t1 = F","t1:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "t1:bool" BOOL_CASES_AX) thT3 thF3);; % --------------------------------------------------------------------- % % EQ_IMP_THM % % % % |- !t1 t2. (t1 = t2) = (t1 ==> t2) /\ (t2 ==> t1) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let EQ_IMP_THM = let [IMP1;IMP2;IMP3;_;IMP4] = map GEN_ALL (CONJUNCTS (SPEC_ALL IMP_CLAUSES)) and [EQ1;EQ2;EQ3;EQ4] = map GEN_ALL (CONJUNCTS (SPEC_ALL EQ_CLAUSES)) and [AND1;AND2;AND3;AND4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) in let thTl = SPEC "t2:bool" EQ1 and thFl = SPEC "t2:bool" EQ3 in let thTr = TRANS (MK_COMB (AP_TERM "$/\" (SPEC "t2:bool" IMP1),SPEC "t2:bool" IMP2)) (SPEC "t2:bool" AND2) and thFr = TRANS (MK_COMB (AP_TERM "$/\" (SPEC "t2:bool" IMP3),SPEC "t2:bool" IMP4)) (SPEC "~t2" AND1) in let thT1 = thTl TRANS (SYM thTr) and thF1 = thFl TRANS (SYM thFr) in let tm = "(t1 = t2) = (t1 ==> t2) /\ (t2 ==> t1)" in let thT2 = SUBST_CONV [(ASSUME "t1 = T","t1:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "t1 = F","t1:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "t1:bool" BOOL_CASES_AX) thT3 thF3);; % --------------------------------------------------------------------- % % EQ_EXPAND % % % % |- !t1 t2. (t1 = t2) = ((t1 /\ t2) \/ (~t1 /\ ~t2)) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let EQ_EXPAND = let [NOT1;NOT2] = tl (CONJUNCTS NOT_CLAUSES) and [EQ1;EQ2;EQ3;EQ4] = map GEN_ALL (CONJUNCTS (SPEC_ALL EQ_CLAUSES)) and [AND1;AND2;AND3;AND4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) and [OR1;OR2;OR3;OR4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL OR_CLAUSES)) in let thTl = SPEC "t2:bool" EQ1 and thFl = SPEC "t2:bool" EQ3 in let thTr = TRANS (MK_COMB (AP_TERM "$\/" (SPEC "t2:bool" AND1), TRANS (AP_THM (AP_TERM "$/\" NOT1) "~t2") (SPEC "~t2" AND3))) (SPEC "t2:bool" OR4) and thFr = TRANS (MK_COMB (AP_TERM "$\/" (SPEC "t2:bool" AND3), TRANS (AP_THM (AP_TERM "$/\" NOT2) "~t2") (SPEC "~t2" AND1))) (SPEC "~t2" OR3) in let thT1 = thTl TRANS (SYM thTr) and thF1 = thFl TRANS (SYM thFr) in let tm = "(t1 = t2) = ((t1 /\ t2) \/ (~t1 /\ ~t2))" in let thT2 = SUBST_CONV [(ASSUME "t1 = T","t1:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "t1 = F","t1:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "t1:bool" BOOL_CASES_AX) thT3 thF3);; % --------------------------------------------------------------------- % % COND_RATOR % % % % |- !b (f:*->**) g x. (b => f | g) x = (b => f x | g x) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let COND_RATOR = let (COND_T,COND_F) = (GEN_ALL # GEN_ALL) (CONJ_PAIR (SPEC_ALL COND_CLAUSES)) in let thTl = AP_THM (ISPECL ["f:*->**";"g:*->**"] COND_T) "x:*" and thFl = AP_THM (ISPECL ["f:*->**";"g:*->**"] COND_F) "x:*" in let thTr = ISPECL ["(f:*->**) x";"(g:*->**) x"] COND_T and thFr = ISPECL ["(f:*->**) x";"(g:*->**) x"] COND_F in let thT1 = thTl TRANS (SYM thTr) and thF1 = thFl TRANS (SYM thFr) in let tm = "(b => (f:*->**) | g) x = (b => f x | g x)" in let thT2 = SUBST_CONV [(ASSUME "b = T","b:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "b = F","b:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "b:bool" BOOL_CASES_AX) thT3 thF3);; % --------------------------------------------------------------------- % % COND_RAND % % % % |- !(f:*->**) b x y. f (b => x | y) = (b => f x | f y) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let COND_RAND = let (COND_T,COND_F) = (GEN_ALL # GEN_ALL) (CONJ_PAIR (SPEC_ALL COND_CLAUSES)) in let thTl = AP_TERM "f:*->**" (ISPECL ["x:*";"y:*"] COND_T) and thFl = AP_TERM "f:*->**" (ISPECL ["x:*";"y:*"] COND_F) in let thTr = ISPECL ["(f:*->**) x";"(f:*->**) y"] COND_T and thFr = ISPECL ["(f:*->**) x";"(f:*->**) y"] COND_F in let thT1 = thTl TRANS (SYM thTr) and thF1 = thFl TRANS (SYM thFr) in let tm = "(f:*->**) (b => x | y) = (b => f x | f y)" in let thT2 = SUBST_CONV [(ASSUME "b = T","b:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "b = F","b:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "b:bool" BOOL_CASES_AX) thT3 thF3);; % --------------------------------------------------------------------- % % COND_ABS % % % % |- !b (f:*->**) g. (\x. (b => f(x) | g(x))) = (b => f | g) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let COND_ABS = let th = SYM (SPECL ["b:bool";"f:*->**";"g:*->**";"x:*"] COND_RATOR) in GEN_ALL ((ABS "x:*" th) TRANS (ETA_CONV "\x. (b => (f:*->**) | g) x"));; % --------------------------------------------------------------------- % % COND_EXPAND % % % % |- !b t1 t2. (b => t1 | t2) = ((~b \/ t1) /\ (b \/ t2)) % % % % RJB 92.09.26 % % --------------------------------------------------------------------- % let COND_EXPAND = let (COND_T,COND_F) = (GEN_ALL # GEN_ALL) (CONJ_PAIR (SPEC_ALL COND_CLAUSES)) and [NOT1;NOT2] = tl (CONJUNCTS NOT_CLAUSES) and [AND1;AND2;AND3;AND4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) and [OR1;OR2;OR3;OR4;_] = map GEN_ALL (CONJUNCTS (SPEC_ALL OR_CLAUSES)) in let thTl = ISPECL ["t1:bool";"t2:bool"] COND_T and thFl = ISPECL ["t1:bool";"t2:bool"] COND_F in let thTr = let th1 = TRANS (AP_THM (AP_TERM "$\/" NOT1) "t1:bool") (SPEC "t1:bool" OR3) and th2 = SPEC "t2:bool" OR1 in TRANS (MK_COMB (AP_TERM "$/\" th1,th2)) (SPEC "t1:bool" AND2) and thFr = let th1 = TRANS (AP_THM (AP_TERM "$\/" NOT2) "t1:bool") (SPEC "t1:bool" OR1) and th2 = SPEC "t2:bool" OR3 in TRANS (MK_COMB (AP_TERM "$/\" th1,th2)) (SPEC "t2:bool" AND1) in let thT1 = thTl TRANS (SYM thTr) and thF1 = thFl TRANS (SYM thFr) in let tm = "(b => t1 | t2) = ((~b \/ t1) /\ (b \/ t2))" in let thT2 = SUBST_CONV [(ASSUME "b = T","b:bool")] tm tm and thF2 = SUBST_CONV [(ASSUME "b = F","b:bool")] tm tm in let thT3 = EQ_MP (SYM thT2) thT1 and thF3 = EQ_MP (SYM thF2) thF1 in GEN_ALL (DISJ_CASES (SPEC "b:bool" BOOL_CASES_AX) thT3 thF3);; hol88-2.02.19940316/ml/gen.ml0000640000212700021270000002660105522522216013445 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: gen.ml % % % % DESCRIPTION: General purpose functions for ML % % % % USES FILES: hol-lcf lisp files, ml-curry.ml, lis.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Use the character "sep" to split the token into non-empty words % % % % words2 `/` `abc//d/ef/` --> [`abc`; `d`; `ef`] % % --------------------------------------------------------------------- % let words2 sep string = snd (itlist (\ch (chs,tokl). if ch = sep then if null chs then [],tokl else [], (implode chs . tokl) else (ch.chs), tokl) (sep . explode string) ([],[]));; % --------------------------------------------------------------------- % % words `are you there` --> [`are`; `you`; `there`] % % --------------------------------------------------------------------- % let words = words2 ` `;; % --------------------------------------------------------------------- % % maptok f `are you there` = [f `are`; f `you`; f `there`] % % --------------------------------------------------------------------- % let maptok f tok = map f (words tok);; % --------------------------------------------------------------------- % % Loading abbreviations. % % % % loadx added by MJCG for HOL88.1.05 on April 6 1989 % % --------------------------------------------------------------------- % let loadt tok = load (tok,true) and loadf tok = load (tok,false);; let compilet tok = compile (tok,true) and compilef tok = compile (tok,false);; % Deleted TFM 90.12.01 % % let loadx tok = load(tok, get_flag_value `print_lib`);; % % --------------------------------------------------------------------- % % Token concatenation % % --------------------------------------------------------------------- % let concat tok1 tok2 = implode(explode tok1 @ explode tok2) ;; let concatl tokl = implode (itlist append (map explode tokl) []);; ml_curried_infix `^`;; let $^ = concat;; let message tok = print_string tok; print_newline();; % --------------------------------------------------------------------- % % combinators, as in Curry & Feys % % CB added: TFM 91.09.13 % % --------------------------------------------------------------------- % ml_paired_infix `o`;; ml_paired_infix `#`;; ml_paired_infix `oo`;; ml_curried_infix `CB`;; let $o(f,g)x = f(g x) ;; let $CB f g x = g(f x) ;; let $# (f,g) (x,y) = (f x, g y);; % --------------------------------------------------------------------- % % Composition for a function that takes a paired argument % % --------------------------------------------------------------------- % let $oo (f,(g,h)) x = f(g x, h x);; let I x = x;; let K x y = x;; let KI = K I;; % Dual of K; K and KI are analogs of fst and snd% let C f x y = f y x % the permutator % and W f x = f x x % the duplicator % and B f g x = f (g x) % the compositor, curried form of "o" % and S f g x = f x (g x);; % --------------------------------------------------------------------- % % S, K, I permit the definition of lambda-abstraction % % \x.x = I actually unnecessary, since I = S K K) % % \x.A = K A where A is a constant or a variable other than x % % \x.(A B) = S (\x.A) (\x.B) % % --------------------------------------------------------------------- % ml_paired_infix `Co`;; let $Co (f,g) x y = f (g y) x;; % permutation-composition % % Ainsi nomme car $Co (f,g) = C (f o g) % let pair x y = (x,y);; let curry f x y = f(x,y);; % --------------------------------------------------------------------- % % sequencing operators for functions [Deleted: TFM 90.09.19] % % % % ml_curried_infix `thenf` ;; % % ml_curried_infix `orelsef` ;; % % % % let thenf f g x = g(f x);; % % let orelsef f g x = f x ? g x;; % % let all_fun x = x;; % % let no_fun x = failwith `no_fun`;; % % let first_fun fl x = % % itlist $orelsef fl no_fun x ? failwith `first_fun`;; % % let every_fun fl x = % % itlist $thenf fl all_fun x ? failwith `first_fun`;; % % letrec repeatf f x = (f thenf (repeatf f) elsef I) x;; % % letrec repeatf f x = (f thenf (repeatf f)) x ? x;; % % % % --------------------------------------------------------------------- % let can f x = (f x ; true) ? false ;; % --------------------------------------------------------------------- % % Check that the value x satisfies the predicate p; if so, pass x on. % % --------------------------------------------------------------------- % let assert p x = if p x then x else fail ;; let syserror tok = print_string `ML system error `; print_string tok; print_newline(); failwith `syserror`;; % --------------------------------------------------------------------- % % Provides a simple backtrace, since it prefixes a token to the previous% % failure token. Warning: this % % (1) slows down failure propagation. % % (2) works only with the innermost lambda of a curried function. % % --------------------------------------------------------------------- % let set_fail_prefix tok ff arg = ff arg ?\tail failwith (concatl [tok; ` -- `; tail]);; % --------------------------------------------------------------------- % % Set a function's failure token % % --------------------------------------------------------------------- % let set_fail tok ff arg = ff arg ? failwith tok;; % --------------------------------------------------------------------- % % f^n (x) = f(f....(f x)) % % Changed to treat -ve arguments as zero, i.e. return x [JRH 94.01.29] % % --------------------------------------------------------------------- % letrec funpow n f x = if n < 1 then x else funpow (n-1) f (f x);; % --------------------------------------------------------------------- % % "<<" Added by MJCG for HOL88.1.01 % % --------------------------------------------------------------------- % ml_paired_infix `<<`;; % ===================================================================== % % The following were added by MJCG for HOL88.1.02. Revised by TFM for % % version 1.12 on 1 December 1990. % % ===================================================================== % % --------------------------------------------------------------------- % % HOLdir no longer used [TFM 90.12.01] % % % % letref HOLdir = ``;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Functions for loading files from a library % % % % DELETED: access the library through the search path. [TFM 90.12.01] % % % % let load_from_lib t lib file = % % load((HOLdir ^ `/Library/` ^ lib ^ `/` ^ file),t);; % % % % let loadt_from_lib = load_from_lib true % % and loadf_from_lib = load_from_lib false;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Function for resetting various paths relative to a new HOL root % % directory. [REVISED: TFM 90.12.01] % % --------------------------------------------------------------------- % let install = let helps = [`/help/ENTRIES/`] in \st. print_string (`HOL installed (\`` ^ st ^ `\`)`); print_newline(); lisp (`(setq %hol-dir (quote |` ^ st ^ `|))`); lisp (`(setq %lib-dir (quote |` ^ st ^ `/Library|))`); set_search_path [``; `~/`; st ^ `/theories/`]; set_library_search_path [st ^ `/Library/`]; set_help_search_path (map (concat st) helps); ();; % --------------------------------------------------------------------- % % Functions for adding to the search path [DELETED TFM 90.12.01] % % % % let add_to_search_path p = set_search_path(p.search_path());; % % let append_to_search_path p = set_search_path(search_path()@[p]);; % % --------------------------------------------------------------------- % hol88-2.02.19940316/ml/hol-rule.ml0000640000212700021270000002065105521527476014436 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: hol-rule.ml % % % % DESCRIPTION: Primitive inference rules for HOL % % % % USES FILES: basic-hol lisp files, bool.th, hol-syn.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % if compiling then (loadf `ml/hol-in-out`) else ();; % First we load the definitions from the theory bool % let T_DEF = definition `bool` `T_DEF` and F_DEF = definition `bool` `F_DEF` and FORALL_DEF = definition `bool` `FORALL_DEF` and AND_DEF = definition `bool` `AND_DEF` and OR_DEF = definition `bool` `OR_DEF` and EXISTS_DEF = definition `bool` `EXISTS_DEF` and NOT_DEF = definition `bool` `NOT_DEF` and EXISTS_UNIQUE_DEF = definition `bool` `EXISTS_UNIQUE_DEF` and LET_DEF = definition `bool` `LET_DEF` and UNCURRY_DEF = definition `bool` `UNCURRY_DEF` and CURRY_DEF = definition `bool` `CURRY_DEF` and COND_DEF = definition `bool` `COND_DEF`;; % Deleted: TFM 91.01.20 % % and IFF_DEF = definition `bool` `IFF_DEF` % % and FCOND_DEF = definition `bool` `FCOND_DEF`;; % % The definition of TYPE_DEFINITION might as well also be loaded. % let TYPE_DEFINITION = definition `bool` `TYPE_DEFINITION`;; % then the axioms % let BOOL_CASES_AX = axiom `bool` `BOOL_CASES_AX` and IMP_ANTISYM_AX = axiom `bool` `IMP_ANTISYM_AX` and ETA_AX = axiom `bool` `ETA_AX` and SELECT_AX = axiom `bool` `SELECT_AX`;; % then the pairing theorems (the ARB_THM is there so the file can be loaded before the type ":prod" has been defined, see hol/theories/mk_bool.ml). % % Added: PAIR_EQ (TFM 88.03.31) % let PAIR = theorem `bool` `PAIR` ? ARB_THM and FST = theorem `bool` `FST` ? ARB_THM and SND = theorem `bool` `SND` ? ARB_THM and PAIR_EQ = theorem `bool` `PAIR_EQ` ? ARB_THM;; % Finally we define the primitive inference rules % % Introduce an assumption --------- A |- A % let ASSUME w = fst(mk_thm([w],w), RecordStep(AssumeStep w)) ? failwith`ASSUME`;; % Reflexivity "t" ---> |- t=t % let REFL t = fst(mk_thm([], mk_eq(t,t)), RecordStep(ReflStep t)) ? failwith `REFL`;; % Substitution A1 |- ti = ui , A2 |- t[ti] ------------------------------- A1 u A2 |- t[ui] % let SUBST thvars w lhsthm = (let ths,vars = split thvars in let ls, rs = split (map (dest_eq o concl) ths) in if aconv (subst (combine(ls,vars)) w) (concl lhsthm) then fst(mk_thm( hyp_union(lhsthm . ths), subst(combine(rs,vars)) w), RecordStep(SubstStep(thvars, w, lhsthm))) else fail )? failwith `SUBST` ;; % Beta-conversion "(\x.t1)t2" ---> |- (\x.t1)t2 = t1[t2/x] % let BETA_CONV t = (let f,v = dest_comb t in let x,u = dest_abs f in fst(mk_thm([], mk_eq(t,subst[v,x]u)), RecordStep(BetaConvStep t)) % Antiquotation removed TFM 90.07.10 % ) ? failwith `BETA_CONV`;; % Abstraction A |- t1 = t2 ----------------------- (provided x is not free in A) A |- (\x.t1) = (\x.t2) % % --------------------------------------------------------------------- % % OPTIMIZED: [TFM 90.06.27] % % % % Original code: % % % % let ABS x th = % % (let t1,t2 = dest_eq(concl th) % % in % % if mem x (freesl(hyp th)) % % then fail % % else mk_thm(hyp th, "(\^x.^t1)=(\^x.^t2)") % % ) ? failwith `ABS`;; % % --------------------------------------------------------------------- % let ABS x th = (let hy,t1,t2 = (I # dest_eq)(dest_thm th) in if mem x (freesl hy) then fail else fst(mk_thm(hy, mk_eq(mk_abs(x,t1),mk_abs(x,t2))), RecordStep(AbsStep(x,th))) ) ? failwith `ABS`;; %Instantiate types A |- t ------------------------------------- (where type variables vtyi not in A) A |- t[ty1,...,tyn/vty1,...,vtyn] % %< Original code: let INST_TYPE inst_tylist th = if null inst_tylist then th else (let asl,w = dest_thm th and tyvl = map ((assert is_vartype) o snd) inst_tylist in if exists (\ty. exists (type_in ty) asl) tyvl then fail else mk_thm(asl, inst (freesl asl) inst_tylist w) ) ? failwith `INST_TYPE` ;; This failed to check for variable capture (spotted by Roger Jones' team at ICL Defence Systems). The new code uses a Lisp coded check: inst_rename_list : term -> term list which returns a list of variables in a term that are in the scope of a lambda binding of a variable with the same name but different type. Such bound variables are renamed if their type is instantiated. As a slight optimization (to compensate for the loss of performance due to the extra checking in inst_rename_list) the validity testing for INST_TYPE has been efficiently coded in Lisp via a dml-ed function: inst_check : (type # type) list # term list -> term list A call inst_check [(ty1,v1); ... ;(tyn,vn)] [tm1; ... ;tmn] returns the list of free variables in tm1, ..., tmn if: (i) each vi is a type variable, and (ii) none of the vi occurs in any of the tm1, ... ,tmn if (i) or (ii) fails to hold the call fails. >% let INST_TYPE inst_tylist th = if null inst_tylist then th else (let asl,w = dest_thm th in let vars = inst_check(inst_tylist,asl) in fst(mk_thm(asl, inst((inst_rename_list w)@vars) inst_tylist w), RecordStep(InstTypeStep(inst_tylist,th))) );; % Discharging an assumption A |- t2 -------------------- ("A-{t1}" is the set subtraction of {t1} from A) A-{t1} |- t1 ==> t2 % let DISCH w th = fst(mk_thm(disch(w,hyp th), mk_imp(w,concl th)), RecordStep(DischStep(w,th))) ? failwith`DISCH`;; % Modus Ponens A1 |- t1 ==> t2 , A2 |- t2 ------------------------------- A1 u A2 |- t2 CHANGED by WW 24 Jan 94. Due to some historical reasons, dest_imp also destruct negation and convert it iinto an implication with F in the conclusio. Therefore, the old code shown below performs extra inferences. E.g. MP (A1 |- ~t) (A2 |- t) = (A1,A2 |- F). The new code implements a strict primitive MP rule. The behaviour of the old MP rule is implemented by NOT_MP in hol-drule.ml. OLD CODE: let MP thi th = (let wa,wc = dest_imp (concl thi) in if aconv wa (concl th) then fst(mk_thm(union(hyp thi) (hyp th), wc), RecordStep(MpStep(thi,th))) else fail) ? failwith `MP`;; % let MP thi th = (let ((c,wa),wc) = (dest_comb # I) (dest_comb (concl thi)) in if not((fst (dest_const c)) = `==>`) then failwith `not an implication` else if aconv wa (concl th) then fst(mk_thm(union(hyp thi) (hyp th), wc), RecordStep(MpStep(thi,th))) else failwith `theorem does not alpha-convert to antecedent` ) ?\s failwith (`MP: `^s);; hol88-2.02.19940316/ml/conv.ml0000640000212700021270000031756705530161076013661 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: conv.ml % % % % DESCRIPTION: Conversions and rules defined using them % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`);; lettype conv = term -> thm;; % --------------------------------------------------------------------- % % Instantiate terms and types of a theorem % % --------------------------------------------------------------------- % let INST_TY_TERM(substl,insttyl) th = INST substl (INST_TYPE insttyl th);; % --------------------------------------------------------------------- % % |- !x y z. w ---> |- w[g1/x][g2/y][g3/z] % % --------------------------------------------------------------------- % letrec GSPEC th = let wl,w = dest_thm th in if is_forall w then GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) else th;; % Match a given part of "th" to a term, instantiating "th". The part should be free in the theorem, except for outer bound variables % let PART_MATCH partfn th = let pth = GSPEC (GEN_ALL th) in let pat = partfn(concl pth) in let matchfn = match pat in \tm. INST_TY_TERM (matchfn tm) pth;; % --------------------------------------------------------------------- % % MATCH_MP: Matching Modus Ponens for implications. % % % % |- !x1 ... xn. P ==> Q |- P' % % --------------------------------------- % % |- Q' % % % % Matches all types in conclusion except those mentioned in hypotheses. % % % % Reimplemented with bug fix [TFM 91.06.17]. % % OLD CODE: % % % % let MATCH_MP impth = % % let match = PART_MATCH (fst o dest_imp) impth ? failwith `MATCH_MP` % % in % % \th. MP (match (concl th)) th;; % % % % --------------------------------------------------------------------- % %----------------------------------------------------------------------------% % Reimplemented again [JRH 92.08.25] to fix variable capture bug and % % keep universal quantification in the resulting equation. Old code: % % % % let MATCH_MP impth = % % let hy,(vs,imp) = (I # strip_forall) (dest_thm impth) in % % let pat = fst(dest_imp imp) % % ? failwith `MATCH_MP: not an implication` in % % let fvs = subtract (frees (fst(dest_imp imp))) (freesl hy) in % % let gth = GSPEC (GENL fvs (SPECL vs impth)) in % % let matchfn = match (fst(dest_imp(concl gth))) in % % \th. (MP (INST_TY_TERM (matchfn (concl th)) gth) th) ? % % failwith `MATCH_MP: does not match`;; % %----------------------------------------------------------------------------% %----------------------------------------------------------------------------% % Fixed bug (found by Sten Agerholm) arising from the fact that type % % instantiation may cause bound variable renaming. Following documentation % % added. [JRH 92.11.18] % %----------------------------------------------------------------------------% %----------------------------------------------------------------------------% % Documentation for the workings of the new MATCH_MP % % ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ % % % % The two argument theorems are of the form % % % % ith = A |- !x1..xn. s ==> t % % th = B |- s' % % % % Extract "bod" (|s|) from "ith", and using the match function "mth", match % % it to (|s'|); do the type instantiation (only), giving "tth", a % % type-instantiated version of "ith". The type instantiation may rename % % bound variables, so repeat the match procedure to get the term % % instantiations "tmin". Now set up lists of free variables in |A| ("hy1") % % and |B| ("hy2"). Take apart the instantiated version of "ith" to get the % % quantified variables |x1|..|xn| in list "avs", and the antecedent and % % consequent of the implication in "ant" and "cons" respectively. % % % % Partition the free variables in the antecedent into those which are % % ("rvs") an are not ("fvs") free in the consequent. We will only need to % % instantiate those in "rvs" to get a match; however we want to rename any % % of the "fvs" if necessary to avoid capture problems (as in the previous % % version of MATCH_MP). Accordingly, set up a list of `available' variables % % in "afvs", which we can rename if required, either because they are not % % free in |A|, or are included in the set |x1|..|xn|. % % % % Now in "cvs" we collect those variables which will be free in the % % consequent after instantiation: if the variable isn't in the instantiation % % list then just the variable itself, otherwise the free variables in % % whatever is to be instantiated for it. Now pick variant versions in "vfvs" % % of the variables in "afvs" to avoid clashes with these or any variables in % % either assumption list. % % % % Now create a complete set of `instantiations' in "atmin" to preform both % % the instantiation of these variants and those needed for the original % % match. Now partition those into those which do ("spl") and do not ("ill") % % appear among the |x1|..|xn|, and consequently can be SPEC'd or must be % % INST'd respectively. % % % % Create an actual SPEC list in "fspl" to SPEC each variable appropriately, % % either to the instantiation in "spl" or otherwise to itself. (This works % % even if there are repetitions in the list |x1|..|xn|.) INST and SPEC % % accordingly to get a matched theorem, and perform the Modus Ponens, % % getting "mth", an instance of |t|. Finally, we want to universally % % quantify over (the variants of) any variables originally in |x1|..|xn|; % % get the associated variants in "qvs" and GENL over them (possible because % % the variants in "vfvs" were chosen not to be free in either |A| or |B|). % %----------------------------------------------------------------------------% let MATCH_MP = letrec variants av vs = if vs = [] then [] else let vh = variant av (hd vs) in vh.(variants (vh.av) (tl vs)) and frev_assoc x l = if l = [] then x else let h.t = l in if x = snd(h) then fst(h) else frev_assoc x t in \ith. let bod = (fst o dest_imp o snd o strip_forall o concl) ith ? failwith `MATCH_MP: not an implication` in \th. (let mfn = C match (concl th) in let tth = INST_TYPE (snd(mfn bod)) ith in let tbod = (fst o dest_imp o snd o strip_forall o concl) tth in let tmin = fst(mfn tbod) in let hy1 = freesl(hyp tth) and hy2 = freesl(hyp th) in let avs,ant,cons = (I # dest_imp) (strip_forall (concl tth)) in let rvs,fvs = partition (C free_in ant) (frees cons) in let afvs = subtract fvs (subtract hy1 avs) in let cvs = freesl (map (C frev_assoc tmin) rvs) in let vfvs = (variants (cvs@hy1@hy2) afvs) com afvs in let atmin = (filter ($not o $=) vfvs)@tmin in let spl,ill = partition (C mem avs o snd) atmin in let fspl = map (C frev_assoc spl) avs in let mth = MP (SPECL fspl (INST ill tth)) th in let qvs = mapfilter (fst o C rev_assoc vfvs) avs in GENL qvs mth) ? failwith `MATCH_MP: can't instantiate theorem`;; % --------------------------------------------------------------------- % % Conversion for rewrite rules of the form |- !x1 ... xn. t == u % % Matches x1 ... xn : t' ----> |- t' == u' % % Matches all types in conclusion except those mentioned in hypotheses. % % % % Rewritten such that the lhs of |- t' = u' is syntactically equal to % % the input term, not just alpha-equivalent. [TFM 90.07.11] % % % % OLD CODE: % % % % let REWR_CONV = % % set_fail_prefix `REWR_CONV` % % (PART_MATCH (fst o dest_eq));; % % % % --------------------------------------------------------------------- % let REWR_CONV th = (let instth = PART_MATCH lhs th in \tm. (let eqn = instth tm in let l = lhs(concl eqn) in if (l = tm) then eqn else TRANS (ALPHA tm l) eqn) ? failwith `REWR_CONV: lhs of theorem doesn't match term`) ? failwith `REWR_CONV: bad theorem argument (not an equation)`;; %Conversion that always fails; identity element for ORELSEC % let NO_CONV : conv = \tm. failwith `NO_CONV`;; % Conversion that always succeeds, using reflexive law: t ---> |- t==t Identity element for THENC % let ALL_CONV = REFL;; ml_curried_infix `THENC`;; ml_curried_infix `ORELSEC`;; %Apply two conversions in succession; fail if either does% let (conv1 THENC conv2): conv = \t. let th1 = conv1 t in let th2 = conv2 (rhs (concl th1)) in th1 TRANS th2;; %Apply conv1; if it fails then apply conv2% let (conv1 ORELSEC conv2): conv = \t. conv1 t ? conv2 t;; %Perform the first successful conversion of those in the list% let FIRST_CONV convl tm = itlist $ORELSEC convl NO_CONV tm ? failwith `FIRST_CONV`;; %Perform every conversion in the list% let EVERY_CONV convl tm = itlist $THENC convl ALL_CONV tm ? failwith `EVERY_CONV`;; %Apply a conversion zero or more times% letrec REPEATC conv t = ((conv THENC (REPEATC conv)) ORELSEC ALL_CONV) t;; %Cause the conversion to fail if it does not change its input% let CHANGED_CONV (conv:term->thm) tm = let th = conv tm in let l,r = dest_eq (concl th) in if aconv l r then failwith `CHANGED_CONV` else th;; let TRY_CONV conv = conv ORELSEC ALL_CONV;; % Apply conv to all top-level subterms of a term. Old version with over-subtle treatment of bound variables: let SUB_CONV conv tm = if is_comb tm then (let rator,rand = dest_comb tm in MK_COMB (conv rator, conv rand)) if is_abs tm then (let bv,body = dest_abs tm in let gv = genvar(type_of bv) in let bodyth = conv (subst [gv,bv] body) in let bv' = variant (thm_frees bodyth) bv in MK_ABS (GEN bv' (INST [bv',gv] bodyth))) else (ALL_CONV tm);; % let SUB_CONV conv tm = if is_comb tm then (let rator,rand = dest_comb tm in MK_COMB (conv rator, conv rand)) if is_abs tm then (let bv,body = dest_abs tm in let bodyth = conv body in MK_ABS (GEN bv bodyth)) else (ALL_CONV tm);; % ===================================================================== % % Section for defining depth conversions [RJB 91.04.17] % % ===================================================================== % begin_section depth_conv;; % ===================================================================== % % Conversions that use failure to indicate that they have not changed % % their input term, and hence save the term from being rebuilt % % unnecessarily. % % % % Based on ideas of Roger Fleming. Implemented by Richard Boulton. % % ===================================================================== % % --------------------------------------------------------------------- % % Failure string indicating that a term has not been changed by the % % conversion applied to it. % % --------------------------------------------------------------------- % let qconv = `QCONV`;; % --------------------------------------------------------------------- % % QCONV : conv -> conv % % % % Takes a conversion that uses failure to indicate that it has not % % changed its argument term, and produces an ordinary conversion. % % --------------------------------------------------------------------- % let QCONV conv tm = (conv tm) ??[qconv](REFL tm);; % --------------------------------------------------------------------- % % ALL_QCONV : conv % % % % Identity conversion for conversions using failure. % % --------------------------------------------------------------------- % let ALL_QCONV:conv = \tm. failwith qconv;; % --------------------------------------------------------------------- % % THENQC : conv -> conv -> conv % % % % Takes two conversions that use failure and produces a conversion that % % applies them in succession. The new conversion also uses failure. It % % fails if neither of the two argument conversions cause a change. % % --------------------------------------------------------------------- % let THENQC conv1 conv2 tm = (let th1 = conv1 tm in ((th1 TRANS (conv2 (rhs (concl th1)))) ??[qconv] th1)) ??[qconv] (conv2 tm);; % --------------------------------------------------------------------- % % ORELSEQC : conv -> conv -> conv % % % % Takes two conversions that use failure and produces a conversion that % % tries the first one, and if this fails for a reason other than that % % the term is unchanged, it tries the second one. % % % % Modified to use the ?\ construct, 92.03.03 by RJB. % % --------------------------------------------------------------------- % let ORELSEQC conv1 conv2 (tm:term) = (conv1 tm) ?\s if (s = qconv) then (failwith qconv) else (conv2 tm);; % --------------------------------------------------------------------- % % REPEATQC : conv -> conv % % % % Applies a conversion zero or more times. % % --------------------------------------------------------------------- % letrec REPEATQC conv tm = (ORELSEQC (THENQC conv (REPEATQC conv)) ALL_QCONV) tm;; % --------------------------------------------------------------------- % % CHANGED_QCONV : conv -> conv % % % % Causes the conversion given to fail if it does not change its input. % % Alpha convertibility is only tested for if the term is changed in % % some way. % % --------------------------------------------------------------------- % let CHANGED_QCONV conv (tm:term) = let th = (conv tm) ??[qconv] failwith `CHANGED_QCONV` in let (l,r) = dest_eq (concl th) in if (aconv l r) then failwith `CHANGED_QCONV` else th;; % --------------------------------------------------------------------- % % TRY_QCONV : conv -> conv % % % % Applies a conversion, and if it fails, raises a `qconv' failure % % indicating that the term is unchanged. % % --------------------------------------------------------------------- % let TRY_QCONV conv = ORELSEQC conv ALL_QCONV;; % --------------------------------------------------------------------- % % SUB_QCONV : conv -> conv % % % % Applies conv to all top-level subterms of a term. Set up to detect % % `qconv' failures when dealing with a combination. If neither the % % rator nor the rand are modified the `qconv' failure is propagated. % % Otherwise, the failure information is used to avoid unnecessary % % processing. % % % % Optimized: MK_ABS(GEN bv bodyth) --> ABS bv bodyth [TFM 93.07.22] % % --------------------------------------------------------------------- % let SUB_QCONV conv tm = if (is_comb tm) then (let (rator,rand) = dest_comb tm in (let th = conv rator in ((MK_COMB (th, conv rand)) ??[qconv](AP_THM th rand))) ??[qconv](AP_TERM rator (conv rand))) else if (is_abs tm) then (let (bv,body) = dest_abs tm in let bodyth = conv body in ABS bv bodyth) % old: MK_ABS (GEN bv bodyth)) % else (ALL_QCONV tm);; % --------------------------------------------------------------------- % % SUB_ALPHA_QCONV : conv -> conv % % % % Modified version of SUB_QCONV for use in rewriting. % % If the application of ABS fails, the conversion is attempted again % % on an alpha-converted version of the abstraction. This is to catch % % those rare cases in which a valid rewrite is rejected because one of % % the hypotheses has a free occurrence of the bound variable. % % An alternative would be to always genvar the abstraction, but the % % problem is sufficiently rare that it is probably more efficient on % % average to repeat the application of the conversion even though this % % may be very expensive. [RJB 94.02.15] % % --------------------------------------------------------------------- % let SUB_ALPHA_QCONV conv tm = if (is_comb tm) then (let (rator,rand) = dest_comb tm in (let th = conv rator in ((MK_COMB (th, conv rand)) ??[qconv](AP_THM th rand))) ??[qconv](AP_TERM rator (conv rand))) else if (is_abs tm) then (let (bv,body) = dest_abs tm in let bodyth = conv body in (ABS bv bodyth ? let v = genvar (type_of bv) in let th1 = ALPHA_CONV v tm in let body' = snd (dest_abs (rhs (concl th1))) in let eq_thm' = ABS v (conv body') in let th2 = ALPHA_CONV bv (rhs (concl eq_thm')) in TRANS (TRANS th1 eq_thm') th2)) else (ALL_QCONV tm);; % --------------------------------------------------------------------- % % Apply a conversion recursively to a term and its parts. % % The abstraction around "t" avoids infinite recursion. % % % % Old version: % % % % letrec DEPTH_CONV conv t = % % (SUB_CONV (DEPTH_CONV conv) THENC (REPEATC conv)) % % t;; % % % % Parameterised over SUB_QCONV. [RJB 94.02.15] % % --------------------------------------------------------------------- % letrec DEPTH_QCONV subconv conv tm = THENQC (subconv (DEPTH_QCONV subconv conv)) (REPEATQC conv) tm;; % --------------------------------------------------------------------- % % Optimized 13.5.93 by JVT to remove the function composition to % % enhance speed. % % % % OLD VERSION: % % % % let DEPTH_CONV = QCONV o DEPTH_QCONV;; % % % % SUB_QCONV added to instantiate new parameter. [RJB 94.02.15] % % --------------------------------------------------------------------- % let DEPTH_CONV = \conv. (QCONV (DEPTH_QCONV SUB_QCONV conv));; % --------------------------------------------------------------------- % % Like DEPTH_CONV, but re-traverses term after each conversion % % Loops if the conversion function never fails % % % % Old version: % % % % letrec REDEPTH_CONV conv t = % % (SUB_CONV (REDEPTH_CONV conv) THENC % % ((conv THENC (REDEPTH_CONV conv)) ORELSEC ALL_CONV)) % % t;; % % % % Parameterised over SUB_QCONV. [RJB 94.02.15] % % --------------------------------------------------------------------- % letrec REDEPTH_QCONV subconv conv tm = THENQC (subconv (REDEPTH_QCONV subconv conv)) (ORELSEQC (THENQC conv (REDEPTH_QCONV subconv conv)) ALL_QCONV) tm;; % --------------------------------------------------------------------- % % Optimized 13.5.93 by JVT to remove the function composition to % % enhance speed. % % % % OLD VERSION: % % % % let REDEPTH_CONV = QCONV o REDEPTH_QCONV;; % % % % SUB_QCONV added to instantiate new parameter. [RJB 94.02.15] % % --------------------------------------------------------------------- % let REDEPTH_CONV = \conv. (QCONV (REDEPTH_QCONV SUB_QCONV conv));; % --------------------------------------------------------------------- % % Rewrite the term t trying conversions at top level before descending % % Not true Normal Order evaluation, but may terminate where % % REDEPTH_CONV would loop. More efficient than REDEPTH_CONV for % % rewrites that throw away many of their pattern variables. % % % % Old version: % % % % letrec TOP_DEPTH_CONV conv t = % % (REPEATC conv THENC % % (TRY_CONV % % (CHANGED_CONV (SUB_CONV (TOP_DEPTH_CONV conv)) THENC % % TRY_CONV(conv THENC TOP_DEPTH_CONV conv)))) % % t;; % % % % Slower, simpler version (tries conv even if SUB_CONV does nothing) % % % % letrec TOP_DEPTH_CONV conv t = % % (REPEATC conv THENC % % SUB_CONV (TOP_DEPTH_CONV conv) THENC % % ((conv THENC TOP_DEPTH_CONV conv) ORELSEC ALL_CONV)) % % t;; % % % % Parameterised over SUB_QCONV. [RJB 94.02.15] % % --------------------------------------------------------------------- % letrec TOP_DEPTH_QCONV subconv conv tm = THENQC (REPEATQC conv) (TRY_QCONV (THENQC (CHANGED_QCONV (subconv (TOP_DEPTH_QCONV subconv conv))) (TRY_QCONV (THENQC conv (TOP_DEPTH_QCONV subconv conv))))) tm;; % --------------------------------------------------------------------- % % Optimized 13.5.93 by JVT to remove the function composition to % % enhance speed. % % % % OLD VERSION: % % % % let TOP_DEPTH_CONV = QCONV o TOP_DEPTH_QCONV;; % % % % SUB_QCONV added to instantiate new parameter. [RJB 94.02.15] % % --------------------------------------------------------------------- % let TOP_DEPTH_CONV = \conv. (QCONV (TOP_DEPTH_QCONV SUB_QCONV conv));; % --------------------------------------------------------------------- % % ONCE_DEPTH_CONV conv tm: applies conv ONCE to the first suitable % % sub-term(s) encountered in top-down order. % % % % Old Version: % % % % letrec ONCE_DEPTH_CONV conv tm = % % (conv ORELSEC (SUB_CONV (ONCE_DEPTH_CONV conv))) tm;; % % % % % % Reimplemented: TFM 90.07.04 (optimised for speed) % % % % This version uses failure to avoid rebuilding unchanged subterms % % (now superseded by more general use of failure for optimisation). % % % % let ONCE_DEPTH_CONV = % % letrec ODC conv tm = % % conv tm ? % % (let l,r = dest_comb tm in % % (let lth = ODC conv l in % % (MK_COMB(lth,ODC conv r)) ? AP_THM lth r) ? % % AP_TERM l (ODC conv r)) ? % % let v,body = dest_abs tm in % % let bodyth = ODC conv body in % % MK_ABS (GEN v bodyth) in % % \conv tm. ODC conv tm ? REFL tm;; % % % % % % It has been discovered that TFM's optimised version had a different % % (and more desirable) behaviour to the original version. The version % % below has been modified to behave as TFM's did by the addition of the % % call to TRY_QCONV. ONCE_DEPTH_CONV cannot now fail, whereas the % % original version could. [RJB 92.03.03] % % % % Parameterised over SUB_QCONV. [RJB 94.02.15] % % --------------------------------------------------------------------- % letrec ONCE_DEPTH_QCONV subconv conv tm = TRY_QCONV (ORELSEQC conv (subconv (ONCE_DEPTH_QCONV subconv conv))) tm;; % --------------------------------------------------------------------- % % Optimized 13.5.93 by JVT to remove the function composition to % % enhance speed. % % % % OLD VERSION: % % % % let ONCE_DEPTH_CONV = QCONV o ONCE_DEPTH_QCONV;; % % % % SUB_QCONV added to instantiate new parameter. [RJB 94.02.15] % % --------------------------------------------------------------------- % let ONCE_DEPTH_CONV = \conv. (QCONV (ONCE_DEPTH_QCONV SUB_QCONV conv));; % --------------------------------------------------------------------- % % Depth conversions for use in rewriting. Added [RJB 94.02.15] % % --------------------------------------------------------------------- % let REW_DEPTH_CONV = \conv. (QCONV (TOP_DEPTH_QCONV SUB_ALPHA_QCONV conv));; let ONCE_REW_DEPTH_CONV = \conv. (QCONV (ONCE_DEPTH_QCONV SUB_ALPHA_QCONV conv));; % --------------------------------------------------------------------- % % Export depth conversions outside of section. % % --------------------------------------------------------------------- % (DEPTH_CONV,REDEPTH_CONV,TOP_DEPTH_CONV,ONCE_DEPTH_CONV, REW_DEPTH_CONV,ONCE_REW_DEPTH_CONV);; end_section depth_conv;; let (DEPTH_CONV,REDEPTH_CONV,TOP_DEPTH_CONV,ONCE_DEPTH_CONV, REW_DEPTH_CONV,ONCE_REW_DEPTH_CONV) = it;; % Convert a conversion to a rule % let CONV_RULE conv th = EQ_MP (conv(concl th)) th;; % Convert a conversion to a tactic % let CONV_TAC conv :tactic (asl,w) = let th = conv w in let left,right = dest_eq(concl th) in if right="T" then ([], \[]. EQ_MP (SYM th) TRUTH) else ([asl,right], \[th']. EQ_MP (SYM th) th');; % Rule and tactic for beta-reducing on all beta-redexes % let BETA_RULE = CONV_RULE(DEPTH_CONV BETA_CONV) and BETA_TAC = CONV_TAC (DEPTH_CONV BETA_CONV);; % ===================================================================== % % The stuff in boxes below is mostly from Tom Melham (tfm) % % ===================================================================== % % ===================================================================== % % What follows is a complete set of conversions for moving ! and ? into % % and out of the basic logical connectives ~, /\, \/, ==>, and =. % % % % Naming scheme: % % % % 1: for moving quantifiers inwards: __CONV % % % % 2: for moving quantifiers outwards: [dir]___CONV % % % % where % % % % := FORALL | EXISTS % % := NOT | AND | OR | IMP | EQ % % [dir] := LEFT | RIGHT (optional) % % % % % % [TFM 90.11.09] % % ===================================================================== % % --------------------------------------------------------------------- % % NOT_FORALL_CONV, implements the following axiom scheme: % % % % |- (~!x.tm) = (?x.~tm) % % % % --------------------------------------------------------------------- % let NOT_FORALL_CONV tm = (let x,t = dest_forall(dest_neg tm) in let all = mk_forall(x,t) and exists = mk_exists(x,mk_neg t) in let nott = ASSUME (mk_neg t) in let th1 = DISCH all (NOT_MP nott (SPEC x (ASSUME all))) in let imp1 = DISCH exists (CHOOSE (x, ASSUME exists) (NOT_INTRO th1)) in let th2 = CCONTR t (NOT_MP (ASSUME(mk_neg exists)) (EXISTS(exists,x)nott)) in let th3 = CCONTR exists (NOT_MP (ASSUME (mk_neg all)) (GEN x th2)) in let imp2 = DISCH (mk_neg all) th3 in IMP_ANTISYM_RULE imp2 imp1) ? failwith `NOT_FORALL_CONV: argument must have the form "~!x.tm"`;; % --------------------------------------------------------------------- % % NOT_EXISTS_CONV, implements the following axiom scheme. % % % % |- (~?x.tm) = (!x.~tm) % % % % --------------------------------------------------------------------- % let NOT_EXISTS_CONV tm = (let x,t = dest_exists (dest_neg tm) in let all = mk_forall(x,mk_neg t) in let asm1 = ASSUME t in let thm1 = NOT_MP (ASSUME tm) (EXISTS (rand tm, x) asm1) in let imp1 = DISCH tm (GEN x (NOT_INTRO (DISCH t thm1))) in let asm2 = ASSUME all and asm3 = ASSUME (rand tm) in let thm2 = DISCH (rand tm) (CHOOSE (x,asm3) (NOT_MP (SPEC x asm2) asm1)) in let imp2 = DISCH all (NOT_INTRO thm2) in IMP_ANTISYM_RULE imp1 imp2 ) ? failwith `NOT_EXISTS_CONV: argument must have the form "~?x.tm"`;; % --------------------------------------------------------------------- % % EXISTS_NOT_CONV, implements the following axiom scheme. % % % % |- (?x.~tm) = (~!x.tm) % % % % --------------------------------------------------------------------- % let EXISTS_NOT_CONV tm = (let xtm = mk_forall ((I # dest_neg) (dest_exists tm)) in SYM(NOT_FORALL_CONV (mk_neg xtm))) ? failwith `EXISTS_NOT_CONV: argument must have the form "?x.~tm"`;; % --------------------------------------------------------------------- % % FORALL_NOT_CONV, implements the following axiom scheme. % % % % |- (!x.~tm) = (~?x.tm) % % % % --------------------------------------------------------------------- % let FORALL_NOT_CONV tm = (let xtm = mk_exists ((I # dest_neg) (dest_forall tm)) in SYM(NOT_EXISTS_CONV (mk_neg xtm))) ? failwith `FORALL_NOT_CONV: argument must have the form "!x.~tm"`;; % --------------------------------------------------------------------- % % FORALL_AND_CONV : move universal quantifiers into conjunction. % % % % A call to FORALL_AND_CONV "!x. P /\ Q" returns: % % % % |- (!x. P /\ Q) = (!x.P) /\ (!x.Q) % % --------------------------------------------------------------------- % let FORALL_AND_CONV tm = (let x,(P,Q) = (I # dest_conj) (dest_forall tm) in let Pth,Qth = CONJ_PAIR (SPEC x (ASSUME tm)) in let imp1 = DISCH tm (CONJ (GEN x Pth) (GEN x Qth)) in let xtm = rand(concl imp1) in let t1,t2 = (SPEC x # SPEC x) (CONJ_PAIR (ASSUME xtm)) in let imp2 = DISCH xtm (GEN x (CONJ t1 t2)) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `FORALL_AND_CONV: argument must have the form "!x.P/\\Q"`;; % --------------------------------------------------------------------- % % EXISTS_OR_CONV : move existential quantifiers into disjunction. % % % % A call to EXISTS_OR_CONV "?x. P \/ Q" returns: % % % % |- (?x. P \/ Q) = (?x.P) \/ (?x.Q) % % --------------------------------------------------------------------- % let EXISTS_OR_CONV tm = (let x,(P,Q) = (I # dest_disj) (dest_exists tm) in let ep = mk_exists(x,P) and eq = mk_exists(x,Q) in let Pth = EXISTS(ep,x)(ASSUME P) and Qth = EXISTS(eq,x)(ASSUME Q) in let thm1 = DISJ_CASES_UNION (ASSUME(mk_disj(P,Q))) Pth Qth in let imp1 = DISCH tm (CHOOSE (x,ASSUME tm) thm1) in let t1 = DISJ1 (ASSUME P) Q and t2 = DISJ2 P (ASSUME Q) in let th1 = EXISTS(tm,x) t1 and th2 = EXISTS(tm,x) t2 in let e1 = CHOOSE (x,ASSUME ep) th1 and e2 = CHOOSE (x,ASSUME eq) th2 in let thm2 = DISJ_CASES (ASSUME(mk_disj(ep,eq))) e1 e2 in let imp2 = DISCH (mk_disj(ep,eq)) thm2 in IMP_ANTISYM_RULE imp1 imp2) ? failwith `EXISTS_OR_CONV: argument must have the form "?x.P\\/Q"`;; % --------------------------------------------------------------------- % % AND_FORALL_CONV : move universal quantifiers out of conjunction. % % % % A call to AND_FORALL_CONV "(!x. P) /\ (!x. Q)" returns: % % % % |- (!x.P) /\ (!x.Q) = (!x. P /\ Q) % % --------------------------------------------------------------------- % let AND_FORALL_CONV tm = (let (x,P),(y,Q) = (dest_forall # dest_forall) (dest_conj tm) in if (not (x=y)) then fail else let t1,t2 = (SPEC x # SPEC x) (CONJ_PAIR (ASSUME tm)) in let imp1 = DISCH tm (GEN x (CONJ t1 t2)) in let rtm = rand(concl imp1) in let Pth,Qth = CONJ_PAIR (SPEC x (ASSUME rtm)) in let imp2 = DISCH rtm (CONJ (GEN x Pth) (GEN x Qth)) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `AND_FORALL_CONV: expecting "(!x.P) /\\ (!x.Q)"`;; % --------------------------------------------------------------------- % % LEFT_AND_FORALL_CONV : move universal quantifier out of conjunction. % % % % A call to LEFT_AND_FORALL_CONV "(!x.P) /\ Q" returns: % % % % |- (!x.P) /\ Q = (!x'. P[x'/x] /\ Q) % % % % Where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let LEFT_AND_FORALL_CONV tm = (let (x,P),Q = (dest_forall # I) (dest_conj tm) in let x' = variant (frees tm) x in let t1,t2 = (SPEC x' # I) (CONJ_PAIR (ASSUME tm)) in let imp1 = DISCH tm (GEN x' (CONJ t1 t2)) in let rtm = rand(concl imp1) in let Pth,Qth = CONJ_PAIR (SPEC x' (ASSUME rtm)) in let imp2 = DISCH rtm (CONJ (GEN x' Pth) Qth) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `LEFT_AND_FORALL_CONV: expecting "(!x.P) /\\ Q"`;; % --------------------------------------------------------------------- % % RIGHT_AND_FORALL_CONV : move universal quantifier out of conjunction. % % % % A call to RIGHT_AND_FORALL_CONV "P /\ (!x.Q)" returns: % % % % |- P /\ (!x.Q) = (!x'. P /\ Q[x'/x]) % % % % where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let RIGHT_AND_FORALL_CONV tm = (let P,(x,Q) = (I # dest_forall) (dest_conj tm) in let x' = variant (frees tm) x in let t1,t2 = (I # SPEC x') (CONJ_PAIR (ASSUME tm)) in let imp1 = DISCH tm (GEN x' (CONJ t1 t2)) in let rtm = rand(concl imp1) in let Pth,Qth = CONJ_PAIR (SPEC x' (ASSUME rtm)) in let imp2 = DISCH rtm (CONJ Pth (GEN x' Qth)) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `RIGHT_AND_FORALL_CONV: expecting "P /\\ (!x.Q)"`;; % --------------------------------------------------------------------- % % OR_EXISTS_CONV : move existential quantifiers out of disjunction. % % % % A call to OR_EXISTS_CONV "(?x. P) \/ (?x. Q)" returns: % % % % |- (?x.P) \/ (?x.Q) = (?x. P \/ Q) % % --------------------------------------------------------------------- % let OR_EXISTS_CONV tm = (let ep,eq = dest_disj tm in let (x,P),(y,Q) = (dest_exists # dest_exists) (ep,eq) in if (not (x=y)) then fail else let otm = mk_exists (x,(mk_disj(P,Q))) in let t1 = DISJ1 (ASSUME P) Q and t2 = DISJ2 P (ASSUME Q) in let th1 = EXISTS(otm,x) t1 and th2 = EXISTS(otm,x) t2 in let e1 = CHOOSE (x,ASSUME ep) th1 and e2 = CHOOSE (x,ASSUME eq) th2 in let thm1 = DISJ_CASES (ASSUME(mk_disj(ep,eq))) e1 e2 in let imp1 = DISCH (mk_disj(ep,eq)) thm1 in let Pth = EXISTS(ep,x)(ASSUME P) and Qth = EXISTS(eq,x)(ASSUME Q) in let thm2 = DISJ_CASES_UNION (ASSUME(mk_disj(P,Q))) Pth Qth in let imp2 = DISCH otm (CHOOSE (x,ASSUME otm) thm2) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `OR_EXISTS_CONV: expecting "(?x.P) \\/ (?x.Q)"`;; % --------------------------------------------------------------------- % % LEFT_OR_EXISTS_CONV : move existential quantifier out of disjunction. % % % % A call to LEFT_OR_EXISTS_CONV "(?x.P) \/ Q" returns: % % % % |- (?x.P) \/ Q = (?x'. P[x'/x] \/ Q) % % % % Where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let LEFT_OR_EXISTS_CONV tm = (let ep,Q = dest_disj tm in let (x,P) = dest_exists ep in let x' = variant (frees tm) x in let newp = subst[x',x] P in let otm = mk_exists (x',(mk_disj(newp,Q))) in let t1 = DISJ1 (ASSUME newp) Q and t2 = DISJ2 newp (ASSUME Q) in let th1 = EXISTS(otm,x') t1 and th2 = EXISTS(otm,x') t2 in let thm1 = DISJ_CASES (ASSUME tm) (CHOOSE(x',ASSUME ep)th1) th2 in let imp1 = DISCH tm thm1 in let Pth = EXISTS(ep,x')(ASSUME newp) and Qth = ASSUME Q in let thm2 = DISJ_CASES_UNION (ASSUME(mk_disj(newp,Q))) Pth Qth in let imp2 = DISCH otm (CHOOSE (x',ASSUME otm) thm2) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `LEFT_OR_EXISTS_CONV: expecting "(?x.P) \\/ Q"`;; % --------------------------------------------------------------------- % % RIGHT_OR_EXISTS_CONV: move existential quantifier out of disjunction. % % % % A call to RIGHT_OR_EXISTS_CONV "P \/ (?x.Q)" returns: % % % % |- P \/ (?x.Q) = (?x'. P \/ Q[x'/x]) % % % % where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let RIGHT_OR_EXISTS_CONV tm = (let P,eq = dest_disj tm in let (x,Q) = dest_exists eq in let x' = variant (frees tm) x in let newq = subst[x',x] Q in let otm = mk_exists (x',(mk_disj(P,newq))) in let t1 = DISJ2 P (ASSUME newq) and t2 = DISJ1 (ASSUME P) newq in let th1 = EXISTS(otm,x') t1 and th2 = EXISTS(otm,x') t2 in let thm1 = DISJ_CASES (ASSUME tm) th2 (CHOOSE(x',ASSUME eq)th1) in let imp1 = DISCH tm thm1 in let Qth = EXISTS(eq,x')(ASSUME newq) and Pth = ASSUME P in let thm2 = DISJ_CASES_UNION (ASSUME(mk_disj(P,newq))) Pth Qth in let imp2 = DISCH otm (CHOOSE (x',ASSUME otm) thm2) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `RIGHT_OR_EXISTS_CONV: expecting "P \\/ (?x.Q)"`;; % --------------------------------------------------------------------- % % EXISTS_AND_CONV : move existential quantifier into conjunction. % % % % A call to EXISTS_AND_CONV "?x. P /\ Q" returns: % % % % |- (?x. P /\ Q) = (?x.P) /\ Q [x not free in Q] % % |- (?x. P /\ Q) = P /\ (?x.Q) [x not free in P] % % |- (?x. P /\ Q) = (?x.P) /\ (?x.Q) [x not free in P /\ Q] % % --------------------------------------------------------------------- % let EXISTS_AND_CONV tm = (let x,(P,Q) = (I # dest_conj) (dest_exists tm) ? failwith `expecting "?x. P /\\ Q"` in let fP = free_in x P and fQ = free_in x Q in if (fP & fQ) then failwith `"` ^ (fst(dest_var x)) ^ `" free in both conjuncts` else let t1,t2 = CONJ_PAIR(ASSUME (mk_conj(P,Q))) in let eP = (fQ => t1 | EXISTS (mk_exists(x,P),x) t1) and eQ = (fP => t2 | EXISTS (mk_exists(x,Q),x) t2) in let imp1 = DISCH tm (CHOOSE(x,ASSUME tm) (CONJ eP eQ)) in let th = EXISTS (tm,x) (CONJ(ASSUME P) (ASSUME Q)) in let th1 = (fP or not fQ => CHOOSE(x,ASSUME(mk_exists(x,P)))th | th) in let thm1 = (fQ or not fP => CHOOSE(x,ASSUME(mk_exists(x,Q)))th1 | th1) in let otm = rand(concl imp1) in let t1,t2 = CONJ_PAIR(ASSUME otm) in let thm2 = PROVE_HYP t1 (PROVE_HYP t2 thm1) in IMP_ANTISYM_RULE imp1 (DISCH otm thm2)) ?\st failwith `EXISTS_AND_CONV: ` ^ st;; % --------------------------------------------------------------------- % % AND_EXISTS_CONV : move existential quantifier out of conjunction. % % % % |- (?x.P) /\ (?x.Q) = (?x. P /\ Q) % % % % provided x is free in neither P nor Q. % % --------------------------------------------------------------------- % let AND_EXISTS_CONV tm = (let (x,P),(y,Q) = (dest_exists # dest_exists) (dest_conj tm) ? failwith `expecting "(?x.P) /\\ (?x.Q)"` in if (not(x=y)) then failwith `expecting "(?x.P) /\\ (?x.Q)"` else if (free_in x P or free_in x Q) then failwith `"` ^ (fst(dest_var x)) ^ `" free in conjunct(s)` else SYM (EXISTS_AND_CONV(mk_exists(x,mk_conj(P,Q))))) ?\st failwith `AND_EXISTS_CONV: ` ^ st;; % --------------------------------------------------------------------- % % LEFT_AND_EXISTS_CONV: move existential quantifier out of conjunction % % % % A call to LEFT_AND_EXISTS_CONV "(?x.P) /\ Q" returns: % % % % |- (?x.P) /\ Q = (?x'. P[x'/x] /\ Q) % % % % Where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let LEFT_AND_EXISTS_CONV tm = (let ep,Q = dest_conj tm in let (x,P) = dest_exists ep in let x' = variant (frees tm) x in let newp = subst[x',x]P in let otm = mk_exists(x',mk_conj(newp,Q)) in let EP,Qth = CONJ_PAIR(ASSUME tm) in let thm1 = EXISTS(otm,x')(CONJ(ASSUME newp)(ASSUME Q)) in let imp1 = DISCH tm (MP (DISCH Q (CHOOSE(x',EP)thm1)) Qth) in let t1,t2 = CONJ_PAIR (ASSUME (mk_conj(newp,Q))) in let thm2 = CHOOSE (x',ASSUME otm) (CONJ (EXISTS (ep,x') t1) t2) in IMP_ANTISYM_RULE imp1 (DISCH otm thm2)) ? failwith `LEFT_AND_EXISTS_CONV: expecting "(?x.P) /\\ Q"`;; % --------------------------------------------------------------------- % % RIGHT_AND_EXISTS_CONV: move existential quantifier out of conjunction % % % % A call to RIGHT_AND_EXISTS_CONV "P /\ (?x.Q)" returns: % % % % |- P /\ (?x.Q) = (?x'. P /\ (Q[x'/x]) % % % % where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let RIGHT_AND_EXISTS_CONV tm = (let P,eq = dest_conj tm in let (x,Q) = dest_exists eq in let x' = variant (frees tm) x in let newq = subst[x',x]Q in let otm = mk_exists(x',mk_conj(P,newq)) in let Pth,EQ = CONJ_PAIR(ASSUME tm) in let thm1 = EXISTS(otm,x')(CONJ(ASSUME P)(ASSUME newq)) in let imp1 = DISCH tm (MP (DISCH P (CHOOSE(x',EQ)thm1)) Pth) in let t1,t2 = CONJ_PAIR (ASSUME (mk_conj(P,newq))) in let thm2 = CHOOSE (x',ASSUME otm) (CONJ t1 (EXISTS (eq,x') t2)) in IMP_ANTISYM_RULE imp1 (DISCH otm thm2)) ? failwith `RIGHT_AND_EXISTS_CONV: expecting "P /\\ (?x.Q)"`;; % --------------------------------------------------------------------- % % FORALL_OR_CONV : move universal quantifier into disjunction. % % % % A call to FORALL_OR_CONV "!x. P \/ Q" returns: % % % % |- (!x. P \/ Q) = (!x.P) \/ Q [if x not free in Q] % % |- (!x. P \/ Q) = P \/ (!x.Q) [if x not free in P] % % |- (!x. P \/ Q) = (!x.P) \/ (!x.Q) [if x free in neither P nor Q] % % --------------------------------------------------------------------- % let FORALL_OR_CONV tm = (let x,(P,Q) = (I # dest_disj) (dest_forall tm) ? failwith `expecting "!x. P \\/ Q"` in let fP = free_in x P and fQ = free_in x Q in if (fP & fQ) then failwith `"` ^ (fst(dest_var x)) ^ `" free in both disjuncts` else let thm1 = SPEC x (ASSUME tm) in let imp1 = if fP then let thm2 = CONTR P (NOT_MP (ASSUME (mk_neg Q)) (ASSUME Q)) in let thm3 = DISJ1 (GEN x (DISJ_CASES thm1 (ASSUME P) thm2)) Q in let thm4 = DISJ2 (mk_forall(x,P)) (ASSUME Q) in DISCH tm (DISJ_CASES (SPEC Q EXCLUDED_MIDDLE) thm4 thm3) else if fQ then let thm2 = CONTR Q (NOT_MP (ASSUME (mk_neg P)) (ASSUME P)) in let thm3 = DISJ2 P (GEN x (DISJ_CASES thm1 thm2 (ASSUME Q))) in let thm4 = DISJ1 (ASSUME P) (mk_forall(x,Q)) in DISCH tm (DISJ_CASES (SPEC P EXCLUDED_MIDDLE) thm4 thm3) else let t1,t2 = (GEN x(ASSUME P), GEN x(ASSUME Q)) in DISCH tm (DISJ_CASES_UNION thm1 t1 t2) in let otm = rand(concl imp1) in let op,oq = dest_disj otm in let thm5 = (fP or not fQ => SPEC x | I) (ASSUME op) in let thm6 = (fQ or not fP => SPEC x | I) (ASSUME oq) in let imp2 = GEN x (DISJ_CASES_UNION (ASSUME otm) thm5 thm6) in IMP_ANTISYM_RULE imp1 (DISCH otm imp2)) ?\st failwith `FORALL_OR_CONV: ` ^ st;; % --------------------------------------------------------------------- % % OR_FORALL_CONV : move existential quantifier out of conjunction. % % % % |- (!x.P) \/ (!x.Q) = (!x. P \/ Q) % % % % provided x is free in neither P nor Q. % % --------------------------------------------------------------------- % let OR_FORALL_CONV tm = (let (x,P),(y,Q) = (dest_forall # dest_forall) (dest_disj tm) ? failwith `expecting "(!x.P) \\/ (!x.Q)"` in if (not(x=y)) then failwith `expecting "(!x.P) \\/ (!x.Q)"` else if (free_in x P or free_in x Q) then failwith `"` ^ (fst(dest_var x)) ^ `" free in disjuncts(s)` else SYM (FORALL_OR_CONV(mk_forall(x,mk_disj(P,Q))))) ?\st failwith `OR_FORALL_CONV: ` ^ st;; % --------------------------------------------------------------------- % % LEFT_OR_FORALL_CONV : move universal quantifier out of conjunction. % % % % A call to LEFT_OR_FORALL_CONV "(!x.P) \/ Q" returns: % % % % |- (!x.P) \/ Q = (!x'. P[x'/x] \/ Q) % % % % Where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let LEFT_OR_FORALL_CONV tm = (let (x,P),Q = (dest_forall # I) (dest_disj tm) in let x' = variant (frees tm) x in let newp = subst[x',x]P in let Pth = DISJ1 (SPEC x' (ASSUME (mk_forall(x,P)))) Q in let Qth = DISJ2 newp (ASSUME Q) in let imp1 = DISCH tm (GEN x' (DISJ_CASES (ASSUME tm) Pth Qth)) in let otm = rand(concl imp1) in let thm1 = SPEC x' (ASSUME otm) in let thm2 = CONTR newp (NOT_MP(ASSUME(mk_neg Q))(ASSUME Q)) in let thm3 = DISJ1 (GEN x' (DISJ_CASES thm1 (ASSUME newp) thm2)) Q in let thm4 = DISJ2 (mk_forall(x,P)) (ASSUME Q) in let imp2 = DISCH otm(DISJ_CASES(SPEC Q EXCLUDED_MIDDLE)thm4 thm3) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `LEFT_OR_FORALL_CONV: expecting "(!x.P) \\/ Q"`;; % --------------------------------------------------------------------- % % RIGHT_OR_FORALL_CONV : move universal quantifier out of conjunction. % % % % A call to RIGHT_OR_FORALL_CONV "P \/ (!x.Q)" returns: % % % % |- P \/ (!x.Q) = (!x'. P \/ (Q[x'/x]) % % % % where x' is a primed variant of x not free in the input term % % --------------------------------------------------------------------- % let RIGHT_OR_FORALL_CONV tm = (let P,(x,Q) = (I # dest_forall) (dest_disj tm) in let x' = variant (frees tm) x in let newq = subst[x',x]Q in let Qth = DISJ2 P (SPEC x' (ASSUME (mk_forall(x,Q)))) in let Pth = DISJ1 (ASSUME P) newq in let imp1 = DISCH tm (GEN x' (DISJ_CASES (ASSUME tm) Pth Qth)) in let otm = rand(concl imp1) in let thm1 = SPEC x' (ASSUME otm) in let thm2 = CONTR newq (NOT_MP(ASSUME(mk_neg P))(ASSUME P)) in let thm3 = DISJ2 P (GEN x' (DISJ_CASES thm1 thm2 (ASSUME newq))) in let thm4 = DISJ1 (ASSUME P) (mk_forall(x,Q)) in let imp2 = DISCH otm(DISJ_CASES(SPEC P EXCLUDED_MIDDLE)thm4 thm3) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `RIGHT_OR_FORALL_CONV: expecting "P \\/ (!x.Q)"`;; % --------------------------------------------------------------------- % % FORALL_IMP_CONV, implements the following axiom schemes. % % % % |- (!x. P==>Q[x]) = (P ==> (!x.Q[x])) [x not free in P] % % % % |- (!x. P[x]==>Q) = ((?x.P[x]) ==> Q) [x not free in Q] % % % % |- (!x. P==>Q) = ((?x.P) ==> (!x.Q)) [x not free in P==>Q] % % --------------------------------------------------------------------- % let FORALL_IMP_CONV tm = (let x,(P,Q) = (I # dest_imp) (dest_forall tm) ? failwith `expecting "!x. P ==> Q"` in let fP = free_in x P and fQ = free_in x Q in if (fP & fQ) then failwith `"`^(fst(dest_var x))^`" free on both sides of "==>"` else if fP then let asm = mk_exists(x,P) in let th1 = CHOOSE(x,ASSUME asm)(UNDISCH(SPEC x (ASSUME tm))) in let imp1 = DISCH tm (DISCH asm th1) in let cncl = rand(concl imp1) in let th2 = MP (ASSUME cncl) (EXISTS (asm,x) (ASSUME P)) in let imp2 = DISCH cncl (GEN x (DISCH P th2)) in IMP_ANTISYM_RULE imp1 imp2 else if fQ then let imp1 = DISCH P(GEN x(UNDISCH(SPEC x(ASSUME tm)))) in let cncl = concl imp1 in let imp2 = GEN x (DISCH P(SPEC x(UNDISCH (ASSUME cncl)))) in IMP_ANTISYM_RULE (DISCH tm imp1) (DISCH cncl imp2) else let asm = mk_exists(x,P) in let th1 = GEN x (CHOOSE(x,ASSUME asm)(UNDISCH(SPEC x (ASSUME tm)))) in let imp1 = DISCH tm (DISCH asm th1) in let cncl = rand(concl imp1) in let th2 = SPEC x (MP (ASSUME cncl) (EXISTS (asm,x) (ASSUME P))) in let imp2 = DISCH cncl (GEN x (DISCH P th2)) in IMP_ANTISYM_RULE imp1 imp2) ?\st failwith `FORALL_IMP_CONV: ` ^ st;; % --------------------------------------------------------------------- % % LEFT_IMP_EXISTS_CONV, implements the following theorem-scheme: % % % % |- (?x. t1[x]) ==> t2 = !x'. t1[x'] ==> t2 % % % % where x' is a variant of x chosen not to be free in (?x.t1[x])==>t2 % % % % Author: Tom Melham % % Revised: [TFM 90.07.01] % %---------------------------------------------------------------------- % let LEFT_IMP_EXISTS_CONV tm = (let t1,t2 = dest_imp tm in let x,t = dest_exists t1 in let x' = variant (frees tm) x in let t' = subst [x',x] t in let th1 = GEN x' (DISCH t'(MP(ASSUME tm)(EXISTS(t1,x')(ASSUME t')))) in let rtm = concl th1 in let th2 = CHOOSE (x',ASSUME t1) (UNDISCH(SPEC x'(ASSUME rtm))) in IMP_ANTISYM_RULE (DISCH tm th1) (DISCH rtm (DISCH t1 th2))) ? failwith `LEFT_IMP_EXISTS_CONV: expecting "(?x.P) ==> Q"`;; % --------------------------------------------------------------------- % % RIGHT_IMP_FORALL_CONV, implements the following theorem-scheme: % % % % |- (t1 ==> !x. t2) = !x'. t1 ==> t2[x'/x] % % % % where x' is a variant of x chosen not to be free in the input term. % %---------------------------------------------------------------------- % let RIGHT_IMP_FORALL_CONV tm = (let t1,t2 = dest_imp tm in let x,t = dest_forall t2 in let x' = variant (frees tm) x in let t' = subst [x',x] t in let imp1 = DISCH tm (GEN x' (DISCH t1(SPEC x'(UNDISCH(ASSUME tm))))) in let ctm = rand(concl imp1) in let alph = GEN_ALPHA_CONV x (mk_forall(x',t')) in let thm1 = EQ_MP alph (GEN x'(UNDISCH (SPEC x' (ASSUME ctm)))) in let imp2 = DISCH ctm (DISCH t1 thm1) in IMP_ANTISYM_RULE imp1 imp2) ? failwith `RIGHT_IMP_FORALL_CONV: expecting "P ==> (!x.Q)"`;; % --------------------------------------------------------------------- % % EXISTS_IMP_CONV, implements the following axiom schemes. % % % % |- (?x. P==>Q[x]) = (P ==> (?x.Q[x])) [x not free in P] % % % % |- (?x. P[x]==>Q) = ((!x.P[x]) ==> Q) [x not free in Q] % % % % |- (?x. P==>Q) = ((!x.P) ==> (?x.Q)) [x not free in P==>Q] % % --------------------------------------------------------------------- % let EXISTS_IMP_CONV tm = (let x,(P,Q) = (I # dest_imp) (dest_exists tm) ? failwith `expecting "?x. P ==> Q"` in let fP = free_in x P and fQ = free_in x Q in if (fP & fQ) then failwith `"`^(fst(dest_var x))^`" free on both sides of "==>"` else if fP then let allp = mk_forall(x,P) in let th1 = SPEC x (ASSUME allp) in let thm1 = MP (ASSUME(mk_imp(P,Q))) th1 in let imp1 = DISCH tm (CHOOSE(x,ASSUME tm)(DISCH allp thm1)) in let otm = rand(concl imp1) in let thm2 = EXISTS(tm,x)(DISCH P (UNDISCH(ASSUME otm))) in let nex = mk_exists(x,mk_neg P) in let asm1 = EXISTS (nex, x) (ASSUME (mk_neg P)) in let th2 = CCONTR P (NOT_MP (ASSUME (mk_neg nex)) asm1) in let th3 = CCONTR nex (NOT_MP (ASSUME (mk_neg allp)) (GEN x th2)) in let thm4 = DISCH P (CONTR Q (UNDISCH (ASSUME (mk_neg P)))) in let thm5 = CHOOSE(x,th3)(EXISTS(tm,x)thm4) in let thm6 = DISJ_CASES (SPEC allp EXCLUDED_MIDDLE) thm2 thm5 in IMP_ANTISYM_RULE imp1 (DISCH otm thm6) else if fQ then let thm1 = EXISTS (mk_exists(x,Q),x) (UNDISCH(ASSUME(mk_imp(P,Q)))) in let imp1 = DISCH tm (CHOOSE(x,ASSUME tm) (DISCH P thm1)) in let thm2 = UNDISCH (ASSUME (rand(concl imp1))) in let thm3 = CHOOSE (x,thm2) (EXISTS (tm,x) (DISCH P (ASSUME Q))) in let thm4 = EXISTS(tm,x)(DISCH P(CONTR Q(UNDISCH(ASSUME(mk_neg P)))))in let thm5 = DISJ_CASES (SPEC P EXCLUDED_MIDDLE) thm3 thm4 in IMP_ANTISYM_RULE imp1 (DISCH(rand(concl imp1)) thm5) else let eQ = mk_exists(x,Q) and aP = mk_forall(x,P) in let thm1 = EXISTS(eQ,x)(UNDISCH(ASSUME(mk_imp(P,Q)))) in let thm2 = DISCH aP (PROVE_HYP (SPEC x (ASSUME aP)) thm1) in let imp1 = DISCH tm (CHOOSE(x,ASSUME tm) thm2) in let thm2 = CHOOSE(x,UNDISCH (ASSUME (rand(concl imp1)))) (ASSUME Q) in let thm3 = DISCH P (PROVE_HYP (GEN x (ASSUME P)) thm2) in let imp2 = DISCH (rand(concl imp1)) (EXISTS(tm,x) thm3) in IMP_ANTISYM_RULE imp1 imp2) ?\st failwith `EXISTS_IMP_CONV: ` ^ st;; % --------------------------------------------------------------------- % % LEFT_IMP_FORALL_CONV, implements the following theorem-scheme: % % % % |- (!x. t1[x]) ==> t2 = ?x'. t1[x'] ==> t2 % % % % where x' is a variant of x chosen not to be free in the input term % %---------------------------------------------------------------------- % let LEFT_IMP_FORALL_CONV tm = (let allt1,t2 = dest_imp tm in let (x,t1) = dest_forall allt1 in let x' = variant (frees tm) x in let t1' = subst [x',x] t1 in let th1 = SPEC x' (ASSUME allt1) in let thm1 = MP (ASSUME(mk_imp(t1',t2))) th1 in let otm = mk_exists(x',mk_imp(t1',t2)) in let imp1 = DISCH otm (CHOOSE(x',ASSUME otm)(DISCH allt1 thm1)) in let thm2 = EXISTS(otm,x') (DISCH t1' (UNDISCH(ASSUME tm))) in let nex = mk_exists(x',mk_neg t1') in let asm1 = EXISTS (nex, x') (ASSUME (mk_neg t1')) in let th2 = CCONTR t1' (NOT_MP (ASSUME (mk_neg nex)) asm1) in let th3 = CCONTR nex (NOT_MP (ASSUME (mk_neg allt1)) (GEN x' th2)) in let thm4 = DISCH t1' (CONTR t2 (UNDISCH (ASSUME (mk_neg t1')))) in let thm5 = CHOOSE(x',th3)(EXISTS(mk_exists(x',concl thm4),x')thm4) in let thm6 = DISJ_CASES (SPEC allt1 EXCLUDED_MIDDLE) thm2 thm5 in IMP_ANTISYM_RULE (DISCH tm thm6) imp1) ? failwith `LEFT_IMP_FORALL_CONV: expecting "(!x.P) ==> Q"`;; % --------------------------------------------------------------------- % % RIGHT_IMP_EXISTS_CONV, implements the following theorem-scheme: % % % % |- (t1 ==> ?x. t2) = ?x'. t1 ==> t2[x'/x] % % % % where x' is a variant of x chosen not to be free in the input term. % %---------------------------------------------------------------------- % let RIGHT_IMP_EXISTS_CONV tm = (let t1,(x,t2) = (I # dest_exists) (dest_imp tm) in let x' = variant (frees tm) x in let t2' = subst [x',x] t2 in let otm = mk_exists(x',mk_imp(t1,t2')) in let thm1 = EXISTS(mk_exists(x,t2),x')(UNDISCH(ASSUME(mk_imp(t1,t2')))) in let imp1 = DISCH otm (CHOOSE(x',ASSUME otm) (DISCH t1 thm1)) in let thm2 = UNDISCH (ASSUME tm) in let thm3 = CHOOSE (x',thm2) (EXISTS (otm,x') (DISCH t1 (ASSUME t2'))) in let thm4 = DISCH t1 (CONTR t2'(UNDISCH(ASSUME(mk_neg t1)))) in let thm5 = EXISTS(otm,x') thm4 in let thm6 = DISJ_CASES (SPEC t1 EXCLUDED_MIDDLE) thm3 thm5 in IMP_ANTISYM_RULE (DISCH tm thm6) imp1) ? failwith `RIGHT_IMP_EXISTS_CONV: expecting "Q ==> (?x.P)"`;; % --------------------------------------------------------------------- % % X_SKOLEM_CONV : introduce a skolem function. % % % % |- (!x1...xn. ?y. tm[x1,...,xn,y]) % % = % % (?f. !x1...xn. tm[x1,..,xn,f x1 ... xn] % % % % The first argument is the function f. % % % % Changed to fail unless there is at least one variable x1..xn. % % [JRH 93.02.05] % % --------------------------------------------------------------------- % let X_SKOLEM_CONV v = if (not(is_var v)) then failwith `X_SKOLEM_CONV: first argument not a variable` else \tm. (let xs,(y,P) = (assert($not o null) # dest_exists) (strip_forall tm) ? failwith `expecting "!x1...xn. ?y.tm"` in let fx = list_mk_comb(v,xs) ? failwith `function variable has the wrong type` in if (free_in v tm) then failwith `"`^(fst(dest_var v))^`" free in the input term` else let pat = mk_exists(v,list_mk_forall(xs,subst[fx,y]P)) in let fn = list_mk_abs(xs,mk_select(y,P)) in let bth = SYM(LIST_BETA_CONV (list_mk_comb(fn,xs))) in let thm1 = SUBST [bth,y] P (SELECT_RULE (SPECL xs (ASSUME tm))) in let imp1 = DISCH tm (EXISTS (pat,fn) (GENL xs thm1)) in let thm2 = SPECL xs (ASSUME (snd(dest_exists pat))) in let thm3 = GENL xs (EXISTS (mk_exists(y,P),fx) thm2) in let imp2 = DISCH pat (CHOOSE (v,ASSUME pat) thm3) in IMP_ANTISYM_RULE imp1 imp2) ?\st failwith `X_SKOLEM_CONV: ` ^st;; % --------------------------------------------------------------------- % % SKOLEM_CONV : introduce a skolem function. % % % % |- (!x1...xn. ?y. tm[x1,...,xn,y]) % % = % % (?y'. !x1...xn. tm[x1,..,xn,y' x1 ... xn] % % % % Where y' is a primed variant of y not free in the input term. % % --------------------------------------------------------------------- % let SKOLEM_CONV = let mkfty tm ty = mk_type(`fun`,[type_of tm;ty]) in \tm. (let xs,(y,P) = (I # dest_exists) (strip_forall tm) in let fv = mk_var(fst(dest_var y), itlist mkfty xs (type_of y)) in X_SKOLEM_CONV (variant (frees tm) fv) tm) ? failwith `expecting "!x1...xn. ?y.tm"`;; % --------------------------------------------------------------------- % % SYM_CONV : a conversion for symmetry of equality. % % % % e.g. SYM_CONV "x=y" ----> (x=y) = (y=x). % % % % Replaced by version below: TFM 88.03.31 % % --------------------------------------------------------------------- % let SYM_CONV tm = (let lhs,rhs = dest_eq tm in SPECL [lhs;rhs] (INST_TYPE [type_of lhs,":*"] EQ_SYM_EQ)) ? failwith `SYM_CONV`;; % First a function for converting a conversion to a rule % % A |- t1 = t2 -------------- (t2' got from t2 using a conversion) A |- t1 = t2' % let RIGHT_CONV_RULE conv th = th TRANS (conv(rhs(concl th)));; % --------------------------------------------------------------------- % % FUN_EQ_CONV "f = g" returns: |- (f = g) = !x. (f x = g x). % % % % Notes: f and g must be functions. The conversion choses an "x" not % % free in f or g. This conversion just states that functions are equal % % IFF the results of applying them to an arbitrary value are equal. % % % % New version: TFM 88.03.31 % % --------------------------------------------------------------------- % let FUN_EQ_CONV tm = let vars = frees tm in let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in if op = `fun` then let varnm = if (is_vartype ty1) then `x` else hd(explode(fst(dest_type ty1))) in let x = variant vars (mk_primed_var(varnm,ty1)) in let imp1 = DISCH_ALL (GEN x (AP_THM (ASSUME tm) x)) in let asm = ASSUME (concl (GEN x (AP_THM (ASSUME tm) x))) in IMP_ANTISYM_RULE imp1 (DISCH_ALL (EXT asm)) else failwith `FUN_EQ_CONV`;; % --------------------------------------------------------------------- % % X_FUN_EQ_CONV "x" "f = g" % % % % yields |- (f = g) = !x. f x = g x % % % % fails if x free in f or g, or x not of the right type. % % --------------------------------------------------------------------- % let X_FUN_EQ_CONV x tm = (if not(is_var x) then failwith ` first arg is not a variable` else if (mem x (frees tm)) then failwith fst(dest_var x) ^ ` is a free variable` else let l = (lhs tm ? failwith `not an equation`) in let check = assert (\x. x = `fun`) in let _,[ty1;ty2] = ((check # I) (dest_type(type_of l)) ? failwith `lhs and rhs not functions`) in if not (ty1 = type_of x) then failwith fst(dest_var x) ^ ` has the wrong type` else let imp1 = DISCH_ALL (GEN x (AP_THM (ASSUME tm) x)) in let asm = ASSUME (concl (GEN x (AP_THM (ASSUME tm) x))) in IMP_ANTISYM_RULE imp1 (DISCH_ALL (EXT asm))) ?\st failwith `X_FUN_EQ_CONV: ` ^ st;; % --------------------------------------------------------------------- % % CONTRAPOS_CONV: convert an implication to its contrapositive. % % % % CONTRAPOS_CONV "a ==> b" --> |- (a ==> b) = (~b ==> ~a) % % % % Added: TFM 88.03.31 % % Revised: TFM 90.07.13 % % Changed: WW 24 Jan 94 Due to changes in dest_imp and MP % % --------------------------------------------------------------------- % let CONTRAPOS_CONV tm = (let a,c = dest_imp tm in let negc = mk_neg c and contra = mk_imp(mk_neg c,mk_neg a) in let imp1 = DISCH negc (NOT_INTRO (IMP_TRANS(ASSUME tm)(NOT_ELIM(ASSUME negc)))) and imp2 = DISCH a (CCONTR c (UNDISCH (UNDISCH (ASSUME contra)))) in IMP_ANTISYM_RULE (DISCH tm imp1) (DISCH contra imp2)) ? failwith `CONTRAPOS_CONV: input term not an implication`;; % --------------------------------------------------------------------- % % ANTE_CONJ_CONV: convert an implication with conjuncts in its % % antecedant to a series of implications. % % % % ANTE_CONJ_CONV "a1 /\ a2 ==> c" % % ----> |- a1 /\ a2 ==> c = (a1 ==> (a2 ==> c)) % % % % Added: TFM 88.03.31 % % --------------------------------------------------------------------- % let ANTE_CONJ_CONV tm = let (a1,a2),c = (dest_conj # I) (dest_imp tm) in let imp1 = MP (ASSUME tm) (CONJ (ASSUME a1) (ASSUME a2)) and imp2 = LIST_MP [CONJUNCT1 (ASSUME "^a1 /\ ^a2"); CONJUNCT2 (ASSUME "^a1 /\ ^a2")] (ASSUME "^a1 ==> (^a2 ==> ^c)") in IMP_ANTISYM_RULE (DISCH_ALL (DISCH a1 (DISCH a2 imp1))) (DISCH_ALL (DISCH "^a1 /\ ^a2" imp2))? failwith `ANTE_CONJ_CONV`;; % --------------------------------------------------------------------- % % SWAP_EXISTS_CONV: swap the order of existentially quantified vars. % % % % SWAP_EXISTS_CONV "?x y.t[x,y]" ---> |- ?x y.t[x,y] = ?y x.t[x,y] % % % % AUTHOR: Paul Loewenstein 3 May 1988 % % --------------------------------------------------------------------- % let SWAP_EXISTS_CONV xyt = (let x,yt = dest_exists (xyt) in let y, t = dest_exists (yt) in let xt = mk_exists (x, t) in let yxt = mk_exists (y, xt) in IMP_ANTISYM_RULE (DISCH xyt (CHOOSE (x,ASSUME xyt) (CHOOSE (y, (ASSUME yt)) (EXISTS (yxt,y) (EXISTS (xt,x) (ASSUME t)))))) (DISCH yxt (CHOOSE (y,ASSUME yxt) (CHOOSE (x, (ASSUME xt)) (EXISTS (xyt,x) (EXISTS (yt,y) (ASSUME t))))))) ? failwith `SWAP_EXISTS_CONV`;; % --------------------------------------------------------------------- % % RAND_CONV conv "t1 t2" applies conv to t2 % % % % Added TFM 88.03.31 % % Revised TFM 91.03.08 % % Revised RJB 91.04.17 % % --------------------------------------------------------------------- % let RAND_CONV conv tm = let rator,rand = (dest_comb tm ? failwith `RAND_CONV`) in let randth = conv rand in (AP_TERM rator randth ? failwith `RAND_CONV`);; % --------------------------------------------------------------------- % % RATOR_CONV conv "t1 t2" applies conv to t1 % % % % Added TFM 88.03.31 % % Revised TFM 91.03.08 % % Revised RJB 91.04.17 % % --------------------------------------------------------------------- % let RATOR_CONV conv tm = let rator,rand = (dest_comb tm ? failwith `RATOR_CONV`) in let ratorth = conv rator in (AP_THM ratorth rand ? failwith `RATOR_CONV`);; % --------------------------------------------------------------------- % % ABS_CONV conv "\x. t[x]" applies conv to t[x] % % % % Added TFM 88.03.31 % % Revised RJB 91.04.17 % % --------------------------------------------------------------------- % let ABS_CONV conv tm = let bv,body = (dest_abs tm ? failwith `ABS_CONV`) in let bodyth = conv body in (ABS bv bodyth ? failwith `ABS_CONV`);; % --------------------------------------------------------------------- % % SELECT_CONV: a conversion for introducing "?" when P [@x.P[x]]. % % % % SELECT_CONV "P [@x.P [x]]" ---> |- P [@x.P [x]] = ?x. P[x] % % % % Added: TFM 88.03.31 % % % % let SELECT_CONV tm = % % (let epsl = find_terms is_select tm in % % let findfn t = % % subst [t, fst (dest_select t)] (snd (dest_select t)) = tm in % % let sel = find findfn epsl in % % let ex = mk_exists(dest_select sel) in % % let imp1 = DISCH_ALL (SELECT_RULE (ASSUME ex)) and % % imp2 = DISCH_ALL (EXISTS (ex,sel) (ASSUME tm)) in % % IMP_ANTISYM_RULE imp2 imp1) ? failwith `SELECT_CONV`;; % % % % Optimised [JG 92.04.24] % % Bugfix [TFM 92.05.07] % % Generalised [JG 93.10.19] % % --------------------------------------------------------------------- % let SELECT_CONV = let SELECT_THM = let f = "f:*->bool" in let tyv = mk_vartype `*` in let th1 = AP_THM EXISTS_DEF f in let th2 = (CONV_RULE (RAND_CONV BETA_CONV)) th1 in GEN f (SYM th2) in \tm. let right t = is_select t & let (v,b) = dest_select t in aconv tm (subst[t,v] b) in let fn = rand (find_term right tm) in let th1 = ISPEC fn SELECT_THM in let th2 = SYM (BETA_CONV(lhs(concl th1))) in let th3 = ALPHA tm (lhs(concl th2)) in th3 TRANS th2 TRANS th1 ? failwith `SELECT_CONV` ;; % --------------------------------------------------------------------- % % bool_EQ_CONV: conversion for boolean equality. % % % % bool_EQ_CONV "b1 = b2" returns: % % % % |- (b1 = b2) = T if b1 and b2 are identical boolean terms % % |- (b1 = b2) = b2 if b1 = "T" % % |- (b1 = b2) = b1 if b2 = "T" % % % % Added TFM 88.03.31 % % Revised TFM 90.07.24 % % --------------------------------------------------------------------- % let bool_EQ_CONV = let check = let boolty = ":bool" in assert \tm. type_of tm = boolty in let Tb.bT._ = map (GEN "b:bool") (CONJUNCTS(SPEC "b:bool" EQ_CLAUSES)) in let T = "T" and F = "F" in \tm. (let l,r = (I # check) (dest_eq tm) in if (l=r) then EQT_INTRO (REFL l) else if (l=T) then SPEC r Tb else if (r=T) then SPEC l bT else fail) ? failwith `bool_EQ_CONV`;; % --------------------------------------------------------------------- % % EXISTS_UNIQUE_CONV: expands with the definition of unique existence. % % % % % % EXISTS_UNIQUE_CONV "?!x.P[x]" yields the theorem: % % % % |- ?!x.P[x] = ?x.P[x] /\ !x y. P[x] /\ P[y] ==> (x=y) % % % % ADDED: TFM 90.05.06 % % % % REVISED: now uses a variant of x for y in 2nd conjunct [TFM 90.06.11] % % --------------------------------------------------------------------- % let EXISTS_UNIQUE_CONV = let check = assert \c. (fst(dest_const c) = `?!`) in let MK_BIN f (e1,e2) = MK_COMB((AP_TERM f e1),e2) and MK_ALL x y tm = let rule = CONV_RULE o RAND_CONV o GEN_ALPHA_CONV in rule y (FORALL_EQ x tm) and AND = "/\" and IMP = "==>" in let conv (nx,ny) t = let [ox;oy],A,C = (I # dest_imp) (strip_forall t) in let A' = MK_BIN AND ((BETA_CONV # BETA_CONV) (dest_conj A)) in MK_ALL ox nx (MK_ALL oy ny (MK_BIN IMP (A',REFL C))) and v = genvar ":bool" in \tm. (let _,(x,body) = (check # dest_abs) (dest_comb tm) in let def = INST_TYPE [type_of x,":*"] EXISTS_UNIQUE_DEF in let exp = RIGHT_BETA(AP_THM def (mk_abs(x,body))) and y = variant (vars body) x in let eqn = conv (x,y) (rand(rand(concl exp))) in SUBST [eqn,v] (mk_eq(tm,mk_conj(mk_exists(x,body),v))) exp) ? failwith `EXISTS_UNIQUE_CONV: arg must have the form "?!x. P[x]"`;; % --------------------------------------------------------------------- % % COND_CONV: conversion for simplifying conditionals: % % % % --------------------------- COND_CONV "T => u | v" % % |- (T => u | v) = u % % % % % % --------------------------- COND_CONV "F => u | v" % % |- (F => u | v) = v % % % % % % --------------------------- COND_CONV "b => u | u" % % |- (b => u | u) = u % % % % --------------------------- COND_CONV "b => u | v" (u =alpha v) % % |- (b => u | v) = u % % % % COND_CONV "P=>u|v" fails if P is neither "T" nor "F" and u =/= v. % % --------------------------------------------------------------------- % let COND_CONV = let T = "T" and F = "F" and vt = genvar ":*" and vf = genvar ":*" in let gen = GENL [vt;vf] in let CT,CF = (gen # gen) (CONJ_PAIR (SPECL [vt;vf] COND_CLAUSES)) in \tm. let P,u,v = dest_cond tm ? failwith `COND_CONV: not a conditional` in let ty = type_of u in if (P=T) then SPEC v (SPEC u (INST_TYPE [ty,":*"] CT)) else if (P=F) then SPEC v (SPEC u (INST_TYPE [ty,":*"] CF)) else if (u=v) then SPEC u (SPEC P (INST_TYPE [ty,":*"] COND_ID)) else if (aconv u v) then let cnd = AP_TERM (rator tm) (ALPHA v u) in let thm = SPEC u (SPEC P (INST_TYPE [ty,":*"] COND_ID)) in TRANS cnd thm else failwith `COND_CONV: can't simplify conditional` ;; % --------------------------------------------------------------------- % % PAIRED_BETA_CONV: Generalized beta conversions for tupled lambda % % abstractions applied to tuples (i.e. redexes) % % % % Given the term: % % % % "(\(x1, ... ,xn).t) (t1, ... ,tn)" % % % % PAIRED_BETA_CONV proves that: % % % % |- (\(x1, ... ,xn).t) (t1, ... ,tn) = t[t1, ... ,tn/x1, ... ,xn] % % % % where t[t1,...,tn/x1,...,xn] is the result of substituting ti for xi % % in parallel in t, with suitable renaming of variables to prevent % % free variables in t1,...,tn becoming bound in the result. % % % % The conversion works for arbitrarily nested tuples. For example: % % % % PAIRED_BETA_CONV "(\((a,b),(c,d)).t) ((1,2),(3,4))" % % % % gives: % % % % |- (\((a,b),(c,d)).t) ((1,2),(3,4)) = t[1,2,3,4/a,b,c,d] % % % % Bugfix: INST used instead of SPEC to avoid priming. [TFM 91.04.17] % % --------------------------------------------------------------------- % let PAIRED_BETA_CONV = let vs = map genvar [":* -> (** -> ***)";":*";":**"] in let DEF = SPECL vs UNCURRY_DEF in let check = assert \t.(fst(dest_const t)) = `UNCURRY` in let RBCONV = RATOR_CONV BETA_CONV THENC BETA_CONV in letrec conv tm = let (_,f),x,y = (((check # I)o dest_comb) # dest_pair)(dest_comb tm) in let [t1;ty'] = snd(dest_type (type_of f)) in let [t2;t3] = snd(dest_type ty') in let inst = INST_TYPE [t1,":*";t2,":**";t3,":***"] DEF in let fv,[xv;yv] = strip_comb(rand(concl inst)) in let def = INST [y,yv;x,xv;f,fv] inst in if (is_abs f) then if (is_abs (snd(dest_abs f))) then TRANS def (RBCONV (rhs(concl def))) else let thm = AP_THM (BETA_CONV (mk_comb(f,x))) y in TRANS def (CONV_RULE (RAND_CONV conv) thm) else let rec = conv (rator(rand(concl def))) in if (is_abs (rhs(concl rec))) then TRANS def (RIGHT_BETA (AP_THM rec y)) else let thm = conv(mk_comb(rhs(concl rec),y)) in TRANS def (TRANS (AP_THM rec y) thm) in \tm. conv tm ? failwith `PAIRED_BETA_CONV`;; %-------------------------------------------------------% % PAIRED_ETA_CONV "\(x1,.(..).,xn). P (x1,.(..).,xn)" = % % |- \(x1,.(..).,xn). P (x1,.(..).,xn) = P % % [JRH 91.07.17] % %-------------------------------------------------------% let PAIRED_ETA_CONV = let pthm = GEN_ALL (SYM (SPEC_ALL PAIR)) in letrec pairify tm = (let step = ISPEC tm pthm in let res = rhs (concl step) in let ((pop,l),r) = (dest_comb #I) (dest_comb res) in TRANS step (MK_COMB(AP_TERM pop (pairify l),pairify r))) ? REFL tm in \tm. (let (vs,bod) = dest_pabs tm in let (f,_) = (I # assert (curry $= vs)) (dest_comb bod) in let xv = mk_var(`x`,type_of vs) in let peq = pairify xv in let par = rhs (concl peq) in let bth = PAIRED_BETA_CONV (mk_comb(tm,par)) in EXT (GEN xv (SUBS [SYM peq] bth))) ? failwith `PAIRED_ETA_CONV`;; %--------------------------------------------------------------------% % GEN_BETA_CONV - reduces single or paired abstractions, introducing % % arbitrarily nested "FST" and "SND" if the rand is not sufficiently % % paired. Example: % % % % #GEN_BETA_CONV "(\(x,y). x + y) numpair";; % % |- (\(x,y). x + y)numpair = (FST numpair) + (SND numpair) % % [JRH 91.07.17] % %--------------------------------------------------------------------% let GEN_BETA_CONV = let ucheck = assert (curry$= `UNCURRY` o fst o dest_const) and pair = CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) PAIR and uncth = SPEC_ALL UNCURRY_DEF in letrec gbc tm = let (abst,arg) = dest_comb tm in if is_abs abst then BETA_CONV tm else let (unc,ran) = (ucheck # I) (dest_comb abst) in let eqv = (is_pair arg) => REFL arg | ISPEC arg pair in let (l,r) = dest_pair (rhs (concl eqv)) in let res = AP_TERM abst eqv in let rt0 = TRANS res (PART_MATCH lhs uncth (rhs (concl res))) in let (tm1a,tm1b) = dest_comb (rhs (concl rt0)) in let rt1 = AP_THM (gbc tm1a) tm1b in let tm2 = rhs (concl rt1) in let rt2 = gbc tm2 in rt0 TRANS rt1 TRANS rt2 in \tm. gbc tm ? failwith `GEN_BETA_CONV`;; begin_section let_CONV;; % --------------------------------------------------------------------- % % Internal function: ITER_BETA_CONV (iterated, tupled beta-conversion). % % % % The conversion ITER_BETA_CONV reduces terms of the form: % % % % (\v1 v2...vn.tm) x1 x2 ... xn xn+1 ... xn+i % % % % where the v's can be varstructs. The behaviour is similar to % % LIST_BETA_CONV, but this function also does paired abstractions. % % --------------------------------------------------------------------- % letrec ITER_BETA_CONV tm = (let rat,rnd = dest_comb tm in let thm = AP_THM (ITER_BETA_CONV rat) rnd in let redex = rand(concl thm) in let red = TRY_CONV(BETA_CONV ORELSEC PAIRED_BETA_CONV) redex in TRANS thm red) ? REFL tm;; % --------------------------------------------------------------------- % % Internal function: ARGS_CONV (apply a list of conversions to the % % arguments of a curried function application). % % % % ARGS_CONV [conv1;...;convn] "f a1 ... an" applies convi to ai. % % --------------------------------------------------------------------- % let ARGS_CONV = letrec appl fs as = if (null fs) then (null as => [] | failwith `appl`) else ((hd fs)(hd as)) . appl (tl fs) (tl as) in \cs tm. let f,ths = (I # appl cs) (strip_comb tm) in rev_itlist (C (curry MK_COMB)) ths (REFL f);; % --------------------------------------------------------------------- % % Internal function RED_WHERE. % % % % Given the arguments "f" and "tm[f]", this function produces a % % conversion that will apply ITER_BETA_CONV to its argument at all % % subterms that correspond to occurrences of f (bottom-up). % % --------------------------------------------------------------------- % letrec RED_WHERE fn body = if ((is_var body) or (is_const body)) then REFL else ((let _,bd = dest_abs body in ABS_CONV (RED_WHERE fn bd)) ? let f,args = strip_comb body in if (f=fn) then ARGS_CONV (map(RED_WHERE fn)args) THENC ITER_BETA_CONV else let f,a = dest_comb body in (RAND_CONV(RED_WHERE fn a)) THENC (RATOR_CONV (RED_WHERE fn f)));; % --------------------------------------------------------------------- % % Internal function: REDUCE % % % % This function does the appropriate beta-reductions in the result of % % expanding a let-term. For terms of the form: % % % % "let f x1 ... xn = t in tm[f]" % % % % we have that: % % % % th |- = tm[\x1 ... xn. t/f] % % % % And the arguments x and f will be: % % % % x = \x1 ... xn. t % % f = \f. tm[f] % % % % REDUCE searches in tm[f] for places in which f occurs, and then does % % an iterated beta-reduction (possibly of varstruct-abstractions) in % % the right-hand side of the input theorem th, at the places that % % correspond to occurrences of f in tm[f]. % % --------------------------------------------------------------------- % let REDUCE = let is_uncurry tm = (fst(dest_const(rator tm)) = `UNCURRY`) ? false in \f x th. if (not((is_abs x) or (is_uncurry x))) then th else let (fn,body) = dest_abs f in CONV_RULE (RAND_CONV (RED_WHERE fn body)) th;; % --------------------------------------------------------------------- % % let_CONV: conversion for reducing "let" terms. % % % % Given a term: % % % % "let v1 = x1 and ... and vn = xn in tm[v1,...,vn]" % % % % let_CONV proves that: % % % % |- let v1 = x1 and ... and vn = xn in tm[v1,...,vn] % % = % % tm[x1,...,xn/v1,...,vn] % % % % where t[t1,...,tn/x1,...,xn] is the result of "substituting" the % % value xi for vi in parallel in tm (see below). % % % % Note that the vi's can take any one of the following forms: % % % % Variables: "x" etc. % % Tuples: "(x,y)" "(a,b,c)" "((a,b),(c,d))" etc. % % Applications: "f (x,y) z" "f x" etc. % % % % Variables are just substituted for. With tuples, the substitution is % % done component-wise, and function applications are effectively % % rewritten in the body of the let-term. % % --------------------------------------------------------------------- % let let_CONV = let v1 = ":*" and v2 = ":**" in let def = definition `bool` `LET_DEF` in let ista tm = ((fst(dest_const(rator tm)) = `UNCURRY`) ? false) in letrec conv tm = let f,x = (dest_let tm) in let _,[ty1;ty2] = dest_type(type_of f) in let defn = INST_TYPE [ty1,v1; ty2,v2] def in let thm = RIGHT_BETA(AP_THM(RIGHT_BETA(AP_THM defn f))x) in if (is_abs f) then REDUCE f x (RIGHT_BETA thm) else if (ista f) then CONV_RULE (RAND_CONV PAIRED_BETA_CONV) thm else let thm1 = AP_THM(AP_TERM (rator(rator tm)) (conv f))x in CONV_RULE (RAND_CONV conv) thm1 in \tm. conv tm ? failwith `let_CONV: cannot reduce the let`;; let_CONV;; end_section let_CONV;; let let_CONV = it;; % ===================================================================== % % Rules defined using conversions. % % ===================================================================== % % --------------------------------------------------------------------- % % EXISTENCE: derives existence from unique existence: % % % % |- ?!x. P[x] % % -------------------- % % |- ?x. P[x] % % % % --------------------------------------------------------------------- % let EXISTENCE = let EXISTS_UNIQUE_DEF = definition `bool` `EXISTS_UNIQUE_DEF` in let P = "P:*->bool" in let th1 = SPEC P (CONV_RULE (X_FUN_EQ_CONV P) EXISTS_UNIQUE_DEF) in let th2 = CONJUNCT1(UNDISCH(fst(EQ_IMP_RULE(RIGHT_BETA th1)))) in let imp = GEN P (DISCH "$?! ^P" th2) in let dest = let check = assert \c. (fst(dest_const c) = `?!`) in (dest_abs o snd) o (check # I) o dest_comb in \th. (let (x,P) = dest (concl th) in let ty = type_of x in MP (SPEC(mk_abs(x,P)) (INST_TYPE [ty,":*"] imp)) th) ? failwith `EXISTENCE: input thm have the form |- ?!x. tm`;; %------------------------------------------------------------------------% % AC_CONV - Prove equality using associative + commutative laws % % % % The conversion is given an associative and commutative law (it deduces % % the relevant operator and type from these) in the form of the inbuilt % % ones, and an equation to prove. It will try to prove this. Example: % % % % AC_CONV(ADD_ASSOC,ADD_SYM) "(1 + 3) + (2 + 4) = 4 + (3 + (2 + 1))" % % [JRH 91.07.17] % %------------------------------------------------------------------------% let AC_CONV(associative,commutative) tm = (let op = (rator o rator o lhs o snd o strip_forall o concl) commutative in let ty = (hd o snd o dest_type o type_of) op in let x = mk_var(`x`,ty) and y = mk_var(`y`,ty) and z = mk_var(`z`,ty) in let xy = mk_comb(mk_comb(op,x),y) and yz = mk_comb(mk_comb(op,y),z) and yx = mk_comb(mk_comb(op,y),x) in let comm = PART_MATCH I commutative (mk_eq(xy,yx)) and ass = PART_MATCH I (SYM (SPEC_ALL associative)) (mk_eq(mk_comb(mk_comb(op,xy),z),mk_comb(mk_comb(op,x),yz))) in let asc = TRANS (SUBS [comm] (SYM ass)) (INST[(x,y); (y,x)] ass) in let init = TOP_DEPTH_CONV (REWR_CONV ass) tm in let gl = rhs (concl init) in letrec bubble head expr = let ((xop,l),r) = (dest_comb # I) (dest_comb expr) in if xop = op then if l = head then REFL expr else if r = head then INST [(l,x); (r,y)] comm else let subb = bubble head r in let eqv = AP_TERM (mk_comb(xop,l)) subb and ((yop,l'),r') = (dest_comb # I) (dest_comb (snd (dest_eq (concl subb)))) in TRANS eqv (INST[(l,x); (l',y); (r',z)] asc) else fail in letrec asce (l,r) = if l = r then REFL l else let ((zop,l'),r') = (dest_comb # I) (dest_comb l) in if zop = op then let beq = bubble l' r in let rt = snd (dest_eq (concl beq)) in TRANS (AP_TERM (mk_comb(op,l')) (asce ((snd (dest_comb l)),(snd (dest_comb rt))))) (SYM beq) else fail in EQT_INTRO (EQ_MP (SYM init) (asce (dest_eq gl)))) ? failwith `AC_CONV`;; %------------------------------------------------------------------------% % GSYM - General symmetry rule % % % % Reverses the first equation(s) encountered in a top-down search. % % % % [JRH 92.03.28] % %------------------------------------------------------------------------% let GSYM = CONV_RULE(ONCE_DEPTH_CONV SYM_CONV);; hol88-2.02.19940316/ml/lib_loader.ml0000640000212700021270000001713605376374102015001 0ustar cammcamm% ===================================================================== % % FILE : lib_loader.ml % % DESCRIPTION : A function for loading library into hol % % % % AUTHOR : Wai Wong % % DATE : 14 May 1993 % % ===================================================================== % %< --------------------------------------------------------------------- % This file defines a generic library loader as an ML function named library_loader. It carries out the standard loading procedures for loading the library. A library consists of three parts: theories, codes and document. Any of these may be absent. The standard procedures of loading a library are: 1) update the system search path to include the library directory; 2) load any libraries on which the current library depends; 3) load the theories (if there are any); 4) load the codes (if there are any); 5) update the help search path to include the current library document; 6) set up auto-loading of theorems, definitions, etc. When a library, say foo, is loaded into a HOL session by evaluating load_library `foo`;; This will load a file named `foo.ml` in the directory `foo` which is in the library seaarch path. The generic library loader, namely library_loader, should be called with appropriate arguments in this file. (See the libraries auxiliary or more_lists for an example of calling this.) In addition, other functions may be called in this file to set up special environment necessary for working with the library. If one is not in draft mode, a library may not be loaded completely. In such case, a function whose name is created by prefixing the name of the library with `load_` is defined. This function can be called later to complete the loading. The definition of this library loading function is done dynamically by the ML function define_load_lib_function. Due to the way it is called by `let_before`, it can take only a single argument, a string list. The information passed in this list consists of the library name, the names of theories and the names of the code files. The library name is the first string in the list and it is mandatory. The theory names and code file names follow, and they are separated by a null string. Both of these are optional. E.g. the simplest case is [`lib_name`; ``]. ----------------------------------------------------------------------->% let define_load_lib_function args = let split_args lst = let (lib_name.rest) = args in let (thy,cod) = splitp (\x.x=``) rest in (lib_name,thy,tl cod) in let lib_path = library_pathname () in let autoload_defs_and_thms thy = (map (\name. autoload_theory(`definition`,thy,name)) (map fst (definitions thy)); map (\name. autoload_theory(`theorem`,thy,name)) (map fst (theorems thy)); ()) in let (lib_name, theories, codes) = split_args args in \(v:void). if (mem lib_name (ancestry())) then (print_string (`Loading contents of `^lib_name^`...`); print_newline(); let path st = (lib_path ^ `/` ^ lib_name ^ `/` ^ st) in (map (\name. load(path name, get_flag_value `print_lib`)) codes); (map autoload_defs_and_thms theories); (map delete_cache theories); ()) else failwith (`theory `^lib_name^` not an ancestor of the current theory`);; %<-------------------------------------------------------------------------- The loader function library_loader takes a 6-tuple as its argument. The fields of this are: lib_name : string --- the name of the library. It should be the name of the directory where the library is found, and the basename of the load file. parent_libs : string list --- the names of the library on which the current library depends. They will be loaded in the order given. theories : string list --- the names of the theories in this library. If the library contains more than one theory, the descendant of all other theories should be the first in the list. This will be loaded and becomes the current theory or the new parent of the current theory. The order of other names is not important. The axioms, definitions and theorems in all the theories listed are set up to be autoloaded. codes : string list --- the names of the code files. They will be loaded in the order given. load_parent : string --- the name of a file to be loaded before the code files are loaded. If we are not currently in draft mode, the parent libraries may not be loaded completely. Instead, functions having name prefixed by `load_` will be defined. These functions can be called in the file specified with this argument to complete the loading of the parent library. part_path : string --- the directory name of the library part. If only part of the library is loaded, the lib_name string should have the part separator `:` in it, e.g. `lib:part`. It such case, the files of the library part may reside in a sub-directory. The name of this sub-directory is specified by this field, and it is added to the search path. help_paths : string list --- the names of directories containing the help files. These are relative to the subdirectory `help` of the library. They are added to the help_search_path. ------------------------------------------------------------------------->% let library_loader = let autoload_defs_and_thms thy = (map (\name. autoload_theory(`definition`,thy,name)) (map fst (definitions thy)); map (\name. autoload_theory(`theorem`,thy,name)) (map fst (theorems thy)); () ) in \(lib_name, parent_libs, theories, codes, load_parent, part_path, help_paths). let path = let root,part = splitp (\c.c = `:`) (explode lib_name) in if (null part) then (library_pathname() ^ `/` ^ lib_name ^ `/`) else (if (part_path = ``) then (library_pathname() ^ `/` ^ (implode root) ^ `/`) else (library_pathname() ^ `/` ^ (implode root) ^ `/` ^ part_path ^ `/`)) in let top_thy = if null theories then `` else (hd theories) in (% Update the search path % print_string `Updating search path`; print_newline(); set_search_path (union (search_path()) [path]); % Loading parent libraries % map load_library parent_libs; % Load (or attempt to load) the theory provided by this library % if not(top_thy = ``) then (if draft_mode() then (print_string (`Declaring theory `^top_thy^` a new parent`); print_newline(); new_parent top_thy) else (load_theory top_thy ? (print_string (`Defining ML function load_`^lib_name); print_newline() ; let_before((`load_`^lib_name), `define_load_lib_function`, (lib_name. (theories @ (``. codes)))); ()))); % Load compiled code if possible % if (draft_mode() or (current_theory() = top_thy) or (top_thy=``)) then (if not((draft_mode()) or (load_parent=``)) then loadf load_parent; map (\name. load( name, get_flag_value `print_lib`)) codes; ()); % Update online help path % let helppaths = if null help_paths then [(path ^ `/help/`)] else map (\s. path ^ `/help/` ^ s ^ `/`) help_paths in (print_string `Updating help search path`; print_newline(); set_help_search_path (union helppaths (help_search_path()))); % Set up autoloading of theorems and definitions % if (draft_mode() or (current_theory() = top_thy)) then (map autoload_defs_and_thms theories; map delete_cache theories; ()); ());; hol88-2.02.19940316/ml/load_thms.ml0000640000212700021270000006676305541570635014674 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: load_thms.ml % % % % DESCRIPTION: Definitions and theorems autoloaded into HOL % % % % AUTHOR: T. F. Melham (88.04.04) % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: MJCG 5/2/89 loading replaced by autoloading % %=============================================================================% % --------------------------------------------------------------------- % % THEORY: one % % --------------------------------------------------------------------- % map autoload_theory [`theorem`, `one`, `one_axiom`; `theorem`, `one`, `one`; `theorem`, `one`, `one_Axiom`];; % --------------------------------------------------------------------- % % THEORY: combin % % --------------------------------------------------------------------- % map autoload_theory [`definition`, `combin`, `o_DEF`; `definition`, `combin`, `K_DEF`; `definition`, `combin`, `S_DEF`; `definition`, `combin`, `I_DEF`; `theorem`, `combin`, `o_THM`; `theorem`, `combin`, `o_ASSOC`; `theorem`, `combin`, `K_THM`; `theorem`, `combin`, `S_THM`; `theorem`, `combin`, `I_THM`; `theorem`, `combin`, `I_o_ID`];; % --------------------------------------------------------------------- % % THEORY: sum % % --------------------------------------------------------------------- % map autoload_theory [`theorem`, `sum`, `sum_Axiom`; `theorem`, `sum`, `sum_axiom`; `definition`, `sum`, `ISL`; `definition`, `sum`, `ISR`; `definition`, `sum`, `OUTL`; `definition`, `sum`, `OUTR`; `theorem`, `sum`, `ISL_OR_ISR`; `theorem`, `sum`, `INL`; `theorem`, `sum`, `INR`];; % --------------------------------------------------------------------- % % THEORY: fun % % --------------------------------------------------------------------- % map autoload_theory [`definition`, `fun`, `ASSOC_DEF`; `definition`, `fun`, `COMM_DEF`; `definition`, `fun`, `FCOMM_DEF`; `definition`, `fun`, `RIGHT_ID_DEF`; `definition`, `fun`, `LEFT_ID_DEF`; `definition`, `fun`, `MONOID_DEF`; `theorem`, `fun`, `ASSOC_CONJ`; `theorem`, `fun`, `ASSOC_DISJ`; `theorem`, `fun`, `FCOMM_ASSOC`; `theorem`, `fun`, `MONOID_CONJ_T`; `theorem`, `fun`, `MONOID_DISJ_F`];; % --------------------------------------------------------------------- % % THEORY: num % % --------------------------------------------------------------------- % map autoload_theory [`theorem`, `num`, `NOT_SUC`; `theorem`, `num`, `INV_SUC`; `theorem`, `num`, `INDUCTION`];; % --------------------------------------------------------------------- % % THEORY: prim_rec % % --------------------------------------------------------------------- % map autoload_theory [`theorem`, `prim_rec`, `INV_SUC_EQ`; `theorem`, `prim_rec`, `LESS_REFL`; `theorem`, `prim_rec`, `SUC_LESS`; `theorem`, `prim_rec`, `NOT_LESS_0`; `theorem`, `prim_rec`, `LESS_MONO`; `theorem`, `prim_rec`, `LESS_SUC_REFL`; `theorem`, `prim_rec`, `LESS_SUC`; `theorem`, `prim_rec`, `LESS_THM`; `theorem`, `prim_rec`, `LESS_SUC_IMP`; `theorem`, `prim_rec`, `LESS_0`; `theorem`, `prim_rec`, `EQ_LESS`; `theorem`, `prim_rec`, `SUC_ID`; `theorem`, `prim_rec`, `NOT_LESS_EQ`; `theorem`, `prim_rec`, `LESS_NOT_EQ`; `theorem`, `prim_rec`, `LESS_SUC_SUC`; `theorem`, `prim_rec`, `PRE`; `theorem`, `prim_rec`, `num_Axiom`];; % --------------------------------------------------------------------- % % THEORY: arithmetic % % --------------------------------------------------------------------- % map autoload_theory [`definition`, `arithmetic`, `GREATER`; `definition`, `arithmetic`, `LESS_OR_EQ`; `definition`, `arithmetic`, `GREATER_OR_EQ`; `definition`, `arithmetic`, `DIVISION`; `definition`, `arithmetic`, `ADD`; `definition`, `arithmetic`, `MULT`; `definition`, `arithmetic`, `SUB`; `definition`, `arithmetic`, `EXP`; `definition`, `arithmetic`, `FACT`; `definition`, `arithmetic`, `EVEN`; `definition`, `arithmetic`, `ODD`; `theorem`, `arithmetic`, `ADD_SUC`; `theorem`, `arithmetic`, `ADD_CLAUSES`; `theorem`, `arithmetic`, `ADD_SYM`; `theorem`, `arithmetic`, `ADD_SUC`; `theorem`, `arithmetic`, `num_CASES`; `theorem`, `arithmetic`, `LESS_MONO_EQ`; `theorem`, `arithmetic`, `SUC_SUB1`; `theorem`, `arithmetic`, `PRE_SUB1`; `theorem`, `arithmetic`, `LESS_ADD`; `theorem`, `arithmetic`, `SUB_0`; `theorem`, `arithmetic`, `LESS_TRANS`; `theorem`, `arithmetic`, `ADD1`; `theorem`, `arithmetic`, `ADD_0`; `theorem`, `arithmetic`, `LESS_ANTISYM`; `theorem`, `arithmetic`, `LESS_LESS_SUC`; `theorem`, `arithmetic`, `FUN_EQ_LEMMA`; `theorem`, `arithmetic`, `LESS_SUC_EQ_COR`; `theorem`, `arithmetic`, `LESS_OR`; `theorem`, `arithmetic`, `OR_LESS`; `theorem`, `arithmetic`, `LESS_EQ`; `theorem`, `arithmetic`, `LESS_NOT_SUC`; `theorem`, `arithmetic`, `LESS_0_CASES`; `theorem`, `arithmetic`, `LESS_CASES_IMP`; `theorem`, `arithmetic`, `LESS_CASES`; `theorem`, `arithmetic`, `ADD_INV_0`; `theorem`, `arithmetic`, `LESS_EQ_ADD`; `theorem`, `arithmetic`, `LESS_EQ_SUC_REFL`; `theorem`, `arithmetic`, `LESS_ADD_NONZERO`; `theorem`, `arithmetic`, `LESS_EQ_ANTISYM`; `theorem`, `arithmetic`, `NOT_LESS`; `theorem`, `arithmetic`, `SUB_EQ_0`; `theorem`, `arithmetic`, `ADD_ASSOC`; `theorem`, `arithmetic`, `MULT_0`; `theorem`, `arithmetic`, `MULT_CLAUSES`; `theorem`, `arithmetic`, `MULT_SYM`; `theorem`, `arithmetic`, `RIGHT_ADD_DISTRIB`; `theorem`, `arithmetic`, `LEFT_ADD_DISTRIB`; `theorem`, `arithmetic`, `MULT_ASSOC`; `theorem`, `arithmetic`, `SUB_ADD`; `theorem`, `arithmetic`, `PRE_SUB`; `theorem`, `arithmetic`, `ADD_EQ_0`; `theorem`, `arithmetic`, `ADD_INV_0_EQ`; `theorem`, `arithmetic`, `PRE_SUC_EQ`; `theorem`, `arithmetic`, `INV_PRE_EQ`; `theorem`, `arithmetic`, `LESS_SUC_NOT`; `theorem`, `arithmetic`, `ADD_EQ_SUB`; `theorem`, `arithmetic`, `LESS_MONO_ADD`; `theorem`, `arithmetic`, `LESS_MONO_ADD_EQ`; `theorem`, `arithmetic`, `EQ_MONO_ADD_EQ`; `theorem`, `arithmetic`, `LESS_EQ_MONO_ADD_EQ`; `theorem`, `arithmetic`, `LESS_EQ_TRANS`; `theorem`, `arithmetic`, `LESS_EQ_LESS_EQ_MONO`; `theorem`, `arithmetic`, `LESS_EQ_REFL`; `theorem`, `arithmetic`, `LESS_IMP_LESS_OR_EQ`; `theorem`, `arithmetic`, `LESS_MONO_MULT`; `theorem`, `arithmetic`, `RIGHT_SUB_DISTRIB`; `theorem`, `arithmetic`, `LEFT_SUB_DISTRIB`; `theorem`, `arithmetic`, `LESS_ADD_1`; `theorem`, `arithmetic`, `ZERO_LESS_EQ`; `theorem`, `arithmetic`, `LESS_EQ_MONO`; `theorem`, `arithmetic`, `LESS_OR_EQ_ADD`; `theorem`, `arithmetic`, `SUC_NOT`; `theorem`, `arithmetic`, `EXP_ADD`; `theorem`, `arithmetic`, `NOT_ODD_EQ_EVEN`; `theorem`, `arithmetic`, `MULT_SUC_EQ`; `theorem`, `arithmetic`, `MULT_EXP_MONO`; `theorem`, `arithmetic`, `WOP`; `theorem`, `arithmetic`, `DA`; `theorem`, `arithmetic`, `MOD_ONE`; `theorem`, `arithmetic`, `DIV_LESS_EQ`; `theorem`, `arithmetic`, `DIV_UNIQUE`; `theorem`, `arithmetic`, `MOD_UNIQUE`; `theorem`, `arithmetic`, `DIV_MULT`; `theorem`, `arithmetic`, `LESS_MOD`; `theorem`, `arithmetic`, `MOD_EQ_0`; `theorem`, `arithmetic`, `ZERO_MOD`; `theorem`, `arithmetic`, `MOD_MULT`; `theorem`, `arithmetic`, `MOD_TIMES`; `theorem`, `arithmetic`, `MOD_PLUS`; `theorem`, `arithmetic`, `MOD_MOD`; `theorem`, `arithmetic`, `SUB_MONO_EQ`; `theorem`, `arithmetic`, `SUB_PLUS`; `theorem`, `arithmetic`, `INV_PRE_LESS`; `theorem`, `arithmetic`, `INV_PRE_LESS_EQ`; `theorem`, `arithmetic`, `SUB_LESS_EQ`; `theorem`, `arithmetic`, `LESS_EQUAL_ANTISYM`; `theorem`, `arithmetic`, `SUB_EQ_EQ_0`; `theorem`, `arithmetic`, `SUB_LESS_0`; `theorem`, `arithmetic`, `SUB_LESS_OR`; `theorem`, `arithmetic`, `LESS_ADD_SUC`; `theorem`, `arithmetic`, `LESS_SUB_ADD_LESS`; `theorem`, `arithmetic`, `TIMES2`; `theorem`, `arithmetic`, `LESS_MULT_MONO`; `theorem`, `arithmetic`, `MULT_MONO_EQ`; `theorem`, `arithmetic`, `ADD_SUB`; `theorem`, `arithmetic`, `LESS_EQ_ADD_SUB`; `theorem`, `arithmetic`, `SUB_EQUAL_0`; `theorem`, `arithmetic`, `LESS_EQ_SUB_LESS`; `theorem`, `arithmetic`, `NOT_SUC_LESS_EQ`; `theorem`, `arithmetic`, `SUB_SUB`; `theorem`, `arithmetic`, `LESS_IMP_LESS_ADD`; `theorem`, `arithmetic`, `LESS_EQ_IMP_LESS_SUC`; `theorem`, `arithmetic`, `SUB_LESS_EQ_ADD`; `theorem`, `arithmetic`, `SUB_CANCEL`; `theorem`, `arithmetic`, `CANCEL_SUB`; `theorem`, `arithmetic`, `NOT_EXP_0`; `theorem`, `arithmetic`, `ZERO_LESS_EXP`; `theorem`, `arithmetic`, `ODD_OR_EVEN`; `theorem`, `arithmetic`, `LESS_EXP_SUC_MONO`; `theorem`, `arithmetic`, `ZERO_DIV`; `theorem`, `arithmetic`, `LESS_LESS_CASES`; `theorem`, `arithmetic`, `GREATER_EQ`; `theorem`, `arithmetic`, `LESS_EQ_CASES`; `theorem`, `arithmetic`, `LESS_EQUAL_ADD`; `theorem`, `arithmetic`, `LESS_EQ_EXISTS`; `theorem`, `arithmetic`, `NOT_LESS_EQUAL`; `theorem`, `arithmetic`, `LESS_EQ_0`; `theorem`, `arithmetic`, `MULT_EQ_0`; `theorem`, `arithmetic`, `LESS_MULT2`; `theorem`, `arithmetic`, `LESS_EQ_LESS_TRANS`; `theorem`, `arithmetic`, `LESS_LESS_EQ_TRANS`; `theorem`, `arithmetic`, `FACT_LESS`; `theorem`, `arithmetic`, `EVEN_ODD`; `theorem`, `arithmetic`, `ODD_EVEN`; `theorem`, `arithmetic`, `EVEN_OR_ODD`; `theorem`, `arithmetic`, `EVEN_AND_ODD`; `theorem`, `arithmetic`, `EVEN_ADD`; `theorem`, `arithmetic`, `EVEN_MULT`; `theorem`, `arithmetic`, `ODD_ADD`; `theorem`, `arithmetic`, `ODD_MULT`; `theorem`, `arithmetic`, `EVEN_DOUBLE`; `theorem`, `arithmetic`, `ODD_DOUBLE`; `theorem`, `arithmetic`, `EVEN_ODD_EXISTS`; `theorem`, `arithmetic`, `EVEN_EXISTS`; `theorem`, `arithmetic`, `ODD_EXISTS`; `theorem`, `arithmetic`, `EQ_LESS_EQ`; `theorem`, `arithmetic`, `ADD_MONO_LESS_EQ`; `theorem`, `arithmetic`, `NOT_SUC_LESS_EQ_0`; `theorem`, `arithmetic`, `NOT_LEQ`; `theorem`, `arithmetic`, `NOT_NUM_EQ`; `theorem`, `arithmetic`, `NOT_GREATER`; `theorem`, `arithmetic`, `NOT_GREATER_EQ`; `theorem`, `arithmetic`, `SUC_ONE_ADD`; `theorem`, `arithmetic`, `SUC_ADD_SYM`; `theorem`, `arithmetic`, `NOT_SUC_ADD_LESS_EQ`; `theorem`, `arithmetic`, `MULT_LESS_EQ_SUC`; `theorem`, `arithmetic`, `SUB_LEFT_ADD`; `theorem`, `arithmetic`, `SUB_RIGHT_ADD`; `theorem`, `arithmetic`, `SUB_LEFT_SUB`; `theorem`, `arithmetic`, `SUB_RIGHT_SUB`; `theorem`, `arithmetic`, `SUB_LEFT_SUC`; `theorem`, `arithmetic`, `SUB_LEFT_LESS_EQ`; `theorem`, `arithmetic`, `SUB_RIGHT_LESS_EQ`; `theorem`, `arithmetic`, `SUB_LEFT_LESS`; `theorem`, `arithmetic`, `SUB_RIGHT_LESS`; `theorem`, `arithmetic`, `SUB_LEFT_GREATER_EQ`; `theorem`, `arithmetic`, `SUB_RIGHT_GREATER_EQ`; `theorem`, `arithmetic`, `SUB_LEFT_GREATER`; `theorem`, `arithmetic`, `SUB_RIGHT_GREATER`; `theorem`, `arithmetic`, `SUB_LEFT_EQ`; `theorem`, `arithmetic`, `SUB_RIGHT_EQ`];; % --------------------------------------------------------------------- % % THEORY: list % % --------------------------------------------------------------------- % map autoload_theory [`theorem`, `list`, `list_Axiom`; % in mk_list_defs.ml % `definition`, `list`, `NULL_DEF`; `definition`, `list`, `HD`; `definition`, `list`, `TL`; `definition`, `list`, `SUM`; `definition`, `list`, `APPEND`; `definition`, `list`, `FLAT`; `definition`, `list`, `LENGTH`; `definition`, `list`, `MAP`; `definition`, `list`, `MAP2`; `definition`, `list`, `EL`; `definition`, `list`, `SNOC`; `definition`, `list`, `FOLDR`; `definition`, `list`, `FOLDL`; `definition`, `list`, `FILTER`; `definition`, `list`, `SCANL`; `definition`, `list`, `SCANR`; `definition`, `list`, `SEG`; `definition`, `list`, `REVERSE`; `definition`, `list`, `ALL_EL`; `definition`, `list`, `SOME_EL`; `definition`, `list`, `IS_EL_DEF`; `definition`, `list`, `AND_EL_DEF`; `definition`, `list`, `OR_EL_DEF`; `definition`, `list`, `FIRSTN`; `definition`, `list`, `BUTFIRSTN`; `definition`, `list`, `LASTN`; `definition`, `list`, `BUTLASTN`; `definition`, `list`, `LAST_DEF`; `definition`, `list`, `BUTLAST_DEF`; `definition`, `list`, `ELL`; `definition`, `list`, `IS_PREFIX`; `definition`, `list`, `IS_SUFFIX`; `definition`, `list`, `IS_SUBLIST`; `definition`, `list`, `PREFIX_DEF`; `definition`, `list`, `SUFFIX_DEF`; `definition`, `list`, `SPLITP`; `definition`, `list`, `ZIP`; `definition`, `list`, `UNZIP`; `definition`, `list`, `UNZIP_FST_DEF`; `definition`, `list`, `UNZIP_SND_DEF`; `definition`, `list`, `GENLIST`; `definition`, `list`, `REPLICATE`; % in mk_list_thms.ml % `theorem`, `list`, `NULL`; `theorem`, `list`, `list_INDUCT`; `theorem`, `list`, `list_CASES`; `theorem`, `list`, `CONS_11`; `theorem`, `list`, `NOT_NIL_CONS`; `theorem`, `list`, `NOT_CONS_NIL`; `theorem`, `list`, `LIST_NOT_EQ`; `theorem`, `list`, `NOT_EQ_LIST`; `theorem`, `list`, `EQ_LIST`; `theorem`, `list`, `CONS`; `theorem`, `list`, `APPEND_ASSOC`; `theorem`, `list`, `LENGTH_APPEND`; `theorem`, `list`, `MAP_APPEND`; `theorem`, `list`, `LENGTH_MAP`; `theorem`, `list`, `LENGTH_NIL`; `theorem`, `list`, `LENGTH_CONS`; `theorem`, `list`, `LENGTH_MAP2`; % in mk_list_thm2.ml % `theorem`, `list`, `ALL_EL_APPEND`; `theorem`, `list`, `ALL_EL_BUTFIRSTN`; `theorem`, `list`, `ALL_EL_BUTLASTN`; `theorem`, `list`, `ALL_EL_CONJ`; `theorem`, `list`, `ALL_EL_FIRSTN`; `theorem`, `list`, `ALL_EL_FOLDL_MAP`; `theorem`, `list`, `ALL_EL_FOLDL`; `theorem`, `list`, `ALL_EL_FOLDR_MAP`; `theorem`, `list`, `ALL_EL_FOLDR`; `theorem`, `list`, `ALL_EL_LASTN`; `theorem`, `list`, `ALL_EL_MAP`; `theorem`, `list`, `ALL_EL_REPLICATE`; `theorem`, `list`, `ALL_EL_REVERSE`; `theorem`, `list`, `ALL_EL_SEG`; `theorem`, `list`, `ALL_EL_SNOC`; `theorem`, `list`, `APPEND_BUTLASTN_BUTFIRSTN`; `theorem`, `list`, `APPEND_BUTLASTN_LASTN`; `theorem`, `list`, `APPEND_BUTLAST_LAST`; `theorem`, `list`, `APPEND_FIRSTN_BUTFIRSTN`; `theorem`, `list`, `APPEND_FIRSTN_LASTN`; `theorem`, `list`, `APPEND_FOLDL`; `theorem`, `list`, `APPEND_FOLDR`; `theorem`, `list`, `APPEND_LENGTH_EQ`; `theorem`, `list`, `APPEND_NIL`; `theorem`, `list`, `APPEND_SNOC`; `theorem`, `list`, `ASSOC_APPEND`; `theorem`, `list`, `ASSOC_FOLDL_FLAT`; `theorem`, `list`, `ASSOC_FOLDR_FLAT`; `theorem`, `list`, `BUTFIRSTN_APPEND1`; `theorem`, `list`, `BUTFIRSTN_APPEND2`; `theorem`, `list`, `BUTFIRSTN_BUTFIRSTN`; `theorem`, `list`, `BUTFIRSTN_LASTN`; `theorem`, `list`, `BUTFIRSTN_LENGTH_APPEND`; `theorem`, `list`, `BUTFIRSTN_LENGTH_NIL`; `theorem`, `list`, `BUTFIRSTN_REVERSE`; `theorem`, `list`, `BUTFIRSTN_SEG`; `theorem`, `list`, `BUTFIRSTN_SNOC`; `theorem`, `list`, `BUTLASTN_APPEND1`; `theorem`, `list`, `BUTLASTN_APPEND2`; `theorem`, `list`, `BUTLASTN_BUTLAST`; `theorem`, `list`, `BUTLASTN_BUTLASTN`; `theorem`, `list`, `BUTLASTN_CONS`; `theorem`, `list`, `BUTLASTN_FIRSTN`; `theorem`, `list`, `BUTLASTN_LASTN_NIL`; `theorem`, `list`, `BUTLASTN_LASTN`; `theorem`, `list`, `BUTLASTN_LENGTH_APPEND`; `theorem`, `list`, `BUTLASTN_LENGTH_CONS`; `theorem`, `list`, `BUTLASTN_LENGTH_NIL`; `theorem`, `list`, `BUTLASTN_MAP`; `theorem`, `list`, `BUTLASTN_REVERSE`; `theorem`, `list`, `BUTLASTN_SEG`; `theorem`, `list`, `BUTLASTN_SUC_BUTLAST`; `theorem`, `list`, `BUTLASTN_1`; `theorem`, `list`, `BUTLAST`; `theorem`, `list`, `COMM_ASSOC_FOLDL_REVERSE`; `theorem`, `list`, `COMM_ASSOC_FOLDR_REVERSE`; `theorem`, `list`, `COMM_MONOID_FOLDL`; `theorem`, `list`, `COMM_MONOID_FOLDR`; `theorem`, `list`, `CONS_APPEND`; `theorem`, `list`, `ELL_0_SNOC`; `theorem`, `list`, `ELL_APPEND1`; `theorem`, `list`, `ELL_APPEND2`; `theorem`, `list`, `ELL_CONS`; `theorem`, `list`, `ELL_EL`; `theorem`, `list`, `ELL_IS_EL`; `theorem`, `list`, `ELL_LAST`; `theorem`, `list`, `ELL_LENGTH_APPEND`; `theorem`, `list`, `ELL_LENGTH_CONS`; `theorem`, `list`, `ELL_LENGTH_SNOC`; `theorem`, `list`, `ELL_MAP`; `theorem`, `list`, `ELL_PRE_LENGTH`; `theorem`, `list`, `ELL_REVERSE_EL`; `theorem`, `list`, `ELL_REVERSE`; `theorem`, `list`, `ELL_SEG`; `theorem`, `list`, `ELL_SNOC`; `theorem`, `list`, `ELL_SUC_SNOC`; `theorem`, `list`, `EL_APPEND1`; `theorem`, `list`, `EL_APPEND2`; `theorem`, `list`, `EL_CONS`; `theorem`, `list`, `EL_ELL`; `theorem`, `list`, `EL_IS_EL`; `theorem`, `list`, `EL_LENGTH_APPEND`; `theorem`, `list`, `EL_LENGTH_SNOC`; `theorem`, `list`, `EL_MAP`; `theorem`, `list`, `EL_PRE_LENGTH`; `theorem`, `list`, `EL_REVERSE_ELL`; `theorem`, `list`, `EL_REVERSE`; `theorem`, `list`, `EL_SEG`; `theorem`, `list`, `EL_SNOC`; `theorem`, `list`, `FCOMM_FOLDL_APPEND`; `theorem`, `list`, `FCOMM_FOLDL_FLAT`; `theorem`, `list`, `FCOMM_FOLDR_APPEND`; `theorem`, `list`, `FCOMM_FOLDR_FLAT`; `theorem`, `list`, `FILTER_APPEND`; `theorem`, `list`, `FILTER_COMM`; `theorem`, `list`, `FILTER_FILTER`; `theorem`, `list`, `FILTER_FLAT`; `theorem`, `list`, `FILTER_FOLDL`; `theorem`, `list`, `FILTER_FOLDR`; `theorem`, `list`, `FILTER_IDEM`; `theorem`, `list`, `FILTER_MAP`; `theorem`, `list`, `FILTER_REVERSE`; `theorem`, `list`, `FILTER_SNOC`; `theorem`, `list`, `FIRSTN_APPEND1`; `theorem`, `list`, `FIRSTN_APPEND2`; `theorem`, `list`, `FIRSTN_BUTLASTN`; `theorem`, `list`, `FIRSTN_FIRSTN`; `theorem`, `list`, `FIRSTN_LENGTH_APPEND`; `theorem`, `list`, `FIRSTN_LENGTH_ID`; `theorem`, `list`, `FIRSTN_REVERSE`; `theorem`, `list`, `FIRSTN_SEG`; `theorem`, `list`, `FIRSTN_SNOC`; `theorem`, `list`, `FLAT_APPEND`; `theorem`, `list`, `FLAT_FLAT`; `theorem`, `list`, `FLAT_FOLDL`; `theorem`, `list`, `FLAT_FOLDR`; `theorem`, `list`, `FLAT_REVERSE`; `theorem`, `list`, `FLAT_SNOC`; `theorem`, `list`, `FOLDL_APPEND`; `theorem`, `list`, `FOLDL_FILTER`; `theorem`, `list`, `FOLDL_FOLDR_REVERSE`; `theorem`, `list`, `FOLDL_MAP`; `theorem`, `list`, `FOLDL_REVERSE`; `theorem`, `list`, `FOLDL_SINGLE`; `theorem`, `list`, `FOLDL_SNOC_NIL`; `theorem`, `list`, `FOLDL_SNOC`; `theorem`, `list`, `FOLDR_APPEND`; `theorem`, `list`, `FOLDR_CONS_NIL`; `theorem`, `list`, `FOLDR_FILTER_REVERSE`; `theorem`, `list`, `FOLDR_FILTER`; `theorem`, `list`, `FOLDR_FOLDL_REVERSE`; `theorem`, `list`, `FOLDR_FOLDL`; `theorem`, `list`, `FOLDR_MAP_REVERSE`; `theorem`, `list`, `FOLDR_MAP`; `theorem`, `list`, `FOLDR_REVERSE`; `theorem`, `list`, `FOLDR_SINGLE`; `theorem`, `list`, `FOLDR_SNOC`; `theorem`, `list`, `IS_EL_APPEND`; `theorem`, `list`, `IS_EL_BUTFIRSTN`; `theorem`, `list`, `IS_EL_BUTLASTN`; `theorem`, `list`, `IS_EL_FILTER`; `theorem`, `list`, `IS_EL_FIRSTN`; `theorem`, `list`, `IS_EL_FOLDL_MAP`; `theorem`, `list`, `IS_EL_FOLDL`; `theorem`, `list`, `IS_EL_FOLDR_MAP`; `theorem`, `list`, `IS_EL_FOLDR`; `theorem`, `list`, `IS_EL_LASTN`; `theorem`, `list`, `IS_EL_REPLICATE`; `theorem`, `list`, `IS_EL_REVERSE`; `theorem`, `list`, `IS_EL_SEG`; `theorem`, `list`, `IS_EL_SNOC`; `theorem`, `list`, `IS_EL_SOME_EL`; `theorem`, `list`, `IS_EL`; `theorem`, `list`, `IS_PREFIX_APPEND`; `theorem`, `list`, `IS_PREFIX_IS_SUBLIST`; `theorem`, `list`, `IS_PREFIX_PREFIX`; `theorem`, `list`, `IS_PREFIX_REVERSE`; `theorem`, `list`, `IS_SUBLIST_APPEND`; `theorem`, `list`, `IS_SUBLIST_REVERSE`; `theorem`, `list`, `IS_SUFFIX_APPEND`; `theorem`, `list`, `IS_SUFFIX_IS_SUBLIST`; `theorem`, `list`, `IS_SUFFIX_REVERSE`; `theorem`, `list`, `LASTN_APPEND1`; `theorem`, `list`, `LASTN_APPEND2`; `theorem`, `list`, `LASTN_BUTFIRSTN`; `theorem`, `list`, `LASTN_BUTLASTN`; `theorem`, `list`, `LASTN_CONS`; `theorem`, `list`, `LASTN_LASTN`; `theorem`, `list`, `LASTN_LENGTH_APPEND`; `theorem`, `list`, `LASTN_LENGTH_ID`; `theorem`, `list`, `LASTN_MAP`; `theorem`, `list`, `LASTN_REVERSE`; `theorem`, `list`, `LASTN_SEG`; `theorem`, `list`, `LASTN_1`; `theorem`, `list`, `LAST`; `theorem`, `list`, `LAST_LASTN_LAST`; `theorem`, `list`, `LENGTH_BUTFIRSTN`; `theorem`, `list`, `LENGTH_BUTLASTN`; `theorem`, `list`, `LENGTH_BUTLAST`; `theorem`, `list`, `LENGTH_EQ`; `theorem`, `list`, `LENGTH_FIRSTN`; `theorem`, `list`, `LENGTH_FLAT`; `theorem`, `list`, `LENGTH_FOLDL`; `theorem`, `list`, `LENGTH_FOLDR`; `theorem`, `list`, `LENGTH_GENLIST`; `theorem`, `list`, `LENGTH_LASTN`; `theorem`, `list`, `LENGTH_NOT_NULL`; `theorem`, `list`, `LENGTH_REPLICATE`; `theorem`, `list`, `LENGTH_REVERSE`; `theorem`, `list`, `LENGTH_SCANL`; `theorem`, `list`, `LENGTH_SCANR`; `theorem`, `list`, `LENGTH_SEG`; `theorem`, `list`, `LENGTH_SNOC`; `theorem`, `list`, `LENGTH_UNZIP_FST`; `theorem`, `list`, `LENGTH_UNZIP_SND`; `theorem`, `list`, `LENGTH_ZIP`; `theorem`, `list`, `MAP_FILTER`; `theorem`, `list`, `MAP_FLAT`; `theorem`, `list`, `MAP_FOLDL`; `theorem`, `list`, `MAP_FOLDR`; `theorem`, `list`, `MAP_MAP_o`; `theorem`, `list`, `MAP_REVERSE`; `theorem`, `list`, `MAP_SNOC`; `theorem`, `list`, `MAP_o`; `theorem`, `list`, `MONOID_APPEND_NIL`; `theorem`, `list`, `NOT_ALL_EL_SOME_EL`; `theorem`, `list`, `NOT_NIL_SNOC`; `theorem`, `list`, `NOT_SNOC_NIL`; `theorem`, `list`, `NOT_SOME_EL_ALL_EL`; `theorem`, `list`, `NULL_EQ_NIL`; `theorem`, `list`, `NULL_FOLDL`; `theorem`, `list`, `NULL_FOLDR`; `theorem`, `list`, `PREFIX_FOLDR`; `theorem`, `list`, `PREFIX`; `theorem`, `list`, `REVERSE_APPEND`; `theorem`, `list`, `REVERSE_EQ_NIL`; `theorem`, `list`, `REVERSE_FLAT`; `theorem`, `list`, `REVERSE_FOLDL`; `theorem`, `list`, `REVERSE_FOLDR`; `theorem`, `list`, `REVERSE_REVERSE`; `theorem`, `list`, `REVERSE_SNOC`; `theorem`, `list`, `RIGHT_ID_APPEND_NIL`; `theorem`, `list`, `SEG_0_SNOC`; `theorem`, `list`, `SEG_APPEND1`; `theorem`, `list`, `SEG_APPEND2`; `theorem`, `list`, `SEG_APPEND`; `theorem`, `list`, `SEG_FIRSTN_BUTFISTN`; `theorem`, `list`, `SEG_LASTN_BUTLASTN`; `theorem`, `list`, `SEG_LENGTH_ID`; `theorem`, `list`, `SEG_LENGTH_SNOC`; `theorem`, `list`, `SEG_REVERSE`; `theorem`, `list`, `SEG_SEG`; `theorem`, `list`, `SEG_SNOC`; `theorem`, `list`, `SEG_SUC_CONS`; `theorem`, `list`, `SNOC_11`; `theorem`, `list`, `SNOC_APPEND`; `theorem`, `list`, `SNOC_Axiom`; `theorem`, `list`, `SNOC_CASES`; `theorem`, `list`, `SNOC_EQ_LENGTH_EQ`; `theorem`, `list`, `SNOC_FOLDR`; `theorem`, `list`, `SNOC_INDUCT`; `theorem`, `list`, `SNOC_REVERSE_CONS`; `theorem`, `list`, `SOME_EL_APPEND`; `theorem`, `list`, `SOME_EL_BUTFIRSTN`; `theorem`, `list`, `SOME_EL_BUTLASTN`; `theorem`, `list`, `SOME_EL_DISJ`; `theorem`, `list`, `SOME_EL_FIRSTN`; `theorem`, `list`, `SOME_EL_FOLDL_MAP`; `theorem`, `list`, `SOME_EL_FOLDL`; `theorem`, `list`, `SOME_EL_FOLDR_MAP`; `theorem`, `list`, `SOME_EL_FOLDR`; `theorem`, `list`, `SOME_EL_LASTN`; `theorem`, `list`, `SOME_EL_MAP`; `theorem`, `list`, `SOME_EL_REVERSE`; `theorem`, `list`, `SOME_EL_SEG`; `theorem`, `list`, `SOME_EL_SNOC`; `theorem`, `list`, `SUM_APPEND`; `theorem`, `list`, `SUM_FLAT`; `theorem`, `list`, `SUM_FOLDL`; `theorem`, `list`, `SUM_FOLDR`; `theorem`, `list`, `SUM_REVERSE`; `theorem`, `list`, `SUM_SNOC`; `theorem`, `list`, `TL_SNOC`; `theorem`, `list`, `UNZIP_SNOC`; `theorem`, `list`, `UNZIP_ZIP`; `theorem`, `list`, `ZIP_SNOC`; `theorem`, `list`, `ZIP_UNZIP`; ];; % --------------------------------------------------------------------- % % THEORY: tree % % --------------------------------------------------------------------- % % === do not load let node_11 = theorem `tree` `node_11` and tree_Induct = theorem `tree` `tree_Induct` and tree_Axiom = theorem `tree` `tree_Axiom`;; % % --------------------------------------------------------------------- % % THEORY: ltree % % --------------------------------------------------------------------- % % === do not load let Node_11 = theorem `ltree` `Node_11` and Node_onto = theorem `ltree` `Node_onto` and ltree_Induct = theorem `ltree` `ltree_Induct` and ltree_Axiom = theorem `ltree` `ltree_Axiom`;; % % --------------------------------------------------------------------- % % THEORY: tydefs % % --------------------------------------------------------------------- % map autoload_theory [`theorem`, `tydefs`, `TY_DEF_THM`; `theorem`, `tydefs`, `exists_TRP`];; hol88-2.02.19940316/ml/unsafe-rules0000640000212700021270000000071605307115750014677 0ustar cammcammdrul.ml hol-drule.ml hol-syn.ml hol-thyfn.ml numconv.ml tacticals.ml drul.ml MK_COMB MK_ABS ALPHA hol-drule.ml ADD_ASSUM SYM TRANS IMP_TRANS AP_TERM AP_THM EQ_MP EQ_IMP_RULE SPEC EQT_INTRO GEN ETA_CONV EXT EXISTS CHOOSE IMP_ANTISYM_RULE MK_EXISTS SUBS SUBS_OCCS SUBST_CONV CONJ CONJUNCT1 CONJUNCT2 DISJ1 DISJ2 DISJ_CASES NOT_INTRO NOT_ELIM CONTR CCONTR INST hol-syn.ml DEF_EXISTS_RULE hol-thyfn.ml ASSUMPTION_DISCH ASSUMPTION_UNDISCH numconv.ml num_CONV hol88-2.02.19940316/ml/hol-syn.ml0000640000212700021270000016425305521002272014265 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: hol-syn.ml % % % % DESCRIPTION: This file defines the basic syntax functions of HOL. % % We use the same names as for PPLAMBDA. The utilities % % on ol-util.ml are included here. % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % this file uses things from genfns.ml % % --------------------------------------------------------------------- % if compiling then (loadf `ml/genfns`);; %----------------------------------------------------------------------------% % Dynamically generated proof steps % %----------------------------------------------------------------------------% type step = AssumeStep of term | ReflStep of term | SubstStep of (thm#term)list # term # thm | BetaConvStep of term | AbsStep of term # thm | InstTypeStep of (type#type)list # thm | DischStep of term # thm | MpStep of thm # thm | MkCombStep of thm # thm | MkAbsStep of thm | AlphaStep of term # term | AddAssumStep of term # thm | SymStep of thm | TransStep of thm # thm | ImpTransStep of thm # thm | ApTermStep of term # thm | ApThmStep of thm # term | EqMpStep of thm # thm | EqImpRuleStep of thm % returns a pair of theorems % | SpecStep of term # thm | EqtIntroStep of thm | GenStep of term # thm | EtaConvStep of term | ExtStep of thm | ExistsStep of (term # term) # thm | ChooseStep of (term # thm) # thm | ImpAntisymRuleStep of thm # thm | MkExistsStep of thm | SubsStep of thm list # thm | SubsOccsStep of (int list # thm) list # thm | SubstConvStep of (thm # term) list # term # term | ConjStep of thm # thm | Conjunct1Step of thm | Conjunct2Step of thm | Disj1Step of thm # term | Disj2Step of term # thm | DisjCasesStep of thm # thm # thm | NotIntroStep of thm | NotElimStep of thm | ContrStep of term # thm | CcontrStep of term # thm | InstStep of (term # term) list # thm | StoreDefinitionStep of string # term | DefinitionStep of string # string | DefExistsRuleStep of term | NewAxiomStep of string # term | AxiomStep of string # string | TheoremStep of string # string | NewConstantStep of string # type | NewTypeStep of int # string | NumConvStep of term;; % We hide the flag and the list in local variables. Four functions are provided for the users to control the recording of proof % begin_section `record_proof`;; letref steplist = [] : step list;; letref record_proof_flag = false;; letref suspended = false;; let is_recording_proof (():void) = record_proof_flag;; let record_proof b = (if b then (steplist := [];()); record_proof_flag := b; ()) ;; let suspend_recording () = if record_proof_flag then (record_proof_flag := false; suspended := true; ());; let resume_recording () = if (suspended & (not record_proof_flag)) then (record_proof_flag := true; suspended := false; ());; let RecordStep step = if record_proof_flag then (steplist := (step.steplist); ());; let get_steps (():void) = steplist;; (record_proof,is_recording_proof,RecordStep,get_steps, suspend_recording,resume_recording);; end_section `record_proof`;; let (record_proof,is_recording_proof,RecordStep,get_steps, suspend_recording,resume_recording) = it;; let new_constant(s,ty) = fst(new_constant(s,ty), RecordStep(NewConstantStep(s,ty)));; % arb_term and ARB_THM are just arbitrary ML values of type term and thm % let arb_term = "arb:*" and ARB_THM = axiom(`bool`, `ARB_THM`);; let falsity = "F:bool" ? arb_term;; % hack so will load in PPLAMBDA % let bool_ty = ":bool" ? ":*";; % hack so will load in PPLAMBDA % % ===================================================================== % % Derived constructors for HOL syntax. % % ===================================================================== % let mk_forall (x,t) = let ty = type_of x in let allty = mk_type(`fun`,[mk_type(`fun`,[ty;bool_ty]);bool_ty]) in mk_comb(mk_const(`!`,allty),mk_abs(x,t)) ? failwith `mk_forall`;; let mk_exists (x,t) = let ty = type_of x in let exty = mk_type(`fun`,[mk_type(`fun`,[ty;bool_ty]);bool_ty]) in mk_comb(mk_const(`?`,exty),mk_abs(x,t)) ? failwith `mk_exists`;; let mk_select (x,t) = let ty = type_of x in let selty = mk_type(`fun`,[mk_type(`fun`,[ty;bool_ty]);ty]) in mk_comb(mk_const(`@`, selty), mk_abs(x,t)) ? failwith `mk_select`;; % NOTES: % % mk_bool_comb `NAME` (t1,t2) --> "NAME t1 t2" % % the K arb_term is a hack so it will load in pp-lambda. % % % % mk_iff deleted [TFM 91.01.20] % let mk_conj,mk_disj,mk_imp = let mk_bool_comb tok ftok = let OP = mk_const(tok, mk_type(`fun`,[bool_ty;mk_type(`fun`,[bool_ty;bool_ty])])) in (\(t1,t2). mk_comb((mk_comb(OP,t1),t2)) ? failwith ftok) in ((mk_bool_comb `/\\` `mk_conj`, mk_bool_comb `\\/` `mk_disj`, mk_bool_comb `==>` `mk_imp`) ? (K arb_term, K arb_term, K arb_term));; let mk_eq (t1,t2) = let ty1 = type_of t1 and ty2 = type_of t2 in if (ty1 = ty2) then let eqty = mk_type(`fun`,[ty1;mk_type(`fun`,[ty2;bool_ty])]) in mk_comb(mk_comb(mk_const(`=`,eqty),t1),t2) else failwith `mk_eq`;; let mk_pair (t1,t2) = let ty1 = type_of t1 and ty2 = type_of t2 in let pty = mk_type(`prod`,[ty1;ty2]) in let cty = mk_type(`fun`,[ty1;mk_type(`fun`,[ty2;pty])]) in mk_comb(mk_comb(mk_const(`,`,cty),t1),t2);; % The K arb_term is a hack so that this file will load in pp-lambda % let mk_neg = (let neg = mk_const(`~`,mk_type(`fun`,[bool_ty;bool_ty])) in (\t. mk_comb (neg,t) ? failwith `mk_neg`)) ? K arb_term;; % ===================================================================== % % Derived destructors for ML syntax. % % ===================================================================== % let dest_forall = let check = assert (\c. fst(dest_const c) = `!`) in \tm. (let (_,b) = (check # I) (dest_comb tm) in dest_abs b) ? failwith `dest_forall`;; let dest_exists = let check = assert (\c. fst(dest_const c) = `?`) in \tm. (let (_,b) = (check # I) (dest_comb tm) in dest_abs b) ? failwith `dest_exists`;; let dest_select = let check = assert (\c. fst(dest_const c) = `@`) in \tm. (let (_,b) = (check # I) (dest_comb tm) in dest_abs b) ? failwith `dest_select`;; let dest_conj = let check = assert (\c. fst(dest_const c) = `/\\`) in \tm. (let ((_,c1),c2) = (((check # I) o dest_comb) # I) (dest_comb tm) in (c1,c2)) ? failwith `dest_conj`;; let dest_disj = let check = assert (\c. fst(dest_const c) = `\\/`) in \tm. (let ((_,c1),c2) = (((check # I) o dest_comb) # I) (dest_comb tm) in (c1,c2)) ? failwith `dest_disj`;; let dest_eq = let check = assert (\c. fst(dest_const c) = `=`) in \tm. (let ((_,c1),c2) = (((check # I) o dest_comb) # I) (dest_comb tm) in (c1,c2)) ? failwith `dest_eq`;; let dest_pair = let check = assert (\c. fst(dest_const c) = `,`) in \tm. (let ((_,c1),c2) = (((check # I) o dest_comb) # I) (dest_comb tm) in (c1,c2)) ? failwith `dest_pair`;; % --------------------------------------------------------------------- % % dest_imp "P ==> Q" = (P,Q). % % % % This also destructs negation - for compatibility with PPLAMBDA code % % CHANGED BY WW 24 Jan 1994 % % The PPLAMBDA compatible dest_imp is renamed to dest_neg_imp. % % --------------------------------------------------------------------- % let dest_imp tm = (let ((c,p),q) = (dest_comb # I) (dest_comb tm) in if (fst (dest_const c)) = `==>` then (p,q) else fail) ? failwith `dest_imp`;; let dest_neg t = (let t1,t2 = dest_comb t in if fst(dest_const t1)=`~` then t2 else fail) ? failwith `dest_neg`;; let dest_neg_imp tm = ((let ((c,p),q) = (dest_comb # I) (dest_comb tm) in if (fst (dest_const c)) = `==>` then (p,q) else fail) ? let (c,b) = dest_comb tm in if (fst (dest_const c)) = `~` then (b,falsity) else fail) ? failwith `dest_neg_imp`;; % dest_form "HOL_ASSERT t" --> "t" % let dest_form fm = (let tok,t = dest_pred fm in if `HOL_ASSERT` = tok then t else fail) ? failwith `dest_form`;; % mk_form "t" --> "HOL_ASSERT t" % let mk_form t = mk_pred(`HOL_ASSERT`,t) ? failwith `mk_form`;; % mk_pp_thm(["fm1";...;"fmn"],"fm") --> "fm1,...,fmn |- fm" It is written in Lisp and is loaded by: lisp `(load '|/mnt/lcp/lcf/franz/F-macro|)` ;; lisp `(load '|/mnt/lcp/lcf/franz/llmac|)`;; lisp `(load '|/mnt/lcp/lcf/franz/F-dml|)` ;; lisp `(load 'mk_pp_thm)` ;; (N.B. this is probably out of date - e.g. need llmac from ~/hol) % % mk_thm(["t1";...;"tn"],"t") --> "t1,...,tn |- t" "t1,...,tn |- t" is represented by the PPLAMBDA theorem: "HOL_ASSERT t1, ... , HOL_ASSERT tn |- HOL_ASSERT t" OLD VERSION: let mk_thm = mk_pp_thm o (map mk_form # mk_form);; CHANGED 21 April 1993 by JVT to get rid of "o" and "#" which cause additional calls to "ap" in lisp. % let mk_thm P = mk_pp_thm (map mk_form (fst P),mk_form (snd P));; % dest_thm "t1,...,tn |- t" --> (["t1";...;"tn"],t) OLD VERSION: let dest_thm = (map dest_form # dest_form) o dest_thm;; CHANGED 21 April 1993 by JVT to get rid of "o" and "#" which cause additional calls to "ap" in lisp. % let dest_thm th = let P = dest_thm th in (map dest_form (fst P),dest_form (snd P));; let hyp = \th. fst (dest_thm th) and concl = \th. snd (dest_thm th);; let hyp_union thl = itlist union (map hyp thl) [];; % ===================================================================== % % Derived discriminator functions. % % ===================================================================== % let is_forall = can dest_forall and is_exists = can dest_exists and is_select = can dest_select and is_conj = can dest_conj and is_disj = can dest_disj and is_imp = can dest_imp and % is_iff = can dest_iff and DELETED [TFM 91.01.20] % is_eq = can dest_eq and is_pair = can dest_pair and is_neg = can dest_neg and is_neg_imp= can dest_neg_imp;; % ===================================================================== % % Alpha-conversion, substitution, etc. % % % % Since HOL only has terms we can simplify the naming of various syntax % % functions. For example, HOL just has aconv instead of aconv_term and % % aconv_form. % % % % NB: These definitions REDEFINE previously dml'ed paired functions as % % curried ones % % ===================================================================== % let aconv t u = aconv (t,u) and subst l t = subst (l,t) and subst_occs nl l t = subst_occs (nl,l,t) and free_in l t = free_in (l,t) and variant vl v = variant (vl,v);; % ===================================================================== % % Occurrences of types in terms and instantiation. % % % % NB: These definitions REDEFINE paired functions as curried ones % % ===================================================================== % let type_in_type ty1 ty2 = type_in_type (ty1,ty2) and type_in ty tm = type_in (ty, tm) and inst_type l ty = inst_type (l,ty) and inst tml l tm = inst (tml,l,tm);; % ===================================================================== % % Matching % % % % NB: this REDEFINES the dml'ed paired "match" function to be curried. % % ===================================================================== % let match pat ob = match (pat,ob);; % ===================================================================== % % Free variables. % % % % dml'd functions term_frees, term_vars and term_tyvars renamed % % to be frees, vars and tyvars. So this not needed [TFM 90.06.04] % % % % let frees = term_frees % % and vars = term_vars % % and tyvars = term_tyvars;; % % ===================================================================== % % ===================================================================== % % Syntax functions for term lists % % ===================================================================== % let freesl = \l. itlist (union o frees) l [] and varsl = \l. itlist (union o vars) l [] and tyvarsl = \l. itlist (union o tyvars) l [];; % ===================================================================== % % Free variables of a theorem % % ===================================================================== % let thm_frees th = let hy,c = dest_thm th in freesl (c.hy);; % ===================================================================== % % Discharge all assumptions w from wl % % ===================================================================== % let disch(w,wl) = filter (\w'.not (aconv w w')) wl ;; % ===================================================================== % % The following definitions make code for PPLAMBDA compatible with HOL % % % % let is_equiv = is_eq % % and mk_equiv = mk_eq % % and dest_equiv = dest_eq;; [DELETED: TFM 90.09.09] % % ===================================================================== % % ===================================================================== % % DELETED: TFM 90.08.16 % % let is_inequiv = is_eq % % and mk_inequiv = mk_eq % % and dest_inequiv = dest_eq;; % % ===================================================================== % let is_pred t = (is_const(fst(dest_comb t))) ? false;; let mk_pred(tk,t) = mk_comb(mk_const(tk, ":^(type_of t)->bool"),t) ? failwith `mk_pred `;; let dest_pred t = (let t1,t2 = dest_comb t in (fst(dest_const t1),t2) ) ? failwith `dest_pred`;; % ===================================================================== % % Iterated derived constructors: % % % % * list_mk_abs [x1;...;xn],t ---> "\x1 ... xn.t" % % * list_mk_comb op, [arg1; ...;argn] ---> "op arg1 ... argn" % % * list_mk_conj ["C1";...;"Cn"] ---> "C1 /\ ... /\ Cn", n>0 % % * list_mk_disj ["D1"; ...; "Dn"] ---> "D1 \/ ... \/ Dn", n>0 % % * list_mk_imp [t1;...;tn], t ---> "t1==>(...(tn==>t)...) % % * list_mk_forall [x1;...;xn],t ---> "!x1 ... xn.t" % % * list_mk_exists [x1;...;xn],t ---> "?x1 ... xn.t" % % * list_mk_pair ["t1";...;"tn"] ---> "(t1,...,tn)", n>0 % % ===================================================================== % let list_mk_abs (vars,t) = (itlist (curry mk_abs) vars t) ? failwith `list_mk_abs`;; let list_mk_comb (op,args) = (rev_itlist (\x f. mk_comb(f,x)) args op) ? failwith `list_mk_comb`;; let list_mk_conj conjs = (end_itlist (curry mk_conj) conjs) ? failwith `list_mk_conj`;; let list_mk_disj disjs = (end_itlist (curry mk_disj) disjs) ? failwith `list_mk_disj`;; let list_mk_imp (antel,conc) = (itlist (curry mk_imp) antel conc) ? failwith `list_mk_imp`;; let list_mk_forall (vars,body) = (itlist (curry mk_forall) vars body) ? failwith `list_mk_forall`;; let list_mk_exists (vars,body) = (itlist (curry mk_exists) vars body) ? failwith `list_mk_exists`;; % list_mk_pair added [RJB 90.10.22]. % let list_mk_pair cmpts = (end_itlist (curry mk_pair) cmpts) ? failwith `list_mk_pair`;; % ===================================================================== % % Iterated derived destructors: % % % % * strip_abs "\x1 ... xn. t" ---> [x1; ...; xn], t % % * strip_comb "t u1 ... un" ---> t, [u1; ...; un] % % * conjuncts "t1 /\ ... /\ tn" ---> [t1; ...; tn] % % * disjuncts "t1 \/ ... \/ tn" ---> [t1; ...; tn] % % * strip_imp "t1 ==> ... ==> tn ==> t" ---> [t1; ...; tn], t % % * strip_forall "!x1 ... xn. t" ---> [x1; ...; xn], t % % * strip_exists "?x1 ... xn. t" ---> [x1; ...; xn], t % % * strip_pair "(t1,...,tn)" ---> [t1; ...; tn] % % % % NOTE : because conjuncts splits both the left and right sides of a % % conjunction, this operation is not the inverse of list_mk_conj. It % % may be useful to introduce list_dest_conj, for splitting only the % % right tails of a conjunction. Likewise for disjunction. % % ===================================================================== % letrec strip_abs tm = if is_abs tm then (let bv,t = dest_abs tm in let bvs, core = strip_abs t in bv.bvs, core) else [],tm;; let strip_comb tm = letrec dest t rands = if is_comb t then (let rator,rand = dest_comb t in dest rator (rand.rands)) else t, rands in dest tm [];; letrec conjuncts w = (let a,b = dest_conj w in conjuncts a @ conjuncts b) ? [w];; letrec disjuncts w = (let a,b = dest_disj w in disjuncts a @ disjuncts b) ? [w];; letrec strip_imp fm = if is_imp fm then (let wa,wc = dest_imp fm in let was,wb = strip_imp wc in wa.was, wb) else [],fm;; letrec strip_forall fm = (let bv,body = dest_forall fm in let bvs, core = strip_forall body in bv.bvs, core) ? [],fm;; letrec strip_exists fm = (let bv,body = dest_exists fm in let bvs, core = strip_exists body in bv.bvs, core) ? [],fm;; % strip_pair added [RJB 90.10.22]. % letrec strip_pair tm = (let x,y = dest_pair tm in x.(strip_pair y)) ? [tm];; % ===================================================================== % % Syntax functions for conditionals % % ===================================================================== % let mk_cond (p,t,u) = (let rty = type_of t in let bty = type_of p in let ty1 = mk_type(`fun`,[rty;rty]) in let cty = mk_type(`fun`,[bty;mk_type(`fun`,[rty;ty1])]) in let cnd = mk_const(`COND`,cty) in mk_comb(mk_comb(mk_comb(cnd,p),t),u)) ? failwith `mk_cond`;; let is_cond tm = (let (c,[p;x;y]) = strip_comb tm in fst(dest_const c) = `COND`) ? false;; let dest_cond tm = (let (c,[p;x;y]) = strip_comb tm in if fst(dest_const c) = `COND` then p,x,y else fail) ? failwith `dest_cond`;; % ===================================================================== % % Syntax functions for let-terms: % % % % dest_let "LET f x" = ("f","x") % % mk_let ("f","x") = "LET f x" % % is_let tm = equivalent to "can dest_let tm" % % ===================================================================== % let dest_let = let check tm = fst(dest_const tm) = `LET` in \tm. (let (_,[f;x]) = (assert check # I) (strip_comb tm) in (f,x)) ? failwith `dest_let`;; let mk_let (f,x) = (let fty = type_of f in let c = mk_const(`LET`,mk_type(`fun`,[fty;fty])) in mk_comb(mk_comb(c,f),x)) ? failwith `mk_let`;; let is_let tm = can dest_let tm;; % ===================================================================== % % Syntax functions for lists added [RJB 90.10.24]. % % ===================================================================== % % mk_cons ("t","[t1;...;tn]") ----> "[t;t1;...;tn]" % let mk_cons (h,t) = (let hty = type_of h and tty = type_of t in let consty = mk_type(`fun`,[hty;mk_type(`fun`,[tty;tty])]) in mk_comb(mk_comb(mk_const(`CONS`,consty),h),t)) ? failwith `mk_cons`;; % dest_cons "[t;t1;...;tn]" ----> ("t","[t1;...;tn]") % let dest_cons tm = (let (c,h),t = ((dest_comb # I) o dest_comb) tm in if fst(dest_const c) = `CONS` then (h,t) else fail) ? failwith `dest_cons`;; let is_cons = can dest_cons;; % mk_list (["t1";...;"tn"],":ty") ----> "[t1;...;tn]:(ty)list" % let mk_list (els,ty) = (let nil = mk_const(`NIL`,mk_type(`list`,[ty])) in itlist (curry mk_cons) els nil) ? failwith `mk_list`;; % dest_list "[t1;...;tn]:(ty)list" ----> (["t1";...;"tn"],":ty") % letrec dest_list tm = (let h,t = dest_cons tm in let l,ty = dest_list t in (h.l),ty) ? (let `NIL`,`list`,[ty] = ((I # dest_type) o dest_const) tm in [],ty) ? failwith `dest_list`;; let is_list = can dest_list;; % If list_mk_cons were to be implemented it should behave as follows: % % % % list_mk_cons (["h1";...;"hm"],"[t1;...;tn]") ----> "[h1;...;hm;t1;...;tn]" % % % % though I don't think it would be used much [RJB 90.10.24]. % %=============================================================================% % Constructor, destructor and discriminator functions for paired abstractions % % [JRH 91.07.17] % %=============================================================================% %--------------------------------------% % mk_pabs - Makes a paired abstraction % %--------------------------------------% let mk_pabs = let mk_uncurry(xt,yt,zt) = mk_const(`UNCURRY`,mk_type(`fun`, [mk_type(`fun`,[xt; mk_type(`fun`,[yt;zt])]); mk_type(`fun`,[mk_type(`prod`,[xt;yt]); zt])])) in letrec mpa(varst,bod) = if is_var varst then mk_abs(varst, bod) else let (vs1,vs2) = dest_pair varst in let cab = mpa(vs1,mpa(vs2,bod)) in mk_comb(mk_uncurry(type_of vs1, type_of vs2, type_of bod),cab) in \(varst,bod). mpa(assert is_pair varst,bod) ? failwith `mk_pabs`;; %-------------------------------------------------------------% % dest_pabs - Destroys (possibly multiply) paired abstraction % %-------------------------------------------------------------% let dest_pabs = let ucheck = assert (curry$= `UNCURRY` o fst o dest_const) in letrec dpa tm = dest_abs tm ? let (_,unc) = (ucheck # I) (dest_comb tm) in let (lv,(rv,bod)) = (I # dpa) (dpa unc) in (mk_pair(lv,rv),bod) in \tm. (assert is_pair # I) (dpa tm) ? failwith `dest_pabs`;; %--------------------------------------------------------% % is_pabs - Tests whether a term is a paired abstraction % %--------------------------------------------------------% let is_pabs = can dest_pabs;; % ===================================================================== % % Lhs and rhs of an equation. % % ===================================================================== % let lhs tm = fst(dest_eq tm) ? failwith `lhs` and rhs tm = snd(dest_eq tm) ? failwith `rhs`;; % ===================================================================== % % Search a term for a sub-term satisfying the predicate p % % ===================================================================== % letrec find_term p tm = if (p tm) then tm else if (is_abs tm) then find_term p (snd (dest_abs tm)) else if (is_comb tm) then (let rator,rand = dest_comb tm in find_term p rator ? find_term p rand) else failwith `find_term`;; % ===================================================================== % % Operator and operand % % ===================================================================== % let rator tm = fst(dest_comb tm) ? failwith `rator` and rand tm = snd(dest_comb tm) ? failwith `rand`;; % ===================================================================== % % Bound variable and body Added RJB 90.10.22 % % ===================================================================== % let bndvar tm = fst(dest_abs tm) ? failwith `bndvar` and body tm = snd(dest_abs tm) ? failwith `body`;; % ===================================================================== % % Find all subterms in a term that satisfy a given predicate p. % % Added TFM 88.03.31 % % ===================================================================== % let find_terms p tm = letrec accum tl p tm = let tl' = if p tm then tm.tl else tl in if is_abs tm then accum tl' p (snd (dest_abs tm)) else if is_comb tm then accum (accum tl' p (rator tm)) p (rand tm) else tl' in accum [] p tm;; % ===================================================================== % % mk_primed_var(name,ty): Makes a variable with a name that is a primed % % variant of name and type ty. Adds primes to the string name until it % % is not the name of a constant in the current theory --- I.e. until % % mk_var (name,ty) succeeds. % % % % Added TFM 88.03.31 % % Modified by MJCG for HOL88 (30/11/88) as mk_var no longer fails % % ===================================================================== % letrec mk_primed_var(name,ty) = if ascii_code(hd(explode name)) = 96 then fail if not(is_constant name) then mk_var(name,ty) else mk_primed_var(name ^ `'`, ty);; % ===================================================================== % % Some functions for theories (see also hol_thyfns.ml) % % ===================================================================== % % Introduce an axiom % let new_axiom(tk,tm) = let gen_all t = list_mk_forall (frees t, t) in fst(new_open_axiom(tk, mk_form(gen_all tm)), RecordStep(NewAxiomStep(tk,tm))) ? failwith `new_axiom`;; % Introduce an axiom without generalizing free variables (used for making definitions) % let new_open_axiom(tk,tm) = new_open_axiom(tk, mk_form tm) ? failwith `new_open_axiom`;; % --------------------------------------------------------------------- % % Introduce a predicate - i.e. a function of type ty->bool % % % % NB: this overwrites the PPLAMBDA version of new_predicate. % % % % This line saves the PPLAMBDA version, but is commented out since this % % function is not used anywhere % % let new_pp_predicate = new_predicate;; % % % % Deleted: [TFM 90.09.09] % % --------------------------------------------------------------------- % let new_predicate(tok,ty) = new_constant(tok, ":^ty -> bool");; let mk_definition t = mk_comb(mk_const(`HOL_DEFINITION`,":bool->bool"),t);; let dest_definition t = (let C,t1 = dest_comb t in if fst(dest_const C)=`HOL_DEFINITION` then t1 else fail ) ? failwith `dest_definition`;; let is_definition = can dest_definition;; let store_definition(name,t) = fst(mk_thm([],dest_definition(concl(new_open_axiom(name,mk_definition t)))), RecordStep(StoreDefinitionStep(name,t)));; let theorem thy factname = fst(paired_theorem (thy,factname), RecordStep(TheoremStep(thy,factname))) and new_type arity tok = fst(paired_new_type (arity,tok), RecordStep(NewTypeStep(arity,tok))) and delete_thm thy factname = paired_delete_thm (thy,factname);; let pp_axiom thy factname = axiom (thy,factname);; let axiom thy ax = let th = pp_axiom thy ax in if is_definition(concl th) then failwith `axiom` else fst(th, RecordStep(AxiomStep(thy,ax)));; % --------------------------------------------------------------------- % %< Deleted by WW 6 Dec 93. A function having the same name is defined in hol-thyfn.ml which will mask out this definition. Restored by WW 2 Jan 94 because this fiunction is needed to build basic-hol which does not include the file hol-thyfn.ml >% let definition thy ax = fst(mk_thm([],dest_definition(concl(pp_axiom thy ax))), RecordStep(DefinitionStep(thy,ax))) ? failwith `definition`;; % --------------------------------------------------------------------- % % Introduce an infix % % % % let new_infix = new_curried_infix;; % % % % Now dml-ed to be new_infix in the first place! [TFM 91.03.17] % % Adding RecordStep for proof recording [WW 05-07-93] % % --------------------------------------------------------------------- % let new_infix(s,ty) = fst(new_infix(s,ty), RecordStep(NewConstantStep(s,ty)));; % ML code for declaring and keeping track of binders % % Modification J.Joyce Apr 87 - move lisp expression for declaring the % % ml function "parse_as_binder" to a separate lisp source because of % % problems with nesting "|". % % % % Modified to define parse_as_binder earlier in the build sequence. % % This fixes the binder inheritance bug. TFM 92.10.01 for HOL88 2.01 % % % % lisp (concat (concat `(load "` lisp_dir_pathname) `parse_as_binder")`);; % % ---------------------------------------------------------------------- % % tuple operations used only for storing binders: deleted [TFM 91.02.24] % % ["t1"; ... ;"tn"] --> "(t1, ... ,tn)" % % Function mk_tuple deleted: [TFM 91.02.24] % % let mk_tuple = end_itlist (curry mk_pair);; % % let mk_tuple l = itlist (curry mk_pair) l arb_term;; % % ["t1"; ... ;"tn"] --> "(t1, ... ,tn)" % % letrec dest_tuple t = % % (let x,y = dest_pair t in x . (dest_tuple y)) ? [t];; % % % % letrec dest_tuple t = % % if t = arb_term then [] else ($. o (I # dest_tuple) o dest_pair) t;; % % ---------------------------------------------------------------------- % % Store ["t1";...;"tn"] as the "theorem" |- BINDERS(t1,...,tn) (binders are stored as theorems rather than axioms as the list of binders needs to be deleted when extending a theory and axioms can't be deleted). % let store_binders l = let t = itlist (curry mk_pair) l arb_term % was mk_tuple l % in save_thm (`LIST_OF_BINDERS`, mk_thm ([], mk_comb(mk_const(`BINDERS`,mk_type(`fun`,[type_of t;":bool"])), t)));; % list of binders in the current theory % letref list_of_binders = []:term list;; % Introduce a binder % let new_binder(tok,ty) = let tok1,tyl1 = (dest_type ty ? failwith `bad binder type`) in let tok2,tyl2 = (dest_type(hd tyl1) ? failwith `bad binder type`) in if not((tok1=`fun`) or (tok2=`fun`)) then failwith `bad binder type` else (parse_as_binder tok; new_constant(tok,ty); list_of_binders := mk_const(tok,ty).list_of_binders; ());; % Added on 25/11/1988 for HOL88: new_specification `flag` `name` `C` |- ?x. ... x ... declares C as a new constant and then does new_axiom(`name`, "... C ...") `flag` must be one of `constant`, `infix` or `binder` and determines the syntactic stutus of C. To avoid Roger Jones type problems, it is required that there be no type variables in types of subterms of "... C ..." that do not occur in the type of C. This rules out, for example, new_specification(tok, `Wonk`, |- ?b:bool. b = !x y:*. x=y) The specification above was amended on 8/2/89 to the following: new_specification name [`flag1`,`C1`; ... ; `flagn,Cn`] |- ?x1 ... xn. ... x1 ... xn ... declares C1, ... ,Cn as a new constants and then does new_axiom(`name`, "... C1 ... Cn ..."); `flagi` must be one of `constant`, `infix` or `binder` and determines the syntactic stutus of Ci. To avoid Roger Jones type problems, it is required that there be no type variables in types of subterms of "... C1 ... Cn ..." that do not occur in the types of any Ci (1 <= i <= n). This rules out, for example, new_specification (`Wonk_DEF`, [`constant`,`Wonk`,`], |- ?b:bool. b = !x y:*. x=y) which would define a constant "Wonk" of type ":bool" by the inconsistent axiom: |- Wonk = !x y:*. x=y % % Auxiliary function to strip off n quantifiers % letrec n_strip_quant dest_fn n t = if n=0 then ([],t) else let x,t' = dest_fn t in let l,t'' = n_strip_quant dest_fn (n-1) t' in (x.l,t'');; % Auxiliary function to test whether a type is the possible type of an infix. % let is_infix_type ty = let op,l = dest_type ty in if op = `fun` then (if fst(dest_type(hd(tl l)))=`fun` then true else false) else false;; % Auxiliary function to test whether a type is the possible type of an binder. % let is_binder_type ty = let op,l = dest_type ty in if op = `fun` then (if fst(dest_type(hd l))=`fun` then true else false) else false;; % Auxiliary function to check the arguments to new_specification; fails (with useful message) or returns (["x1";...;"xn"], "... x1 ... xn ...") % let check_specification defname flag_name_list th = if not(draft_mode()) then failwith `not in draft mode` if not(null(hyp th)) then failwith `no assumptions to theorem allowed in specifications` if not(null(frees(concl th))) then failwith(itlist (\t s. fst(dest_var t)^` `^s) (frees(concl th)) `is (are) unbound variable(s) in specification`) else map (\(flag,name). if is_constant name then failwith (`attempt to specify an existing constant: ` ^ name) if not(allowed_constant name) then failwith (name ^ ` is not an allowable constant name`) if not (mem flag [`constant`;`infix`;`binder`]) then failwith(concat flag ` must be \`constant\`, \`infix\` or \`binder\``) ) flag_name_list; let vars,body = (n_strip_quant dest_exists (length flag_name_list) (concl th) ? failwith `too few existentially quantified variables`) in map (\var. if not(null(subtract (tyvars body) (tyvars var))) then failwith(itlist (\vty s. dest_vartype vty^` `^s) (subtract (tyvars body) (tyvars var)) (`should occur in the type of `^(fst(dest_var var))))) vars; map2 (\((flag,name),var). if (flag = `infix`) & not(is_infix_type(type_of var)) then failwith(fst(dest_var var)^` doesn't have infix type`) if (flag = `binder`) & not(is_binder_type(type_of var)) then failwith(fst(dest_var var)^` doesn't have binder type`)) (flag_name_list,vars); (vars,body);; let new_specification defname flag_name_list th = let vars,body = check_specification defname flag_name_list th in map2 (\((flag,name),var). if flag = `constant` then new_constant(name,type_of var) if flag = `infix` then new_infix(name,type_of var) else new_binder(name,type_of var)) (flag_name_list,vars); store_definition (defname, subst (map2 (\((flag,name),var). (mk_const(name,type_of var),var)) (flag_name_list,vars)) body);; % new_definition(tok,"C ... = t") declares C as a new constant and then does new_axiom(tok,"C ... = t"). "C ..." must be a as described below, all free variables in t must be bound in "C ..." and C must not occur in t. Free variables in the definition may be universally quantified % % check that tm is a where: ::= | (,...,) and that there are no repeated variables. Return list of variables. % letrec check_varstruct tm = if is_var tm then [tm] else (let t1,t2 = (dest_pair tm ? failwith `bad varstruct`) in let l1 = check_varstruct t1 and l2 = check_varstruct t2 in if intersect l1 l2 = [] then l1@l2 else failwith `repeated variable in varstruct`);; % check that tm is a where: ::= | and that no variables are repeated. Return list of variables. % letrec check_lhs tm = if is_var tm then [tm] if is_const tm then failwith(`attempt to redefine the constant ` ^ (fst(dest_const tm))) if not(is_comb tm) then failwith`lhs not of form "x = ..." or "f x = ... "` else (let t1,t2 = dest_comb tm in let l1 = check_lhs t1 and l2 = check_varstruct t2 in if intersect l1 l2 = [] then l1@l2 else failwith `var used twice`);; % if "C ... = (...:ty)" then (get_type "C ..." ty) gives the type of C. % letrec get_type left rightty = (if is_var left then rightty else get_type (rator left) ":^(type_of(rand left))->^rightty" ) ? failwith `bad lhs`;; % The derived rule DEF_EXISTS_RULE : term -> thm proves that a function defined by a definitional equation exists. The implementation below uses mk_thm, but this will be changed eventually. % let DEF_EXISTS_RULE tm = let vars,(left,right) = (((I # dest_eq) o strip_forall) tm ? failwith`definition not an equation`) in let leftvars = check_lhs left and ty = get_type left (type_of right) and rightvars = frees right in if not(set_equal(intersect leftvars rightvars)rightvars) then failwith`unbound var in rhs` if mem(hd leftvars)rightvars then failwith `recursive definitions not allowed` else (let name = fst(dest_var(hd leftvars)) and v = hd leftvars in (if not(null(subtract (tyvars right) (tyvars v))) then failwith(dest_vartype(hd(subtract (tyvars right) (tyvars v)))^ ` an unbound type variable in definition`) if not(allowed_constant name) then failwith (concat name ` is not allowed as a constant name`) else fst(mk_thm([], mk_exists (v, list_mk_forall ((union vars (tl leftvars)), mk_eq(left,right)))), RecordStep(DefExistsRuleStep tm))));; let new_gen_definition flag (tok,tm) = let def_thm = DEF_EXISTS_RULE tm in let name = (fst o dest_var o fst o dest_exists o concl) def_thm in new_specification tok [flag,name] def_thm;; let new_definition = new_gen_definition `constant`;; % Old version: let new_definition(tok,tm) = let vars,(left,right) = (((I # dest_eq) o strip_forall) tm ? failwith`bad definition`) in let leftvars = check_lhs left and ty = get_type left (type_of right) and rightvars = frees right in if not(set_equal(intersect leftvars rightvars)rightvars) then failwith`unbound var in rhs` if mem(hd leftvars)rightvars then failwith `recursive definitions not allowed` else (let name = fst(dest_var(hd leftvars)) and v = hd leftvars in ((new_constant(name, ty); store_definition (tok, list_mk_forall(vars,mk_eq(subst[mk_const(name,ty),v]left, right)))) ) ? failwith `disallowed constant or not in draft`);; % % new_infix_definition(tok,"C ... = t") declares C as a new curried infix and then does new_axiom(tok,"C ... = t"). Note that C must appear in prefix form in the declaration. % let new_infix_definition = new_gen_definition `infix`;; % Old version: let new_infix_definition(tok,tm) = let vars,(left,right) = (((I # dest_eq) o strip_forall) tm ? failwith`bad definition`) in let ty = get_type left (type_of right) and leftvars = check_lhs left and rightvars = frees right in if not(set_equal(intersect leftvars rightvars)rightvars) then failwith`unbound var in rhs` if mem(hd leftvars)rightvars then failwith `recursive definitions not allowed` else (let name = fst(dest_var(hd leftvars)) and v = hd leftvars in ((new_infix(name, ty); store_definition (tok, list_mk_forall(vars,mk_eq(subst[mk_const(name,ty),v]left, right)))) ) ? failwith `disallowed infix`);; % % --------------------------------------------------------------------- % % let infixes = curried_infixes;; % % % % Now dml-ed to be infixes in the first place! [TFM 91.03.17] % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % new_theory [revised: TFM 90.06.05] % % NOTE this overwrites the function new_theory defined using dml. % % --------------------------------------------------------------------- % let new_theory tok = (can store_binders list_of_binders; new_theory tok; list_of_binders := []; ());; % --------------------------------------------------------------------- % % close_theory % % % % close_pp_theory made local: [TFM 90.06.05] % % NOTE this overwrites the function close_theory defined using dml. % % --------------------------------------------------------------------- % let close_theory = let close_pp_theory = close_theory in \x:void.(store_binders list_of_binders; close_theory(); list_of_binders := []; ()) ? failwith`close_theory`;; % --------------------------------------------------------------------- % % binders: fetch list of binders from a theory % % % % Now fails on non-ancestor theories. [JRH 91.06.19] % % --------------------------------------------------------------------- % let binders = letrec dest_tuple t = if t = arb_term then [] else ($. o (I # dest_tuple) o dest_pair) t in \thy. if thy=`-` or mem thy (ancestry()) then let thl = ([theorem thy `LIST_OF_BINDERS`] ? []) in if null thl then [] else (let t1,t2 = dest_comb(concl(hd thl)) in if fst(dest_const t1)=`BINDERS` then dest_tuple t2 else fail) ? failwith `binders: invalid binder list in theory `^thy else failwith `binders: `^thy^` is not an ancestor`;; % --------------------------------------------------------------------- % % activate_binders: tell the parser about binders % % --------------------------------------------------------------------- % let activate_binders thy = map (parse_as_binder o fst o dest_const) (binders thy);; % --------------------------------------------------------------------- % % ancestors --- Get the (proper) ancestors of a theory. % % Added by WW 05-07-93. % % The original slow implementation was in hol-thyfn.ml. % % The local function % % all_parents = -: string list -> string list -> string list % % all_parents plist thyl returns a list of theory names which are the % % ancestors of the theories in thyl and not in plist. % % --------------------------------------------------------------------- % let ancestors = letrec all_parents plist = fun [] . plist | (thy . thyl) . if (mem thy plist) then all_parents plist thyl else ( let pl = parents thy in let vl = subtract pl ( (intersect pl plist)) in (all_parents (thy . plist) (vl @ thyl))) in (\thy'. let thy = (thy' = `-`) => (current_theory()) | thy' in let ths = all_parents [] [thy] in snd(remove (\th. th = thy) ths));; % --------------------------------------------------------------------- % % CHANGED BY WW 8 Feb 1993 % % Attempt to speed up the loading of theory % % 1) make the following functions local in this section: % % activate_all_binders % % 2) add new function all_parents. It is similar to the function % % ancestors but return the argument and all ancestors, % % and it runs much faster than the old ancestors(). % % 3) add the list thy_chked to remember the theories whose binders have % % been activated. % % --------------------------------------------------------------------- % begin_section `load_thy`;; % --------------------------------------------------------------------- % % activate_all_binders: activate the binders on a theory and all its % % ancestor theories. % % OLD VERSION: % %letrec activate_all_binders thy = % % if thy = `HOL` % % then [] % % else % % (let bl = activate_binders thy % % and pl = parents thy % % in % % itlist (\tok tokl. activate_all_binders tok @ tokl) pl bl);; % % Changed by WW 8 Feb 93 % % This function is reimplemented. It runs much faster. % % It does not repeatedly go into a ancestor theory and every theory % % whose binders have been activated is remembered in the list thy_chked % % --------------------------------------------------------------------- % letref thy_chked = []:string list;; let activate_all_binders thy = let pl = thy . (ancestors thy) in let nl = subtract pl thy_chked in (thy_chked := union pl thy_chked; (itlist (\l1 l2. (activate_binders l1) @ l2) nl []));; % --------------------------------------------------------------------- % % load_theory % % % % load_pp_theory made local: [TFM 90.06.05] % % NOTE this overwrites the function load_theory defined using dml. % % Changed by WW 5 Feb 93 % % call the local active_all_binders to prevent % % repeatedly activate binders. % % --------------------------------------------------------------------- % let load_theory = \thy. (load_theory thy; activate_all_binders thy; ());; % --------------------------------------------------------------------- % % extend_theory % % % % extend_pp_theory made local: [TFM 90.06.05] % % NOTE this overwrites the function extend_theory defined using dml. % % Changed by WW 5 Feb 93 % % call the local active_all_binders to prevent % % repeatedly activate binders. % % --------------------------------------------------------------------- % let extend_theory = \thy. (extend_theory thy; activate_all_binders thy; list_of_binders := binders thy; ((delete_thm thy `LIST_OF_BINDERS`; ()) ? ()); ());; % --------------------------------------------------------------------- % % new_parent [TFM 92.02.22] % % Added so that binders in parent and its ancestors are activated. % % NOTE this overwrites the function new_parent defined using dml. % % Changed by WW 5 Feb 93 % % call the local activate_all_binders to prevent repeatedly activate % % binders. % % --------------------------------------------------------------------- % let new_parent thy = (new_parent thy; activate_all_binders thy; ());; (load_theory, extend_theory, new_parent);; end_section `load_thy`;; let (load_theory, extend_theory, new_parent) = it;; let new_binder_definition = new_gen_definition `binder`;; % Old version: let new_binder_definition(tok,tm) = let vars,(left,right) = (((I # dest_eq) o strip_forall) tm ? failwith`bad definition`) in let ty = get_type left (type_of right) and leftvars = check_lhs left and rightvars = frees right in if not(set_equal(intersect leftvars rightvars)rightvars) then failwith`unbound var in rhs` if mem(hd leftvars)rightvars then failwith `recursive definitions not allowed` else (let name = fst(dest_var(hd leftvars)) and v = hd leftvars in ((new_binder(name, ty); store_definition (tok, list_mk_forall(vars,mk_eq(subst[mk_const(name,ty),v]left, right)))) ) ? failwith `disallowed binder`);; % % ===================================================================== % % new_type_definition: define a new logical type. % % % % USAGE: new_type_definition(name, pred, thm) (DRAFT MODE ONLY) % % % % ARGUMENTS: name --- a string giving the name of the new type or % % type operator that is to be defined. % % % % pred --- a term denoting a predicate which is to % % define a subset of an existing type (ty say) % % that is to represent the new type. The type % % of pred must be "ty -> bool" and pred must % % must contain no free variables. % % % % thm --- a theorem asserting the existence of some % % object of type ty that satisfies pred. The % % theorem must be of the form "|- ?x. pred x" for % % some variable x. The theorem must have no % % assumptions. % % % % SIDE EFFECTS: 1) Introduces a new type (type operator) with the % % given name. The arity of the new type operator % % is the same as the number of type variables in the % % predicate pred. Fails if name is already the name of % % an existing type. % % % % 2) Asserts an axiom stating that there is an isomorphism% % from the new type to the subset of ty defined by the % % predicate pred. The name of this axiom will be % % form `name_TY_DEF`. If an axiom (or definition) % % with this name already exists, then the call fails. % % % % The form of the axiom asserted will be as follows: % % % % new_type_definition(`ty`, "P", |- ?x. P x) % % % % yields the axiom: % % % % ty_TY_DEF = |- ?rep. TYPE_DEFINITION P rep % % % % I.e. there is a function rep from the new type to % % the representing type ty that is one to one and onto % % the subset defined by P. % % % % RETURNS: the axiom as a theorem. % % % % IMPLEMENTATION NOTE: the dml'ed ML function is_axiom here tests if an % % axiom, OR definition is already in the current theory. % % ===================================================================== % let new_type_definition (name,pred,thm) = if not(draft_mode()) then failwith `not in draft mode` else if is_axiom (current_theory(),(name ^ `_TY_DEF`)) then failwith `"` ^ name ^ `_TY_DEF" already an axiom or definition` else if not(null(frees pred)) then failwith `subset predicate must be a closed term` else if not((I # tl)(dest_type(type_of pred))=(`fun`,[":bool"]) ? false) then failwith `subset predicate has the wrong type` else if not(null(hyp thm)) then failwith `existence theorem must have no assumptions` else if not((pred = rator(snd(dest_exists(concl thm))))?false) then failwith `existence theorem must match subset predicate` else if (is_type name) then failwith name ^ ` is already the name of a type or type operator` else let _,[ty;_] = dest_type(type_of pred) and evar = fst(dest_exists(concl thm)) in let tyvarsl = tyvars pred in new_type (length tyvarsl) name; let newty = mk_type (name,tyvarsl) in let repty = mk_type (`fun`,[newty;ty]) in let rep = mk_primed_var(`rep`, repty) in let bool = mk_type (`bool`,[]) in let TYDEF_ty = mk_type (`fun`,[mk_type(`fun`,[ty;bool]); mk_type(`fun`,[repty;bool])]) in let TYDEF = mk_const(`TYPE_DEFINITION`,TYDEF_ty) in let ax = mk_exists(rep,mk_comb(mk_comb(TYDEF,pred),rep)) in store_definition (name ^ `_TY_DEF`,ax);; % ===================================================================== % % Functions for interpreting tokens as ML % % % % space and ascii_ize made local [TFM 90.06.01] % % ===================================================================== % let ML_eval = let space = ascii_code ` ` in let ascii_ize tok = itlist (\n l. map ascii_code (explode n)@[space]@l) (words tok) [] in (inject_input o ascii_ize);; % ===================================================================== % % Definition of pre terms in ML % % ===================================================================== % rectype preterm = preterm_var of string % Variables % | preterm_const of string % Constants % | preterm_comb of preterm # preterm % Combinations % | preterm_abs of preterm # preterm % Abstractions % | preterm_typed of preterm # type % Explicit typing % | preterm_antiquot of term;; % Antiquotation % % ===================================================================== % % Constraining the type of the Lisp defined typechecker % % ===================================================================== % let preterm_to_term = preterm_to_term : preterm -> term;; hol88-2.02.19940316/ml/prim_rec.ml0000640000212700021270000002622205424210742014472 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: prim_rec.ml % % % % DESCRIPTION: Primitive recursive definitions on arbitrary recursive% % types. Assumes the type is defined by an axiom of % % the form proved by the recursive types package. % % % % See my Ph.D. thesis for details % % % % AUTHOR: T. F. Melham (87.08.23) % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % %=============================================================================% %< Moved to the file lis.ml remove x satisfying p from l.... giving x and the thing and rest of l letrec remove p l = if (p(hd l)) then ((hd l), (tl l)) else (I # (\r. ((hd l) . r))) (remove p (tl l));; >% begin_section prove_rec_fn_exists;; % derive_existence_thm th tm % % % % If th is a rec type axiom and tm is a term giving a prim rec % % definition, derive an existence theorem for doing the definition. % % The existence theorem has cases corresponding to those in tm and % % is suitably type-instantiated. % % % % E.g. Input % % % % |- !f0 f1 f2 e. ?! fn. % % (!x0 x1 t t'. fn(C1 t x0 t' x1) = f0(fn t)(fn t')x0 x1 t t') /\ % % (!t. fn(C2 t) = f1(fn t)t) /\ % % (!x. fn(C3 x) = f2 x) /\ % % (fn C4 = e) % % % % "(!n b. Fn n C4 b = ...) /\ % % (!b n m t x t'. Fn n (C1 t' b t m) x = ...) /\ % % (!m x q. Fn m (C3 x) q = ...)" % % % % Output: % % % % |- !e f0 f2. ?fn. % % (!g1 g2. fn C4 g1 g2 = e g1 g2) /\ % % (!g3 g4 g5 g6 g7 g8. fn(C1 g5 g3 g6 g4) g7 g8 = % % f0(fn g5)(fn g6)g3 g4 g5 g6) g7 g8 /\ % % (!g9 g10 g11. fn(C3 g9) g10 g11 = f2 g9 g10 g11) % % % % Note: the g's are genvars (so are e ... f2) % let derive_existence_thm th tm = (let vars = map(genvar o type_of) (fst(strip_forall(concl th))) in let exists = CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV (SPECL vars th)) in let e_fn = fst(dest_exists (concl exists)) in let conjs = conjuncts tm in letrec splt l = if (is_var (hd l)) then (let bv,C,av = splt (tl l) in ((hd l).bv,C,av)) else if (is_const (hd l) or (is_comb (hd l))) then [],(hd l),(tl l) else fail in let bv,Con,av =splt(snd(strip_comb(lhs(snd(strip_forall(hd conjs)))))) in let rhsfn = let cv = genvar(type_of Con) in let r = rhs(snd(strip_forall(hd conjs))) in list_mk_abs(cv. (bv @ av),r) in let th_inst = INST_TYPE (snd(match e_fn rhsfn)) exists in let get_c t = let args = snd(strip_comb(lhs(snd(strip_forall t)))) in let c = fst(strip_comb(find (\t.is_const t or is_comb t) args)) in (if (is_const c) then c else fail) in let cs = map get_c conjs in let exl = CONJUNCTS (SELECT_RULE th_inst) in let fn = fst(dest_exists(concl th_inst)) in let same_c c cl = (c = fst(strip_comb(rand(lhs(snd(strip_forall(concl cl))))))) in letrec get_ths cs exl = if (null cs) then [] else (let (c,ex) = remove (same_c(hd cs)) exl in (c.(get_ths (tl cs) ex))) in let ths = (get_ths cs exl) in let argvars = map (genvar o type_of) (bv @ av) in let ap_ths th = let v = map (genvar o type_of) (fst(strip_forall(concl th))) in let th1 = rev_itlist (C AP_THM) argvars (SPECL v th) in (GENL (v @ argvars) th1) in let th1 = LIST_CONJ (map ap_ths ths) in let sel = mk_select(dest_exists (concl th_inst)) in GEN_ALL(EXISTS(mk_exists(fn,subst [fn,sel](concl th1)),sel)th1))? failwith `Can't derive existence theorem`;; % mk_fn: make the function for the rhs of a clause in the existence thm % % % % returns: 1) the function % % 2) a list of variables that the clause should be SPECl % % 3) a pre-done beta-conversion of the rhs. % let mk_fn (cl,(Fn,bv,C,av,r)) = let lcl = hd(snd(strip_comb(lhs(snd(strip_forall cl))))) in let lclvars = tl(snd(strip_comb(lhs(snd(strip_forall cl))))) in let m = (fst(match lcl C)) @ combine((bv @ av),lclvars) in let cl' = subst m (snd(strip_forall cl)) in let nonrec = filter(is_var)(snd(strip_comb(rhs cl'))) in let rec = filter(is_comb)(snd(strip_comb(rhs cl'))) in let recvars = map (genvar o type_of) rec in let basepat = list_mk_comb(Fn,(map (genvar o type_of) bv)) in let find t = find_terms (\tm. can (match "^basepat ^t") tm & (fst(strip_comb tm) = Fn) & (rand tm = t)) in letrec do_subst (new,old) tm = if (tm = old) then new else if (is_abs tm) then mk_abs((I # do_subst(new,old))(dest_abs tm)) else if (is_comb tm) then let fn = do_subst(new,old) # do_subst(new,old) in mk_comb((fn(dest_comb tm))) else tm in let mk_substs (rc,rcv) t = let occs = find (rand rc) t in let args tm = snd(strip_comb (rator tm)) in let news = map (\tm. list_mk_comb(rcv,args tm)) occs in itlist do_subst (combine(news,occs)) t in let r' = itlist mk_substs (combine(rec,recvars)) r in let varsub = map (\v. (genvar (type_of v)),v) (recvars @ nonrec) in let fn = list_mk_abs(fst(split varsub),subst varsub r') in let specl = map (\v.(fst(rev_assoc v m))? v) (fst(strip_forall cl)) in let beta = LIST_BETA_CONV(list_mk_comb(fn,snd(strip_comb(rhs cl')))) in (fn,specl,beta);; % instantiate_existence_thm eth tm : instantiate eth to match tm % % % % E.g. INPUT: % % % % |- !e f0 f2. ?fn. % % (!g1 g2. fn C4 g1 g2 = e g1 g2) /\ % % (!g3 g4 g5 g6 g7 g8. fn(C1 g5 g3 g6 g4) g7 g8 = % % f0(fn g5)(fn g6)g3 g4 g5 g6) g7 g8 /\ % % (!g9 g10 g11. fn(C3 g9) g10 g11 = f2 g9 g10 g11) % % % % % % "(!n b. Fn n C4 b = ...) /\ % % (!b n m t x t'. Fn n (C1 t' b t m) x = ...) /\ % % (!m x q. Fn m (C3 x) q = ...)" % % % % OUTPUT: % % |- ?fn. (!n b. fn C4 n b = ...) /\ % % (!b n m t x t'. fn (C1 t' b t m) n x = ...) /\ % % (!m x q. fn (C3 x) m q = ...) % let instantiate_existence_thm eth tm = (let cls = map (snd o strip_forall) (conjuncts tm) in letrec splt l = if (is_var (hd l)) then (let bv,C,av = splt (tl l) in ((hd l).bv,C,av)) else if (is_const (hd l) or (is_comb (hd l))) then [],(hd l),(tl l) else fail in let dest tm = let ((Fn,(bv,C,av)),r)=(((I # splt) o strip_comb) # I)(dest_eq tm) in (Fn,bv,C,av,r) in let destcl = (map dest cls) in let ecls = conjuncts(snd(dest_exists(snd(strip_forall(concl eth))))) in let fns,spec,beta = (I # split) (split(map mk_fn (combine(ecls,destcl)))) in let ethsp = SPECL fns eth in let conjs = map (uncurry SPECL) (combine(spec,CONJUNCTS(SELECT_RULE ethsp))) in let rule (th1,th2) = CONV_RULE (RAND_CONV (REWR_CONV th1)) th2 in let th = LIST_CONJ (map (GEN_ALL o rule) (combine(beta,conjs))) in let fn = fst(dest_exists (concl ethsp)) and fsel = mk_select(dest_exists(concl ethsp)) in (EXISTS (mk_exists(fn,subst [fn,fsel] (concl th)),fsel) th))? failwith `Can't instantiate existence theorem`;; % prove_rec_fn_exists th tm % % % % Given 1) th, a recursion theorem (type axiom) % % 2) tm, the specification of a recursive function % % % % proves that such a function exists. % % Quantify the equations of the function spec. % let closeup tm = let lvars t = subtract (freesl(snd(strip_comb(lhs(snd (strip_forall t)))))) (fst(strip_forall t)) in list_mk_conj(map (\tm.list_mk_forall(lvars tm,tm)) (conjuncts tm));; % MJCG 17/1/89: added test for attempted redefinition of a constant and % % code to propagate failure message % let prove_rec_fn_exists th tm = (let eth = derive_existence_thm th tm in let ith = instantiate_existence_thm eth tm in letrec get_avars tm = if (is_var (rand tm)) then (get_avars (rator tm)) else (snd(strip_comb (rator tm)),rand tm) in let cl = snd(strip_forall(hd(conjuncts tm))) in let fn = fst(strip_comb(lhs cl)) and av,tv = (map (genvar o type_of) # (genvar o type_of)) (get_avars (lhs cl)) in if is_const fn then failwith(fst(dest_const fn)^` previously defined`) else let goal = ([],mk_exists(fn,closeup tm)) in let etac th = let efn = fst(strip_comb(lhs(snd(strip_forall(concl th))))) in EXISTS_TAC (list_mk_abs(av@[tv],list_mk_comb(efn,tv.av))) in let fn_beta th (A,gl) = let efn = fst(strip_comb(lhs(snd(strip_forall(concl th))))) in let eabs = (list_mk_abs(av@[tv],list_mk_comb(efn,tv.av))) in let epat = list_mk_comb(eabs, map (genvar o type_of) (av @ [tv])) in let tms = find_terms (\tm. can (match epat) tm) gl in PURE_ONCE_REWRITE_TAC (map LIST_BETA_CONV tms) (A,gl) in GEN_ALL(TAC_PROOF(goal, STRIP_ASSUME_TAC ith THEN FIRST_ASSUM etac THEN REPEAT STRIP_TAC THEN FIRST_ASSUM fn_beta THEN FIRST_ASSUM MATCH_ACCEPT_TAC)))?\tok failwith(`Can't solve recursion equation: `^tok);; prove_rec_fn_exists;; end_section prove_rec_fn_exists;; let prove_rec_fn_exists = it;; % Make a new recursive function definition. % % Old code: let new_recursive_definition infix_flag th name tm = let thm = prove_rec_fn_exists th tm in if (is_forall (concl thm)) then failwith `definition contains free vars` else let def = mk_eq(fst(dest_exists (concl thm)), mk_select(dest_exists (concl thm))) in let defn = if (infix_flag) then new_infix_definition (name ^ `_DEF`,def) else new_definition (name ^ `_DEF`,def) in save_thm (name,SUBS [SYM defn] (SELECT_RULE thm));; New code for HOL88: % let new_recursive_definition infix_flag th name tm = let thm = prove_rec_fn_exists th tm in new_specification name [(infix_flag=>`infix`|`constant`), ((fst o dest_var o fst o dest_exists o concl) thm)] thm;; hol88-2.02.19940316/ml/tactics.ml0000640000212700021270000004122605521224703014325 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: tactics.ml % % % % DESCRIPTION: tactics inverting the inference rules, and other basic% % tactics % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, % % tacont.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml,tacont.ml % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`; loadf `ml/tacont`);; % Accepts a theorem that satisfies the goal A ========= ACCEPT_TAC "|-A" - % % --------------------------------------------------------------------- % % Revised to return a theorem alpha-identical to goal. [TFM 93.07.22] % % OLD CODE: % % % % let ACCEPT_TAC th :tactic (asl,w) = % % if aconv (concl th) w then [], \[].th % % else failwith `ACCEPT_TAC`;; % % --------------------------------------------------------------------- % let ACCEPT_TAC th :tactic (asl,w) = if aconv (concl th) w then [], \[]. EQ_MP (ALPHA (concl th) w) th else failwith `ACCEPT_TAC`;; % --------------------------------------------------------------------- % % DISCARD_TAC: checks that a theorem is useless, then ignores it. % % Revised: 90.06.15 TFM. % % --------------------------------------------------------------------- % let DISCARD_TAC : thm -> tactic = let truth = mk_const(`T`,mk_type(`bool`,[])) in % "T" % \th. \(asl,w). if exists (aconv (concl th)) (truth . asl) then ALL_TAC (asl,w) else failwith `DISCARD_TAC`;; % Contradiction rule A =========== CONTR_TAC "|- FALSITY ()" - % let CONTR_TAC cth :tactic (asl,w) = (let th = CONTR w cth in [], \[].th) ? failwith `CONTR_TAC`;; % Put a theorem onto the assumption list. Note: since an assumption B denotes a theorem B|-B, you cannot instantiate types or variables in assumptions. A =========== |- B [B] A % let ASSUME_TAC bth :tactic (asl,w) = [ ((concl bth) . asl) , w], \[th]. PROVE_HYP bth th;; %"Freeze" a theorem to prevent instantiation A =========== ttac "B|-B" ... % let FREEZE_THEN ttac bth :tactic = \g. let gl,prf = ttac (ASSUME (concl bth)) g in gl, PROVE_HYP bth o prf;; % Conjunction introduction A /\ B =============== A B % let CONJ_TAC :tactic (asl,w) = (let l,r = dest_conj w in [(asl,l); (asl,r)], \[th1;th2]. CONJ th1 th2 ) ? failwith `CONJ_TAC`;; % Disjunction introduction A \/ B ============== A % let DISJ1_TAC : tactic (asl,w) = (let a,b = dest_disj w in [(asl,a)], \[tha]. DISJ1 tha b) ? failwith `DISJ1_TAC`;; % A \/ B ============== B % let DISJ2_TAC :tactic (asl,w) = (let a,b = dest_disj w in [(asl,b)], \[thb]. DISJ2 a thb) ? failwith `DISJ2_TAC`;; %Implication elimination A ================ |- B B ==> A % let MP_TAC thb :tactic (asl,wa) = [asl, mk_imp(concl thb, wa)], \[thimp]. MP thimp thb;; % --------------------------------------------------------------------- % % If-and-only-if introduction DELETED [TFM 91.01.20] % % % % A <=> B % % ================ % % A==>B B==>A % % % % let IFF_TAC : tactic (asl,w) = % % (let a,b = dest_iff w in % % [(asl, "^a==>^b"); (asl, "^b==>^a")], % % \[thab;thba]. CONJ_IFF (CONJ thab thba) % % ) ? failwith `IFF_TAC`;; % % --------------------------------------------------------------------- % % t1 = t2 ========================= t1 ==> t2 t2 ==> t1 % % MJCG 17/11/88 for HOL88 Recoded to use mk_imp to eliminate mk_comb failure and hence spurious error messages % let EQ_TAC:tactic (asl,t) = (let t1,t2 = dest_eq t in ([(asl, mk_imp(t1,t2)); (asl, mk_imp(t2,t1))], \[th1;th2]. IMP_ANTISYM_RULE th1 th2) ) ? failwith `EQ_TAC`;; % Universal quantifier % % !x.A(x) ============== A(x') explicit version for tactic programming; proof fails if x' is free in hyps % % let X_GEN_TAC x' :tactic (asl,w) = % % (let x,body = dest_forall w in % % [ (asl, subst[x',x]body) ], (\[th]. GEN x' th) % % ) ? failwith `X_GEN_TAC`;; % % T. Melham. X_GEN_TAC rewritten 88.09.17 % % % % 1) X_GEN_TAC x' now fails if x' is not a variable. % % % % 2) rewritten so that the proof yields the same quantified var as the % % goal. % % % % let X_GEN_TAC x' :tactic = % % if not(is_var x') then failwith `X_GEN_TAC` else % % \(asl,w).((let x,body = dest_forall w in % % [(asl,subst[x',x]body)], % % (\[th]. GEN x (INST [(x,x')] th))) % % ? failwith `X_GEN_TAC`);; % % Bugfix for HOL88.1.05, MJCG, 4 April 1989 % % Instantiation before GEN replaced by alpha-conversion after it to % % prevent spurious failures due to bound variable problems when % % quantified variable is free in assumptions. % % Optimization for the x=x' case added. % let X_GEN_TAC x' :tactic = if not(is_var x') then failwith `X_GEN_TAC` else \(asl,w).((let x,body = dest_forall w in if x=x' then ([(asl,body)], \[th]. GEN x' th) else ([(asl,subst[x',x]body)], \[th]. let th' = GEN x' th in EQ_MP (GEN_ALPHA_CONV x (concl th')) th')) ? failwith `X_GEN_TAC`);; % chooses a variant for the user; for interactive proof % % informative error string added [TFM 90.06.02] % let GEN_TAC :tactic (A,g) = let x,b = dest_forall g ? failwith `GEN_TAC: goal not universally quantified` in X_GEN_TAC (variant (freesl(g.A)) x) (A,g);; % A(t) ============ t,x !x.A(x) example of use: generalizing a goal before attempting an inductive proof as with Boyer and Moore valid only if x is not free in A(UU), but this test is slow % let SPEC_TAC (t,x) :tactic (asl,w) = ([ asl, mk_forall(x, subst [x,t] w)], \[th]. SPEC t th) ? failwith `SPEC_TAC` ;; % Existential introduction ?x.A(x) ============== t A(t) % let EXISTS_TAC t :tactic (asl,w) = (let x,body = dest_exists w in [asl, subst [t,x]body], \[th]. EXISTS (w,t) th ) ? failwith `EXISTS_TAC` ;; %Substitution% % These substitute in the goal; thus they DO NOT invert the rules SUBS and SUBS_OCCS, despite superficial similarities. In fact, SUBS and SUBS_OCCS are not invertible; only SUBST is. % let GSUBST_TAC substfn ths :tactic (asl,w) = let ls,rs = split (map (dest_eq o concl) ths) in let vars = map (genvar o type_of) ls in let base = substfn (combine(vars,ls)) w in [ asl, subst (combine(rs,vars)) base], \[th]. SUBST (combine(map SYM ths, vars)) base th ;; % A(ti) ============== |- ti == ui A(ui) % let SUBST_TAC ths = set_fail_prefix `SUBST_TAC` (GSUBST_TAC subst ths);; let SUBST_OCCS_TAC nlths = set_fail_prefix `SUBST_OCCS_TAC` (let nll,ths = split nlths in GSUBST_TAC (subst_occs nll) ths);; % A(t) =============== |- t==u A(u) works nicely with tacticals % let SUBST1_TAC rthm = SUBST_TAC [rthm];; %Map an inference rule over the assumptions, replacing them% let RULE_ASSUM_TAC rule = POP_ASSUM_LIST (\asl. MAP_EVERY ASSUME_TAC (rev (map rule asl)));; %Substitute throughout the goal and its assumptions% let SUBST_ALL_TAC rth = SUBST1_TAC rth THEN RULE_ASSUM_TAC (SUBS [rth]);; let CHECK_ASSUME_TAC gth = FIRST [CONTR_TAC gth; ACCEPT_TAC gth; DISCARD_TAC gth; ASSUME_TAC gth];; let STRIP_ASSUME_TAC = (REPEAT_TCL STRIP_THM_THEN) CHECK_ASSUME_TAC;; % given a theorem: |- (?y1. (x=t1(y1)) /\ B1(x,y1)) \/ ... \/ (?yn. (x=tn(yn)) /\ Bn(x,yn)) where each y is a vector of zero or more variables and each Bi is a conjunction (Ci1 /\ ... /\ Cin) A(x) =============================================== [Ci1(tm,y1')] A(t1) . . . [Cin(tm,yn')] A(tn) such definitions specify a structure as having n different possible constructions (the ti) from subcomponents (the yi) that satisfy various constraints (the Cij) % let STRUCT_CASES_TAC = REPEAT_TCL STRIP_THM_THEN (\th. SUBST1_TAC th ORELSE ASSUME_TAC th);; % --------------------------------------------------------------------- % % COND_CASES_TAC: tactic for doing a case split on the condition p % % in a conditional (p => u | v). % % % % Find a conditional "p => u | v" that is free in the goal and whose % % condition p is not a constant. Perform a case split on the condition. % % % % % % t[p=>u|v] % % ================= COND_CASES_TAC % % {p} t[u] % % {~p} t[v] % % % % [Revised: TFM 90.05.11] % % --------------------------------------------------------------------- % let COND_CASES_TAC :tactic = let is_good_cond tm = not(is_const(fst(dest_cond tm))) ? false in \(asl,w). let cond = find_term (\tm. is_good_cond tm & free_in tm w) w ? failwith `COND_CASES_TAC` in let p,t,u = dest_cond cond in let inst = INST_TYPE [type_of t, ":*"] COND_CLAUSES in let (ct,cf) = CONJ_PAIR (SPEC u (SPEC t inst)) in DISJ_CASES_THEN2 (\th. SUBST1_TAC (EQT_INTRO th) THEN SUBST1_TAC ct THEN ASSUME_TAC th) (\th. SUBST1_TAC (EQF_INTRO th) THEN SUBST1_TAC cf THEN ASSUME_TAC th) (SPEC p EXCLUDED_MIDDLE) (asl,w) ;; %Cases on |- p=T \/ p=F % let BOOL_CASES_TAC p = STRUCT_CASES_TAC (SPEC p BOOL_CASES_AX);; %Strip one outer !, /\, ==> from the goal% let STRIP_GOAL_THEN ttac = FIRST [GEN_TAC; CONJ_TAC; DISCH_THEN ttac];; % Like GEN_TAC but fails if the term equals the quantified variable % let FILTER_GEN_TAC tm : tactic (asl,w) = if is_forall w & not (tm = fst(dest_forall w)) then GEN_TAC (asl,w) else failwith `FILTER_GEN_TAC`;; %Like DISCH_THEN but fails if the antecedent mentions the term% let FILTER_DISCH_THEN ttac tm : tactic (asl,w) = if is_neg_imp w & not (free_in tm (fst(dest_neg_imp w))) then DISCH_THEN ttac (asl,w) else failwith `FILTER_DISCH_THEN`;; %Like STRIP_THEN but preserves any part of the goal that mentions the term% let FILTER_STRIP_THEN ttac tm = FIRST [ FILTER_GEN_TAC tm; FILTER_DISCH_THEN ttac tm; CONJ_TAC];; let DISCH_TAC = \g. DISCH_THEN ASSUME_TAC g ? failwith `DISCH_TAC`;; let DISJ_CASES_TAC = DISJ_CASES_THEN ASSUME_TAC;; let CHOOSE_TAC = CHOOSE_THEN ASSUME_TAC;; let X_CHOOSE_TAC x = X_CHOOSE_THEN x ASSUME_TAC;; let STRIP_TAC = \g. STRIP_GOAL_THEN STRIP_ASSUME_TAC g ? failwith `STRIP_TAC`;; let FILTER_DISCH_TAC = FILTER_DISCH_THEN STRIP_ASSUME_TAC;; let FILTER_STRIP_TAC = FILTER_STRIP_THEN STRIP_ASSUME_TAC;; % Cases on |- t \/ ~t % let ASM_CASES_TAC t = DISJ_CASES_TAC(SPEC t EXCLUDED_MIDDLE);; % --------------------------------------------------------------------- % % A tactic inverting REFL (from tfm). % % % % A = A % % ============== % % % % Revised to work if lhs is alpha-equivalent to rhs [TFM 91.02.02] % % Also revised to retain assumptions. % % --------------------------------------------------------------------- % let REFL_TAC:tactic (asl,g) = let (l,r) = dest_eq g ? failwith `REFL_TAC: not an equation` in let asms = itlist ADD_ASSUM asl in if (l=r) then [], K (asms (REFL l)) else if (aconv l r) then [], K (asms (ALPHA l r)) else failwith `REFL_TAC: lhs and rhs not alpha-equivalent`;; % UNDISCH_TAC - tactic, moves one of the assumptions as LHS of an implication to the goal (fails if named assumption not in assumptions) UNDISCH_TAC: term -> tactic tm [ t1;t2;...;tm;tn;...tz ] t ====================================== [ t1;t2;...;tn;...tz ] tm ==> t % let UNDISCH_TAC tm (asl,t) = if mem tm asl then ([subtract asl [tm], mk_imp(tm,t)], UNDISCH o hd) else failwith `UNDISCH_TAC`;; % --------------------------------------------------------------------- % % AP_TERM_TAC: Strips a function application off the lhs and rhs of an % % equation. If the function is not one-to-one, does not preserve % % equivalence of the goal and subgoal. % % % % f x = f y % % ============= % % x = y % % % % Added: TFM 88.03.31 % % Revised: TFM 91.02.02 % % --------------------------------------------------------------------- % let AP_TERM_TAC:tactic (asl,gl) = let l,r = dest_eq gl ? failwith `AP_TERM_TAC: not an equation` in let g,x = dest_comb l ? failwith `AP_TERM_TAC: lhs not an application` in let f,y = dest_comb r ? failwith `AP_TERM_TAC: rhs not an application` in if not(f=g) then failwith `AP_TERM_TAC: functions on lhs and rhs differ` else ([asl, mk_eq(x,y)], (AP_TERM f o hd));; % --------------------------------------------------------------------- % % AP_THM_TAC: inverts the AP_THM inference rule. % % % % f x = g x % % ============= % % f = g % % % % Added: TFM 91.02.02 % % --------------------------------------------------------------------- % let AP_THM_TAC:tactic (asl,gl) = let l,r = dest_eq gl ? failwith `AP_THM_TAC: not an equation` in let g,x = dest_comb l ? failwith `AP_THM_TAC: lhs not an application` in let f,y = dest_comb r ? failwith `AP_THM_TAC: rhs not an application` in if not(x=y) then failwith `AP_THM_TAC: arguments on lhs and rhs differ` else ([asl, mk_eq(g,f)], (C AP_THM x o hd));; % ===================================================================== % % EXISTS_REFL_TAC % % % % A, ?x1...xn. tm[t1'...tn'] = tm[x1....xn] % % ----------------------------------------- % % - % % % % Added: TFM 88.03.31 % % % % Temporarily deleted, pending reimplementation. The tactic should % % really unify lhs and rhs! [TFM 91.02.05] % % ===================================================================== % % % % let EXISTS_REFL_TAC (A,g) = % % (let v,(l,r) = (I # dest_eq)(strip_exists g) in % % let m = (fst(match l r)) in % %((MAP_EVERY (\v. EXISTS_TAC (snd(assoc v m))) v) THEN % % REFL_TAC) (A,g)) ? % % failwith `EXISTS_REFL_TAC`;; % % --------------------------------------------------------------------- % hol88-2.02.19940316/ml/rewrite.ml0000640000212700021270000004415005530161544014356 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: rewrite.ml % % % % DESCRIPTION: Simple rewriting rules and tactics for HOL % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, % % conv.ml, hol-net.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, etc % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`; loadf `ml/conv`; loadf `ml/hol-net`);; % ===================================================================== % % Section for defining mk_conv_net [TFM 91.03.17] % % ===================================================================== % begin_section mk_conv_net;; % --------------------------------------------------------------------- % % Redundant GEN_ALL/SPEC_ALL combinations resulting from applying % % mk_conv_net to mk_rewrite eliminated as was done by Konrad Slind in % % HOL90 [JG 92.04.24] % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % mk_rewrites: split a theorem into a list of theorems suitable for % % rewriting by doing: % % % % 1. Specialize all variables (SPEC_ALL). % % % % 2. Then do the following: % % % % |- t1 /\ t2 --> [|- t1 ; |- t2] % % |- t1 <=> t2 --> [|- t1=t2] % % % % 3. Then |- t --> |- t = T and |- ~t --> |- t = F % % % % iff case deleted [TFM 91.01.20] % % optimized [TFM 91.03.17] % % --------------------------------------------------------------------- % letrec mk_rewrites th = (let thm = SPEC_ALL th in let t = concl thm in if is_eq t then [thm] else if is_conj t then let (c1,c2) = CONJ_PAIR thm in (mk_rewrites c1 @ mk_rewrites c2) else if is_neg t then [EQF_INTRO thm] else [EQT_INTRO thm]) ? failwith `mk_rewrites`;; % --------------------------------------------------------------------- % % [th1; ... ; thn] --> (mk_rewrites th1) @ ... @ (mk_rewrites thn) % % --------------------------------------------------------------------- % let mk_rewritesl thl = itlist (append o mk_rewrites ) thl [];; % --------------------------------------------------------------------- % % Inefficient ML implementation of nets as lists of pairs: % % % % let enter_term(t,x)n = (t,x).n % % and lookup_term n t = % % mapfilter(\(t',x).if can(match t)t' then x else fail) % % and nil_term_net = []:(term#*)list;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Build a conv net from a list of theorems % % --------------------------------------------------------------------- % let mk_conv_net thl = itlist enter_term (map (\th. (lhs(concl th),REWR_CONV th)) (mk_rewritesl thl)) nil_term_net;; % --------------------------------------------------------------------- % % Export mk_conv_net outside of section. % % --------------------------------------------------------------------- % mk_conv_net;; end_section mk_conv_net;; let mk_conv_net = it;; % ===================================================================== % % List of basic rewrites (temporarily made assignable to enable % % experimental changes to be quickly made) % % ===================================================================== % % |- !t. (!x.t) = t % let FORALL_SIMP = let t = "t:bool" and x = "x:*" in GEN t (IMP_ANTISYM_RULE (DISCH "!^x.^t" (SPEC x (ASSUME "!^x.^t"))) (DISCH t (GEN x (ASSUME t))));; % |- !t. (?x.t) = t % let EXISTS_SIMP = let t = "t:bool" and x = "x:*" in GEN t (IMP_ANTISYM_RULE (DISCH "?^x.^t" (CHOOSE("p:*", ASSUME"?^x.^t")(ASSUME t))) (DISCH t (EXISTS("?^x.^t", "r:*")(ASSUME t))));; % |- !t1 t2. (\x. t1)t2 = t1 % let ABS_SIMP = GEN_ALL(BETA_CONV "(\x:*.(t1:**))t2");; let basic_rewrites = [REFL_CLAUSE; EQ_CLAUSES; NOT_CLAUSES; AND_CLAUSES; OR_CLAUSES; IMP_CLAUSES; COND_CLAUSES; % IFF_EQ; |- !t1 t2. (t1<=>t2) = (t1=t2) DELETED [TFM 91.01.20] % FORALL_SIMP; EXISTS_SIMP; ABS_SIMP; PAIR; FST; SND ];; % ===================================================================== % % Main rewriting conversion % % ===================================================================== % let GEN_REWRITE_CONV = let RW_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm in \(rewrite_fun:conv->conv) built_in_rewrites. let basic_net = mk_conv_net built_in_rewrites in \thl. rewrite_fun (RW_CONV (merge_term_nets (mk_conv_net thl) basic_net));; % --------------------------------------------------------------------- % % Rewriting conversions. % % % % Modified to use special versions of the depth conversions. % % [RJB 94.02.15] % % --------------------------------------------------------------------- % let PURE_REWRITE_CONV = GEN_REWRITE_CONV REW_DEPTH_CONV [] and REWRITE_CONV = GEN_REWRITE_CONV REW_DEPTH_CONV basic_rewrites and PURE_ONCE_REWRITE_CONV = GEN_REWRITE_CONV ONCE_REW_DEPTH_CONV [] and ONCE_REWRITE_CONV = GEN_REWRITE_CONV ONCE_REW_DEPTH_CONV basic_rewrites;; %====================================================================== % % Main rewriting rule % % OLD version: % % % % let GEN_REWRITE_RULE = % % let REWRITE_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm in % % \rewrite_fun built_in_rewrites. % % let basic_net = mk_conv_net built_in_rewrites in % % \thl. let conv = rewrite_fun % % (REWRITE_CONV(merge_term_nets (mk_conv_net thl) % % basic_net)) in % % \th. EQ_MP (conv (concl th)) th;; % % % % New version rewritten using the new GEN_REWRITE_CONV [JG 92.04.07] % % The code is most simply expressed as follows: % % % % let GEN_REWRITE_RULE rewrite_fun built_in_rewrites thl = % % CONV_RULE (GEN_REWRITE_CONV rewrite_fun built_in_rewrites thl) ;; % % % % However, it is optimised below so that the built_in_rewrites gets % % made into a conv net at compile time. % % % % Futher optimized 13.5.93 by JVT to remove the function composition % % to enhance speed. % % % % OLD VERSION: % % % % let GEN_REWRITE_RULE rewrite_fun built_in_rewrites = % % let REWL_CONV = GEN_REWRITE_CONV rewrite_fun built_in_rewrites in % % CONV_RULE o REWL_CONV ;; % %====================================================================== % let GEN_REWRITE_RULE rewrite_fun built_in_rewrites = let REWL_CONV = GEN_REWRITE_CONV rewrite_fun built_in_rewrites in \tm. (CONV_RULE (REWL_CONV tm));; % --------------------------------------------------------------------- % % Rewriting rules. % % % % Modified to use special versions of the depth conversions. % % [RJB 94.02.15] % % --------------------------------------------------------------------- % let PURE_REWRITE_RULE = GEN_REWRITE_RULE REW_DEPTH_CONV [] and REWRITE_RULE = GEN_REWRITE_RULE REW_DEPTH_CONV basic_rewrites and PURE_ONCE_REWRITE_RULE = GEN_REWRITE_RULE ONCE_REW_DEPTH_CONV [] and ONCE_REWRITE_RULE = GEN_REWRITE_RULE ONCE_REW_DEPTH_CONV basic_rewrites;; % --------------------------------------------------------------------- % % Rewrite a theorem with the help of its assumptions % % --------------------------------------------------------------------- % let PURE_ASM_REWRITE_RULE thl th = PURE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th and ASM_REWRITE_RULE thl th = REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th and PURE_ONCE_ASM_REWRITE_RULE thl th = PURE_ONCE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th and ONCE_ASM_REWRITE_RULE thl th = ONCE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; % --------------------------------------------------------------------- % % Rules that rewrite using those assumptions that satisfy a predicate % % --------------------------------------------------------------------- % let FILTER_PURE_ASM_REWRITE_RULE f thl th = PURE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_ASM_REWRITE_RULE f thl th = REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_PURE_ONCE_ASM_REWRITE_RULE f thl th = PURE_ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th and FILTER_ONCE_ASM_REWRITE_RULE f thl th = ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th;; %====================================================================== % % Main rewriting tactic % % OLD version: % % % % let GEN_REWRITE_TAC = % % let REWRITE_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm in % % \rewrite_fun built_in_rewrites. % % let basic_net = mk_conv_net built_in_rewrites in % % \thl.let conv = rewrite_fun % % (REWRITE_CONV(merge_term_nets (mk_conv_net thl) % % basic_net)) in % % \(A,t):goal. let th = conv t in % % let (),right = dest_eq(concl th) in % % if right="T" % % then ([], \[]. EQ_MP (SYM th) TRUTH) % % else ([A,right], \[th']. EQ_MP (SYM th) th');; % % % % New version rewritten using the new GEN_REWRITE_CONV [JG 92.04.07] % % The code is most simply expressed as follows: % % % % let GEN_REWRITE_TAC rewrite_fun built_in_rewrites thl = % % CONV_TAC (GEN_REWRITE_CONV rewrite_fun built_in_rewrites thl) ;; % % % % However, it is optimised below so that the built_in_rewrites gets % % made into a conv net at compile time. % % % % Futher optimized 13.5.93 by JVT to remove the function composition % % to enhance speed. % % % % OLD VERSION: % % % % let GEN_REWRITE_TAC rewrite_fun built_in_rewrites = % % let REWL_CONV = GEN_REWRITE_CONV rewrite_fun built_in_rewrites in % % CONV_TAC o REWL_CONV ;; % %====================================================================== % let GEN_REWRITE_TAC rewrite_fun built_in_rewrites = let REWL_CONV = GEN_REWRITE_CONV rewrite_fun built_in_rewrites in \tm. (CONV_TAC (REWL_CONV tm));; % --------------------------------------------------------------------- % % Rewriting tactics. % % % % Modified to use special versions of the depth conversions. % % [RJB 94.02.15] % % --------------------------------------------------------------------- % let PURE_REWRITE_TAC = GEN_REWRITE_TAC REW_DEPTH_CONV [] and REWRITE_TAC = GEN_REWRITE_TAC REW_DEPTH_CONV basic_rewrites and PURE_ONCE_REWRITE_TAC = GEN_REWRITE_TAC ONCE_REW_DEPTH_CONV [] and ONCE_REWRITE_TAC = GEN_REWRITE_TAC ONCE_REW_DEPTH_CONV basic_rewrites;; % --------------------------------------------------------------------- % % Rewrite a goal with the help of its assumptions % % --------------------------------------------------------------------- % let PURE_ASM_REWRITE_TAC thl = ASSUM_LIST (\asl. PURE_REWRITE_TAC (asl @ thl)) and ASM_REWRITE_TAC thl = ASSUM_LIST (\asl. REWRITE_TAC (asl @ thl)) and PURE_ONCE_ASM_REWRITE_TAC thl = ASSUM_LIST (\asl. PURE_ONCE_REWRITE_TAC (asl @ thl)) and ONCE_ASM_REWRITE_TAC thl = ASSUM_LIST (\asl. ONCE_REWRITE_TAC (asl @ thl));; % --------------------------------------------------------------------- % % Tactics that rewrite using those assumptions that satisfy a predicate % % --------------------------------------------------------------------- % let FILTER_PURE_ASM_REWRITE_TAC f thl = ASSUM_LIST (\asl. PURE_REWRITE_TAC ((filter (f o concl) asl) @ thl)) and FILTER_ASM_REWRITE_TAC f thl = ASSUM_LIST (\asl. REWRITE_TAC ((filter (f o concl) asl) @ thl)) and FILTER_PURE_ONCE_ASM_REWRITE_TAC f thl = ASSUM_LIST (\asl. PURE_ONCE_REWRITE_TAC ((filter (f o concl) asl) @ thl)) and FILTER_ONCE_ASM_REWRITE_TAC f thl = ASSUM_LIST (\asl. ONCE_REWRITE_TAC ((filter (f o concl) asl) @ thl));; % --------------------------------------------------------------------- % % Search a sub-term of t matching u % % --------------------------------------------------------------------- % let find_match u = letrec find_mt t = (match u t ? find_mt(rator t) ? find_mt(rand t) ? find_mt(snd(dest_abs t)) ? failwith `find_match`) in find_mt;; % SUBST_MATCH (|-u=v) th searches for an instance of u in (the conclusion of) th and then substitutes the corresponding instance of v. Much faster than rewriting. % let SUBST_MATCH eqth th = let tm_inst,ty_inst = find_match (lhs(concl eqth)) (concl th) in SUBS [INST tm_inst (INST_TYPE ty_inst eqth)] th;; % Possible further simplifications: |- !t. ((\x.t1) t2) = t1 |- !t P. (!x. t /\ P x) = (t /\ (!x. P x)) | !x:*. (@x'.x'=x) = x |- !t1 t2 t3. (t1\/t2) ==> t3 = (t1==>t3) /\ (t2==>t3) |- !t1 t2 t3. (t1\/t2) /\ t3 = (t1/\t3) \/ (t2/\t3) |- !t1 t2 t3. t3 /\ (t1\/t2) = (t3/\t1) \/ (t3/\t2) |- !t P. (?x.P x) ==> t = !x'.(P x' ==> t) |- !t P. (?x.P x) /\ t = ?x'.(P x' /\ t) |- !t P. t /\ (?x.P x) = ?x'.(t /\ P x') |- !t1 t2. (t1<=>t2) = (t1==>t2 /\ t2==>t1) % hol88-2.02.19940316/ml/genfns.ml0000640000212700021270000000746505071125075014164 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: genfns.ml % % % % DESCRIPTION: Some general purpose ML functions % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% letrec map2 f (l1,l2) = if (null l1) then if (null l2) then [] else failwith `map2` else if (null l2) then failwith `map2` else f (hd l1,hd l2) . map2 f (tl l1,tl l2);; letrec itlist2 f (l1,l2) x = if (null l1) then if (null l2) then x else failwith `itlist2` else if (null l2) then failwith `itlist2` else f (hd l1,hd l2) (itlist2 f (tl l1,tl l2) x);; % --------------------------------------------------------------------- % % Used only once, so replaced by \(x,y).(y,x) [TFM 90.06.01] % % let flip(x,y) = (y,x);; % % --------------------------------------------------------------------- % let set_equal s1 s2 = subtract s1 s2 = [] & subtract s2 s1 = [];; letrec el i l = (if null l or i<1 then fail if i=1 then hd l else el (i-1) (tl l) ) ? failwith `el`;; % --------------------------------------------------------------------- % % functions: % % % % seg:(int#int)->(*)list->(*)list % % word_seg:(int#int)->(*)list->(*)list % % word_el:int->(*)list->* % % truncate:int->(*)list->(*)list % % % % moved to eval library [TFM 90.06.01] % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % The version of words used below uses space and as separators % % --------------------------------------------------------------------- % let word_separators = [` `; ` `];; let words string = snd (itlist (\ch (chs,tokl). if mem ch word_separators then if null chs then [],tokl else [], (implode chs . tokl) else (ch.chs), tokl) (` ` . explode string) ([],[]));; let maptok f = (map f) o words;; % make_set in ml/lis.ml has same functionality as setify, but a better % % definition, so definition below commented-out. [RJB 90.10.20] % % % % setify l removes repeated elements from l % % % % letrec setify l = % % if null l then [] % % if mem (hd l) (tl l) then setify(tl l) % % else hd l.(setify(tl l));; % let uncurry f (x,y) = f x y;; hol88-2.02.19940316/ml/goals.ml0000640000212700021270000001726605525725626014025 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: goals.ml % % % % DESCRIPTION: Utilities for maintaining subproofs, underlies goal % % stack package % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-thyfn.ml, hol-rule.ml, hol-drule.ml, drul.ml, % % tacticals.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: Subgoals numbered (MJCG 31.01.94) % %=============================================================================% % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, etc % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-thyfn`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`);; % mapcount f [x1;x2; ... ;xn] = [f 1 x1; f 2 x2; ... ;f n xn] % % Added 31.01.94 by MJCG to support new print_hyps % % Assignable print function. Added by RJB 6/6/90. % letref assignable_print_term = print_term;; % Added by MJCG 31.01.94 % new_flag(`number_subgoals`, true) ? ();; % Print assumptions -- in reverse order so new assumptions appear last. % % Term-printing function made assignable by RJB 6/6/90. % % Assumption numbering added by MJCG 31.01.94 % let print_hyps asl = let len = length asl + 1 in letrec map_fn f n l = if null l then [] else f n (hd l).map_fn f (n+1) (tl l) in let print n as = let asm_head = (if get_flag_value `number_subgoals` then ` ` ^ string_of_int(len-n) ^ (if (len-n) < 10 then ` [` if (len-n) < 100 then ` [` else `[`) else ` [`) in (print_string asm_head; assignable_print_term (as); print_string ` ]`; print_newline()) in do (map_fn print 1 (rev asl));; let print_goal (asl,w) = assignable_print_term w; print_newline(); print_hyps asl; print_newline();; % Version of ML function prove that prints out the unsolvable goals. Added by MJCG 12/11/89 (based on code from Phil Windley). % let PROVE : (term # tactic) -> thm = set_fail_prefix `PROVE` (\(t,tac). let gl,p = tac([],t) in if null gl then p[] else (message (`Unsolved goals:`); map print_goal gl; print_newline(); failwith `unsolved goals`));; %Prove and store a theorem% let prove_thm(tok, w, tac:tactic) = let gl,prf = tac ([],w) in if null gl then save_thm (tok, prf[]) else (message (`Unsolved goals:`); map print_goal gl; print_newline(); failwith (`prove_thm -- could not prove ` ^ tok));; lettype subgoals = goal list # proof;; % The key to handling subgoals is to incorporate proved ones into the proof immediately. Suppose a tactic returns three subgoals: [g1;g2;g3], prf3 after proving a theorem th1 that achieves g1, we get the subgoals [g2;g3], prf2 where prf2 [th2;th3] = prf3 [th1;th2;th3] rotating the subgoals gives us [g3;g2], prf2' where prf2' [th3;th2] = prf2 [th2;th3] % let root_goal g : subgoals = ([g], \[th].th);; let attempt_first ((gl,pr):subgoals) tac : subgoals = if null gl then failwith `no goals to expand` else tac (hd gl);; % rotate_goals modified to use hd, tl, @, last and butlast % % instead of rotate_left and rotate_right [RJB 90.10.20]. % let rotate_goals (gl,pr) :subgoals = (tl gl)@[hd gl], pr o (\l. (last l).(butlast l)) ? failwith `rotate_goals`;; let achieve_first (((asl,w).gl),pr) th :subgoals = (gl, \thl. pr (th . thl));; let apply_proof = set_fail_prefix `apply_proof` (\(([],pr):subgoals). pr[]);; %1 then (print_int ngs; print_string ` subgoals`; print_newline()) else if ngs=0 then (print_string `goal proved`; print_newline()); map print_goal (rev gl));; >% %< New version from Phil Windley: modified 10/6/89 to support print_all_subgoals flag -- PJW >% new_flag(`print_all_subgoals`, true) ? ();; % Trap added by MJCG 31.01.94 % let print_subgoals ((gl,pr):subgoals) = do (let ngs = length gl in ( if ngs>1 then (print_int ngs; print_string ` subgoals`; print_newline()) else if ngs=0 then (print_string `goal proved`; print_newline()); if get_flag_value(`print_all_subgoals`) then map print_goal (rev gl) else (if ngs > 1 then (print_string `Current subgoal: `;print_newline()); [if (ngs>0) then print_goal (hd gl)])));; let print_stack sg_stack n = let stack1 = fst (chop_list n sg_stack) ? sg_stack in do (map print_subgoals (rev stack1));; %Use completed proofs to satisfy goals% letrec pop_proofs sg_stack = (let (sgs1 . sgs2 . sg_tail) = sg_stack in let th = apply_proof sgs1 in print_thm th; print_newline (); pop_proofs (achieve_first sgs2 th . sg_tail)) ? sg_stack;; %pop proofs and print new stack if different% let pop_proofs_print sg_stack = let sg2 = pop_proofs sg_stack in if length sg2 < length sg_stack & not (null sg2) then (print_newline(); print_string `Previous subproof:`; print_newline(); print_stack sg2 1); sg2;; %Print a new layer of subgoals, and push it onto the stack% let push_print sgs sg_stack = print_subgoals sgs; sgs . sg_stack;; %Expand the top subgoal using the tactic; push and print new subgoals % %the f is for "fast" -- does not validate the tactic% let push_fsubgoals sg_stack tac = message `OK..`; if null sg_stack then failwith `Goal stack is empty` else pop_proofs_print (push_print (attempt_first (hd sg_stack) tac) sg_stack);; %push subgoals after validating the tactic% let push_subgoals sg_stack = (push_fsubgoals sg_stack) o VALID;; %Rotate subgoals on stack top% let rotate_top n (sgs . sg_stack) = push_print (funpow n rotate_goals sgs) sg_stack;; %Create a new goalstack, containing the initial goal% let new_stack g = push_print (root_goal g) [];; %Extract proof on top of stack% let top_proof (sgs . sg_stack) = apply_proof sgs;; hol88-2.02.19940316/ml/num.ml0000640000212700021270000004057205526467262013513 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: num.ml % % % % DESCRIPTION: Derived rules/tactics for :num. Assumes that theorems% % from arithmetic.th are already loaded. % % % % Provied for compatibility with old HOL: % % - INDUCT_TAC % % - new_prim_rec_definition % % - new_infix_prim_rec_definition % % % % AUTHOR: MJCG and TFM % % % % USES FILES: ind.ml, prim_rec.ml, numconv.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% if compiling then (loadf `ml/ind`;loadf `ml/prim_rec`;loadf `ml/numconv`);; % --------------------------------------------------------------------- % % INDUCT: (thm # thm) -> thm % % % % A1 |- t[0] A2 |- !n. t[n] ==> t[SUC n] % % ----------------------------------------------- % % A1 u A2 |- !n. t[n] % % --------------------------------------------------------------------- % let INDUCT = let INDUCTION = theorem `num` `INDUCTION` in \(base,step). (let n,body = dest_forall(concl step) in let assm,conc = dest_imp body in let P = "\^n.^assm" and v1 = genvar bool_ty and v2 = genvar bool_ty in let base' = EQ_MP (SYM(BETA_CONV "^P 0")) base and step' = SPEC n step and hypth = SYM(RIGHT_BETA(REFL "^P ^n")) and concth = SYM(RIGHT_BETA(REFL "^P(SUC ^n)")) and IND = SPEC P INDUCTION in let th1 = SUBST [hypth,v1;concth,v2] "^(concl step') = (^v1 ==> ^v2)" (REFL (concl step')) in let th2 = GEN n (EQ_MP th1 step') in let th3 = SPEC n (MP IND (CONJ base' th2)) in GEN n (EQ_MP (BETA_CONV(concl th3)) th3)) ? failwith`INDUCT`;; % --------------------------------------------------------------------- % % [A] !n.t[n] % % ================================ % % [A] t[0] , [A,t[n]] t[SUC x] % % --------------------------------------------------------------------- % let INDUCT_TAC = let INDUCTION = theorem `num` `INDUCTION` in let tac = INDUCT_THEN INDUCTION ASSUME_TAC in \g. tac g ? failwith `INDUCT_TAC`;; % --------------------------------------------------------------------- % % For compatibility of new/old HOL. % % --------------------------------------------------------------------- % let new_prim_rec_definition = let num_Axiom = theorem `prim_rec` `num_Axiom` in \(name,tm). new_recursive_definition false num_Axiom name tm;; let new_infix_prim_rec_definition = let num_Axiom = theorem `prim_rec` `num_Axiom` in \(name,tm). new_recursive_definition true num_Axiom name tm;; % --------------------------------------------------------------------- % % ADD_CONV: addition of natural number constants (numerals). % % % % If n and m are numerals (i.e 0,1,2,3,...) then: % % % % ADD_CONV "n + m" % % % % returns % % % % |- n + m = s % % % % where s is the numeral denoting the sum of n and m. % % % % NOTE: iterative version. % % --------------------------------------------------------------------- % let ADD_CONV = let nv = "n:num" and mv = "m:num" and numty = ":num" in let asym = SPECL [nv;mv] (theorem `arithmetic` `ADD_SYM`) in let Sth = let addc = theorem `arithmetic` `ADD_CLAUSES` in let t1,t2 = CONJ_PAIR (CONJUNCT2(CONJUNCT2 addc)) in (TRANS t1 (SYM t2)) in let ladd0 = let addc = theorem `arithmetic` `ADD_CLAUSES` in GEN "n:num" (CONJUNCT1 addc) in let v1 = genvar ":num" and v2 = genvar ":num" in let int_of_tm tm = int_of_string(fst(dest_const tm)) and tm_of_int i = mk_const(string_of_int i,numty) in let mk_pat = let pl = "$+" in let lra = mk_comb(pl,v1) in \(n,m). mk_eq(mk_comb(lra,m),mk_comb(mk_comb(pl,n),v2)) in let trans (c,mi) th = let n,m = (rand # I) (dest_comb(rand (concl th))) in let nint = tm_of_int c and mint = tm_of_int mi in let nth = SYM(num_CONV n) and mth = SYM(num_CONV mint) in let thm1 = INST [nint,mv;m,nv] Sth in (SUBST [nth,v1;mth,v2] (mk_pat(nint,m)) thm1) in let zconv = RAND_CONV(REWR_CONV ladd0) in let conv th (n,m) = letref thm,count,mint = th,n,m in if (count=0) then CONV_RULE zconv thm loop (count := count - 1 ; mint := mint + 1; thm := TRANS thm (trans (count,mint) thm)) in \tm. (let c,[n;m] = (assert (\c.c="+") # I) (strip_comb tm) in let nint = int_of_tm n and mint = int_of_tm m in if not(mint < nint) then conv (REFL tm) (nint,mint) else let th1 = conv (REFL(mk_comb(mk_comb(c,m),n))) (mint,nint) in TRANS (INST [n,nv;m,mv] asym) th1) ? failwith `ADD_CONV`;; % --------------------------------------------------------------------- % % num_EQ_CONV: equality of natural number constants. % % % % If n and m are numerals (i.e 0,1,2,3,...) or sucessors of numerals % % (e.g. SUC 0, SUC(SUC 2), etc), then: % % % % num_EQ_CONV "n = m" % % % % returns % % % % |- (n = m) = T if n=m % % |- (n = m) = F if ~(n=m) % % % % and if n and m are syntactically identical terms of type :num, then % % % % num_EQ_CONV "n = m" returns |- (n = m) = T % % % % NOTE: runs out of stack for large numbers. % % % % Fixed Bug: 5 May 1993, TFM. % % --------------------------------------------------------------------- % let num_EQ_CONV = let nv = genvar ":num" and mv = genvar ":num" in let rth = SPEC nv (theorem `prim_rec` `LESS_SUC_REFL`) and lnth = SPECL [nv;mv] (theorem `prim_rec` `LESS_NOT_EQ`) and lmth = SPECL [nv;mv] (theorem `prim_rec` `LESS_MONO`) and lz = SPEC nv (theorem `prim_rec` `LESS_0`) in let checkty = assert (\t. type_of t = ":num") in let check = let tm = "SUC" in assert (\t. t = tm) in let Suc = AP_TERM "SUC" in let int_of_tm tm = int_of_string(fst(dest_const tm)) in letrec val n = (int_of_tm n) ? val (snd((check # I) (dest_comb n)))+1 in let mk_pat = let less = "$<" in \n. mk_comb(mk_comb(less,n),mv) in let mk_pat2 = let less = "$<" in \m. mk_comb(mk_comb(less,nv),m) in letrec eqconv n m = if (n=m) then REFL n else if (is_const n) then let th = num_CONV n in TRANS th (eqconv (rand(concl th)) m) else if (is_const m) then let th = num_CONV m in TRANS (eqconv n (rand(concl th))) (SYM th) else Suc (eqconv (rand n) (rand m)) in letrec neqconv n m = if (is_const m) then let th = num_CONV m in let thm = (neqconv n (rand(concl th))) in SUBST [SYM th,mv] (mk_pat n) thm else let m' = rand m in if (n=m') then INST [n,nv] rth else if (is_const n) then if (n="0") then INST [m',nv] lz else let th = num_CONV n in let n' = rand(rand(concl th)) in let th2 = MP (INST [n',nv;m',mv] lmth) (neqconv n' m') in SUBST [SYM th,nv] (mk_pat2 m) th2 else let n' = rand n in MP (INST [n',nv;m',mv] lmth) (neqconv n' m') in \tm. (let n,m = (checkty # I) (dest_eq tm) in if (n=m) then EQT_INTRO (REFL n) else let nint = val n and mint = val m in if (mint=nint) then EQT_INTRO(eqconv n m) else if (nint ~P[n'] % % % % --------------------------------------------------------------------- % let EXISTS_LEAST_CONV = let wop = theorem `arithmetic` `WOP` in let wth = CONV_RULE (ONCE_DEPTH_CONV ETA_CONV) wop in let check = let ty = ":num" in assert (\tm. type_of tm = ty) in let acnv = RAND_CONV o ABS_CONV in \tm. (let n,P = (check # I) (dest_exists tm) in let thm1 = UNDISCH (SPEC (rand tm) wth) in let thm2 = CONV_RULE (GEN_ALPHA_CONV n) thm1 in let c1,c2 = dest_comb (snd(dest_exists(concl thm2))) in let bth1 = RAND_CONV BETA_CONV c1 in let bth2 = acnv (RAND_CONV (RAND_CONV BETA_CONV)) c2 in let n' = variant (n. frees tm) n in let abth2 = CONV_RULE (RAND_CONV (GEN_ALPHA_CONV n')) bth2 in let thm3 = EXISTS_EQ n (MK_COMB(bth1,abth2)) in let imp1 = DISCH tm (EQ_MP thm3 thm2) in let eltm = rand(concl thm3) in let thm4 = CONJUNCT1 (ASSUME (snd(dest_exists eltm))) in let thm5 = CHOOSE (n,ASSUME eltm) (EXISTS (tm,n) thm4) in IMP_ANTISYM_RULE imp1 (DISCH eltm thm5)) ? failwith `EXISTS_LEAST_CONV`;; %---------------------------------------------------------------------------% % EXISTS_GREATEST_CONV - Proves existence of greatest element satisfying P. % % % % EXISTS_GREATEST_CONV "(?x. P[x]) /\ (?y. !z. z > y ==> ~(P[z]))" = % % |- (?x. P[x]) /\ (?y. !z. z > y ==> ~(P[z])) = % % ?x. P[x] /\ !z. z > x ==> ~(P[z]) % % % % If the variables x and z are the same, the "z" instance will be primed. % % [JRH 91.07.17] % %---------------------------------------------------------------------------% let EXISTS_GREATEST_CONV = let LESS_EQ' = theorem `arithmetic` `LESS_EQ` and LESS_EQUAL_ANTISYM' = theorem `arithmetic` `LESS_EQUAL_ANTISYM` and NOT_LESS' = theorem `arithmetic` `NOT_LESS` and LESS_SUC_REFL' = theorem `prim_rec` `LESS_SUC_REFL` and LESS_0_CASES' = theorem `arithmetic` `LESS_0_CASES` and NOT_LESS_0' = theorem `prim_rec` `NOT_LESS_0` and num_CASES' = theorem `arithmetic` `num_CASES` and GREATER' = definition `arithmetic` `GREATER` in let EXISTS_GREATEST = PROVE ("!P.(?x. P x) /\ (?x. !y. y > x ==> ~P y) = ?x. P x /\ !y. y > x ==> ~P y", GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[GREATER'] THEN DISCH_THEN (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (X_CHOOSE_THEN "g:num" MP_TAC o CONV_RULE EXISTS_LEAST_CONV)) THEN DISCH_THEN (\th. EXISTS_TAC "g:num" THEN REWRITE_TAC[th] THEN MP_TAC th) THEN STRUCT_CASES_TAC (SPEC "g:num" num_CASES') THENL [REWRITE_TAC[NOT_LESS_0'] THEN DISCH_THEN (MP_TAC o SPEC "x:num") THEN DISJ_CASES_TAC (SPEC "x:num" LESS_0_CASES'); POP_ASSUM (K ALL_TAC) THEN DISCH_THEN (CONJUNCTS_THEN2 (MP_TAC o REWRITE_RULE[] o CONV_RULE (ONCE_DEPTH_CONV CONTRAPOS_CONV)) (X_CHOOSE_TAC "y:num" o REWRITE_RULE[NOT_IMP] o CONV_RULE NOT_FORALL_CONV o REWRITE_RULE[LESS_SUC_REFL'] o SPEC "n:num")) THEN DISCH_THEN (MP_TAC o SPEC "y:num") THEN ASM_REWRITE_TAC[NOT_LESS'] THEN POP_ASSUM (CONJUNCTS_THEN2 (\th. DISCH_THEN (SUBST1_TAC o MATCH_MP LESS_EQUAL_ANTISYM' o CONJ (REWRITE_RULE[LESS_EQ'] th))) ASSUME_TAC)]; DISCH_THEN CHOOSE_TAC THEN CONJ_TAC THEN EXISTS_TAC "x:num"] THEN ASM_REWRITE_TAC[]) in let t = RATOR_CONV and n = RAND_CONV and b = ABS_CONV in let red1 = t o n o t o n o n o b and red2 = t o n o n o n o b o n o b o n o n and red3 = n o n o b o t o n and red4 = n o n o b o n o n o b o n o n in \tm. (let (lc,rc) = dest_conj tm in let pred = rand lc in let (xv,xb) = dest_exists lc in let (yv,yb) = dest_exists rc in let zv = fst (dest_forall yb) in let prealpha = CONV_RULE (red1 BETA_CONV THENC red2 BETA_CONV THENC red3 BETA_CONV THENC red4 BETA_CONV) (SPEC pred EXISTS_GREATEST) in let rqd = mk_eq(tm,mk_exists(xv,mk_conj(xb,subst[(xv,yv)] yb))) in S (C EQ_MP) (C ALPHA rqd o concl) prealpha) ? failwith `EXISTS_GREATEST_CONV`;; %---------------------------------------------------------------------------% % A couple of useful function for converting between ML integers and % % numeric terms, e.g., "2" <---> 2 % %---------------------------------------------------------------------------% let term_of_int = \n. mk_const(string_of_int n, mk_type(`num`,[])) ;; let int_of_term = int_of_string o fst o dest_const ;; hol88-2.02.19940316/ml/killpp.ml0000640000212700021270000000436505071125077014175 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: killpp.ml % % % % DESCRIPTION: Removes traces of PPLAMBDA % % % % USES FILES: hol-lcf lisp files, ml-curry.ml, ml-gen.ml, ml-lis.ml,% % ml-site.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% lisp`(remprop 'UU 'const)`;; lisp`(remprop 'TT 'const)`;; lisp`(remprop 'FF 'const)`;; lisp`(remprop 'FST 'const)`;; lisp`(remprop 'SND 'const)`;; lisp`(remprop 'FIX 'const)`;; lisp`(remprop 'COND 'const)`;; lisp`(remprop 'PAIR 'const)`;; lisp`(remprop '|<<| 'ollp)`;; lisp`(remprop '|<<| 'ol2)`;; lisp`(remprop '|==| 'ollp)`;; lisp`(remprop '|==| 'ol2)`;; hol88-2.02.19940316/ml/hol-thyfn.ml0000640000212700021270000003720205500610333014575 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: hol-thyfn.ml % % % % DESCRIPTION: Definitions of functions for creating and accessing % % theories % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml % % (commented-out code depends on other ml files as well)% % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`);; % --------------------------------------------------------------------- % % ML for coding assumptions so that % % these can be restored on reading in theorems. % % % % This feature DELETED: TFM 90.12.01 % % Restored for storing theorems only: TFM 91.04.27 % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Section in which IS_ASSUMPTION_OF hack is implemented. % % --------------------------------------------------------------------- % begin_section IS_ASSUMPTION_OF;; let IS_ASSUMPTION_OF = definition `bool` `IS_ASSUMPTION_OF`;; % --------------------------------------------------------------------- % % ASSUMPTION_DISCH: % % % % A, t1 |- t2 % % --------------------------- % % A |- t1 IS_ASSUMPTION_OF t2 % % % % let ASSUMPTION_DISCH t1 th = % % EQ_MP (SYM(SPEC(concl th)(SPEC t1 IS_ASSUMPTION_OF))) (DISCH t1 th) % % ? failwith `ASSUMPTION_DISCH`;; % % --------------------------------------------------------------------- % let ASSUMPTION_DISCH t1 th = mk_thm(disch(t1,hyp th), "^t1 IS_ASSUMPTION_OF ^(concl th)") ? failwith`ASSUMPTION_DISCH`;; letrec ASSUMPTION_DISCH_ALL th = ASSUMPTION_DISCH_ALL (ASSUMPTION_DISCH (hd (hyp th)) th) ? th;; % --------------------------------------------------------------------- % % ASSUMPTION_UNDISCH: % % % % A |- t1 IS_ASSUMPTION_OF t2 % % --------------------------- % % t1, A1 |- t2 % % % % let ASSUMPTION_UNDISCH th = % % (let ((),t1),t2 = ((dest_comb # I) o dest_comb o concl) th % % in % % UNDISCH (EQ_MP (SPEC t2 (SPEC t1 IS_ASSUMPTION_OF)) th) % % ) ? failwith `ASSUMPTION_UNDISCH`;; % % --------------------------------------------------------------------- % let ASSUMPTION_UNDISCH th = (let (C,t1),t2 = ((dest_comb # I) o dest_comb o concl) th in if fst(dest_const C)=`IS_ASSUMPTION_OF` then mk_thm(union[t1](hyp th),t2) else fail ) ? failwith `ASSUMPTION_UNDISCH`;; letrec ASSUMPTION_UNDISCH_ALL th = ASSUMPTION_UNDISCH_ALL (ASSUMPTION_UNDISCH th) ? th;; let save_thm(name,th) = ASSUMPTION_UNDISCH_ALL (save_thm(name, ASSUMPTION_DISCH_ALL th));; % --------------------------------------------------------------------- % % Functions for dealing with the theorems of a theory. % % --------------------------------------------------------------------- % let theorem thy thm = ASSUMPTION_UNDISCH_ALL(theorem thy thm);; let delete_thm thy thm = ASSUMPTION_UNDISCH_ALL(delete_thm thy thm);; % --------------------------------------------------------------------- % % Revised: no ASSUMPTION_UNDISCH_ALL [TFM 90.12.01] % % % % Note that this OVERWRITES the ML function "theorems". % % % % ASSUMPTION_UNDISCH_ALL restored [TFM 91.04.27] % % --------------------------------------------------------------------- % let theorems thy = mapfilter (\(tok,th). if tok=`LIST_OF_BINDERS` then fail else (tok, ASSUMPTION_UNDISCH_ALL th)) (theorems thy);; % --------------------------------------------------------------------- % % End of section and export of values. % % --------------------------------------------------------------------- % (save_thm,theorem,delete_thm,theorems);; end_section IS_ASSUMPTION_OF;; let (save_thm,theorem,delete_thm,theorems) = it;; % --------------------------------------------------------------------- % % Get the (proper) ancestors of a theory. % % --------------------------------------------------------------------- % %< Deleted by WW 05-07-93. A faster implementation is in hol-syn.ml let ancestors = letrec f st = let ths = parents st in itlist union (map f ths) ths in \st. f st ? failwith `ancestors: ` ^ st ^ ` is not an ancestor`;; >% % --------------------------------------------------------------------- % % Functions for dealing with the constants of a theory. % % % % In HOL88 the ML function constants returns all constants, % % including binders and infixes. % % --------------------------------------------------------------------- % % The following definition masks the old value of "constants". % let constants = let pp_constants = constants in \thy. union (pp_constants thy) (infixes thy);; % --------------------------------------------------------------------- % % Functions for dealing with the axioms and definitions of a theory. % % % % HOL88 versions of the ML functions definition and definitions % % apply ASSUMPTION_UNDISCH_ALL to a stored definition. % % % % Use of ASSUMPTION_UNDISCH_ALL deleted [TFM 90.12.01] % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % The following definition masks the old value of "axioms". % % % % Conditional call to ASSUMPTION_UNDISCH_ALL deleted (conditional on % % a undisch_defs flag. [TFM 90.12.01] % % Adding proof recording for the function definition. [WW 6 Dec. 93] % % --------------------------------------------------------------------- % let (axioms,definition,definitions) = let pp_axioms = axioms in let dest_asm_definition t = let C,t1 = dest_comb t in if fst(dest_const C)=`HOL_DEFINITION` then (mk_thm([],t1)) else fail in (filter(\ (tok,th). not(is_definition(concl th))) o pp_axioms, (\thy name. fst(dest_asm_definition(concl(pp_axiom thy name)), RecordStep(DefinitionStep(thy,name))) ? failwith `definition`), (mapfilter(\ (tok,th). (tok, dest_asm_definition(concl th))) o pp_axioms));; % --------------------------------------------------------------------- % % Apply ASSUMPTION_UNDISCH_ALL to output of new_specification. % % Can't do this in the original definition in hol-syn.ml because % % ASSUMPTION_UNDISCH_ALL is not defined there. % % Should really reorganize source files! % % % % Calls to ASSUMPTION_UNDISCH_ALL removed, so this no longer needed % % % % let new_specification defname flag_name_list th = % % let defth = new_specification defname flag_name_list th % % in % % if get_flag_value`undisch_defs` % % then ASSUMPTION_UNDISCH_ALL defth % % else defth;; % % % % [TFM 90.12.01] % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % print_theory : print the contents of a theory. % % % % MJCG 31/1/89 for HOL88: print current theory name instead of `-`. % % % % Utilities for print_theory made local. [TFM 90.04.24] % % % % The utilities are: % % % % print_tok_ty : Print a token and type for constants and infixes. % % % % print_tok_thm : Print a labelled theorem (or axiom) % % % % apply_type_op : Create an example type using arguments of the form % % *, **, ***, etc. % % % % print_tok_all_thm : Print a labelled theorem with its assumptions % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % print_list : Print a non-empty list, labelled with name, using % % a supplied printing function prfn. % % --------------------------------------------------------------------- % let print_list incon name prfn l = if not (null l) then do (print_begin 2; print_string name; print_string ` --`; print_break (2,0); if incon then print_ibegin 0 else print_begin 0; map (\x. prfn x; print_break (5,0)) (rev l); print_end(); print_end(); print_newline());; let print_theory = letrec upto from to = if from>to then [] else from . (upto (from+1) to) in let print_tok_ty (tok,ty) = print_begin 2; print_string tok; print_break (1,0); print_type ty; print_end() and print_tok_thm (tok,th) = print_begin 2; print_string tok; print_break (2,0); print_thm th; print_end() and apply_type_op (arity, name) = mk_type (name, map (mk_vartype o implode o (replicate `*`)) (upto 1 arity)) and print_tok_all_thm (tok,th) = print_begin 2; print_string tok; print_break (2,0); print_all_thm th; print_end() in let print_const = print_tok_ty o dest_const in \tok.let thy = if (tok=`-`) then current_theory() else tok in print_string (`The Theory ` ^ thy); print_newline(); print_list true `Parents` print_string (parents thy); print_list true `Types` (print_type o apply_type_op) (types thy); print_list true `Type Abbreviations` print_tok_ty (type_abbrevs thy); print_list true `Constants` print_const (constants thy); print_list true `Infixes` print_const (infixes thy); print_list true `Binders` print_const (binders thy); print_list false `Axioms` print_tok_thm (axioms thy); print_list false `Definitions` print_tok_all_thm (definitions thy); print_list false `Theorems` print_tok_all_thm (theorems thy); print_string(`******************** ` ^ thy ^ ` ********************`); print_newline();print_newline();; % --------------------------------------------------------------------- % % Functions for loading in axioms, definitions and theorems % % --------------------------------------------------------------------- % % Printing made conditional on value of print_load flag % % in HOL88.1.05, MJCG April 6 1989. % let theorem_lfn[thy;th] = theorem thy th;; % undo_autoload th added in HOL88.1.02 to make autoloading in compiled ML files work. % let theorem_msg_lfn [thy;th] = (if get_flag_value `print_load` then (print_string (`Theorem `^th^` autoloading from theory \``^thy^`\` ...`); print_newline())); undo_autoload th; theorem thy th;; % ml_let changed to let_after for HOL88 (MJCG 6/2/89) % let load_theorem thy th = let_after(th, `theorem_lfn`, [thy;th]);; let load_theorems thy = map (\(tok,th). load_theorem thy tok) (theorems thy);; let definition_lfn[thy;th] = definition thy th;; % undo_autoload th added in HOL88.1.02 to make autoloading in compiled ML files work. % let definition_msg_lfn [thy;th] = (if get_flag_value `print_load` then (print_string (`Definition `^th^` autoloading from theory \``^thy^`\` ...`); print_newline())); undo_autoload th; definition thy th;; % ml_let changed to let_after for HOL88 (MJCG 6/2/89) % let load_definition thy th = let_after(th, `definition_lfn`, [thy;th]);; let load_definitions thy = map (\(tok,th). load_definition thy tok) (definitions thy);; let axiom_lfn[thy;th] = axiom thy th;; % undo_autoload th added in HOL88.1.02 to make autoloading in compiled ML files work. % let axiom_msg_lfn [thy;th] = (if get_flag_value `print_load` then (print_string(`Axiom `^th^` autoloading from theory \``^thy^`\` ...`); print_newline())); undo_autoload th; axiom thy th;; % ml_let changed to let_after for HOL88 (MJCG 6/2/89) % let load_axiom thy th = let_after(th, `axiom_lfn`, [thy;th]);; let load_axioms thy = map (\(tok,th). load_axiom thy tok) (axioms thy);; % ===================================================================== What follows is now obsolete (and was never debuged) -- see definition of new_specification on ml/hol-syn.ml for current treatment. The code that follows implements constant specifications in which the stored definition is not necessarily of the form |- ?x1 ... xn. t, be may only be logically equivalent to this. Sequents are encoded as terms using the infix constant IS_ASSUMPTION_OF defined by: IS_ASSUMPTION_OF = |- !t1 t2. (t1 IS_ASSUMPTION_OF t2) = (t1 ==> t2) Evaluating new_general_specification name [`flag1`,`C1`; ... ; `flagn,Cn`] |- ?x1 ... xn. t[x1,...,xn] |- !x1 .... xn. (t1[x1,...,xn] IS_ASSUMPTION_OF . . . tm[x1,...,xn] IS_ASSUMPTION_OF t'[x1,...,xn]) = t[x1,...,xn] specifies C1, ... ,Cn by the definition: t1[C1,...,Cn], ... , tm[C1,...,Cn] |- t'[C1,...,Cn]) Normally, t1, ... , tm would be closed terms, but this is not logically necessary. let new_general_specification defname flag_name_list th eqth = let exists_vars,exists_body = check_specification defname flag_name_list th in let forall_vars,forall_body = (n_strip_quant dest_forall (length exists_vars) (concl eqth) ? `missing outermost universally quantified variable(s)`) in if not(forall_vars = exists_vars) then failwith`different quantified variables`; let left,right = (dest_eq forall_body ? `not a universally quantified equation`) in if not(right = exists_body) then failwith`rhs of equation doesn't match body of existential quantification`; map2 (\((flag,name),var). if flag = `constant` then new_constant(name,type_of var) if flag = `infix` then new_infix(name,type_of var) else new_binder(name,type_of var)) (flag_name_list,exists_vars); store_definition (defname, subst (map2 (\((flag,name),var). (mk_const(name,type_of var),var)) (flag_name_list,exists_vars)) left);; ===================================================================== % hol88-2.02.19940316/ml/lis.ml0000640000212700021270000001632705424211444013466 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: lis.ml % % % % DESCRIPTION: List-processing functions for ML. Many of these % % functions could be coded in Lisp for speed. % % % % USES FILES: ml-curry.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % let nil = [];; [ Deleted: TFM 90.05.31] % let append x y = x @ y;; %genmem has been deleted; if p is a curried predicate, then you can write "exists (p x)" else write "exists (curry p x)" % let itlist f l x = rev_itlist f (rev l) x;; % [x1; ...; xn] ---> (ff x1 ... (ff (xn-1) xn)...) for n>0 % let end_itlist ff l = if null l then failwith `end_itlist` else (let last.rest = rev l in rev_itlist ff rest last);; % Ad hoc and only used once in HOL sources, so deleted. [TFM 90.06.01] % % let eqfst x (y,z) = (x=y) % % and eqsnd x (y,z) = (x=z);; % % Failure strings added [TFM 90.12.01] % let assoc x l = find (\(y,z). y=x) l ? failwith `assoc`;; let rev_assoc x l = find (\(y,z). z=x) l ? failwith `rev_assoc`;; let intersect l1 l2 = filter (\x. mem x l2) l1 ;; let subtract l1 l2 = filter (\x. not mem x l2) l1 ;; let union l1 l2 = l1 @ (subtract l2 l1) ;; % `make_set' renamed `setify' [RJB 90.10.20]. % % % % make a list into a set, stripping out duplicate elements % let setify l = itlist (\a s. if mem a s then s else a.s) l [];; letrec split l = if null l then ([],[]) else (let (x1,x2) .l' = l in let l1',l2' = split l' in (x1.l1', x2.l2'));; letrec combine(l1,l2) = if null l1 & null l2 then [] else ((hd l1, hd l2) . combine(tl l1, tl l2) ? failwith `combine`);; ml_paired_infix `com`;; let $com = combine;; %Check if the elements of `l` are all distinct% letrec distinct l = (null l) or (not (mem (hd l) (tl l)) & distinct (tl l));; % chop_list n [e1; ...; en; e[n+1]; ... ; e[n+m] ---> [e1; ...; en] , [e[n+1]; ...; e[n+m]] % letrec chop_list n l = if n=0 then ([],l) else (let m,l' = chop_list (n-1) (tl l) in hd l . m , l') ? failwith `chop_list`;; % --------------------------------------------------------------------- % % Functions last and butlast added. [RJB 90.10.20] % % --------------------------------------------------------------------- % % last [x1;...;xn] ---> xn % letrec last l = last (tl l) ? hd l ? failwith `last`;; % butlast [x1;...x(n-1);xn] ---> [x1;...;x(n-1)] % letrec butlast l = if null (tl l) then [] else (hd l).(butlast(tl l)) ? failwith `butlast`;; % Occurrences of rotate_left and rotate_right replaced % % by calls to hd, tl, @, last and butlast. % % Commented-out [RJB 90.10.20] % % % % let rotate_left (a.l) = l @ [a] % % and rotate_right l = % % let ra.rl = rev l in ra . (rev rl);; % % [[1;2;3]; [4;5;6]; [7;8;9]] ---> [1; 5; 9] % % Not used anywhere: commented-out [TFM 90.04.21] % % % % letrec diagonal ll = % % if null ll then [] % % else hd (hd ll) . (diagonal (map tl (tl ll)));; % % [x1; ...; x(m+n)] ---> [y1; ...; ym], [z1; ...; zn] where the y's are all x's that satisfy p, the z's all other x's % let partition p l = itlist (\a (yes,no). if p a then (a.yes),no else yes, (a.no)) l ([],[]);; %make the list [x; x; ...; x] of length n% letrec replicate x n = if n<0 then failwith `replicate` else if n=0 then [] else x . (replicate x (n-1));; % make the list [from; from+1; ...; to] % % Made local where actually used: [TFM 90.06.25] % % letrec upto from to = % % if from>to then [] % % else from . (upto (from+1) to);; % %--------------------------------------------------------------------% % sort - Quicksorts a list according to a given "less-than" operator % % [JRH 91.07.17] % %--------------------------------------------------------------------% letrec sort cmp lis = let curry f x y = f (x,y) in if null lis then [] else let piv.rest = lis in let (r,l) = partition (curry cmp piv) rest in (sort cmp l)@(piv.(sort cmp r));; %--------------------------------------------------------------------% % splitp --- splits a list into two according to a given predicate % % [WW 93.05.19] % %--------------------------------------------------------------------% let splitp pred l = letrec spl lst = if null lst then ([], []) else let (h.rest) = lst in if pred h then ([], lst) else let (p,s) = spl rest in ((h.p),s) in spl l ;; %-----------------------------------------------------------------------% % remove x satisfying p from l.... giving x and the thing and rest of l % % Moved here by WW 24-July-93 % %-----------------------------------------------------------------------% letrec remove p l = if (p(hd l)) then ((hd l), (tl l)) else let (p', l') = remove p (tl l) in (p', ((\r. ((hd l) . r)) l')) ;; hol88-2.02.19940316/ml/tyfns.ml0000640000212700021270000006465405521202176014050 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: tyfns.ml % % % % DESCRIPTION: Auxiliary programs for recursive types. % % AUTHOR: T. F. Melham (87.08.23) % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % % % % REVISION HISTORY: 90.06.28 % %=============================================================================% if compiling then loadf `ml/prim_rec`;; % ===================================================================== % % STRUCTURAL INDUCTION % % ===================================================================== % begin_section prove_induction_thm;; % --------------------------------------------------------------------- % % Internal function: UNIQUENESS % % % % This function derives uniqueness from unique existence: % % % % |- ?!x. P[x] % % --------------------------------------- % % |- !v1 v2. P[v1] /\ P[v2] ==> (v1=v2) % % % % The variables v1 and v2 are genvars. % % --------------------------------------------------------------------- % let UNIQUENESS = let EXISTS_UNIQUE_DEF = definition `bool` `EXISTS_UNIQUE_DEF` in let P = "P:*->bool" and v1 = genvar ":*" and v2 = genvar ":*" in let th1 = SPEC P (CONV_RULE (X_FUN_EQ_CONV P) EXISTS_UNIQUE_DEF) in let th2 = CONJUNCT2(UNDISCH(fst(EQ_IMP_RULE(RIGHT_BETA th1)))) in let imp = GEN P (DISCH "$?! ^P" (SPECL [v1;v2] th2)) in let AND = let f = "$/\" in \(e1,e2). MK_COMB((AP_TERM f e1),e2) in let conv tm = AND ((BETA_CONV # BETA_CONV) (dest_conj tm)) and check = assert \c. (fst(dest_const c) = `?!`) and v = genvar ":bool" in \th. let _,(x,body) = (check # dest_abs) (dest_comb (concl th)) in let ty = type_of x in let uniq = MP (SPEC(mk_abs(x,body)) (INST_TYPE [ty,":*"] imp)) th in let V1,V2 = let i = inst [] [ty,":*"] in (i v1,i v2) in let red = conv (fst(dest_imp(concl uniq))) in GEN V1 (GEN V2(SUBST [red,v] (mk_imp(v,mk_eq(V1,V2))) uniq));; % --------------------------------------------------------------------- % % Internal function: DEPTH_FORALL_CONV % % % % DEPTH_FORALL_CONV conv "!x1...xn. tm" applies the conversion conv to % % the term tm to yield |- tm = tm', and then returns: % % % % |- (!x1...xn. tm) = (!x1...xn. tm') % % % % --------------------------------------------------------------------- % let DEPTH_FORALL_CONV conv tm = let vs,th = (I # conv) (strip_forall tm) in itlist FORALL_EQ vs th;; % --------------------------------------------------------------------- % % Internal function: CONJS_CONV % % % % CONJS_CONV conv "t1 /\ t2 /\ ... /\ tn" applies conv to each of the % % n conjuncts t1,t2,...,tn and then rebuilds the conjunction from the % % results. % % % % --------------------------------------------------------------------- % letrec CONJS_CONV conv tm = (let c,cs = (conv # CONJS_CONV conv) (dest_conj tm) in MK_COMB((AP_TERM "$/\" c),cs)) ? conv tm;; % --------------------------------------------------------------------- % % Internal function: CONJS_SIMP % % % % CONJS_SIMP conv "t1 /\ t2 /\ ... /\ tn" applies conv to each of the % % n conjuncts t1,t2,...,tn. This should reduce each ti to "T". I.e. % % executing conv ti should return |- ti = T. The result returned by % % CONJS_SIMP is then: |- (t1 /\ t2 /\ ... /\ tn) = T % % % % --------------------------------------------------------------------- % let CONJS_SIMP = let T_AND_T = CONJUNCT1 (SPEC "T" AND_CLAUSES) in letrec simp conv tm = (let c,cs = (conv # simp conv) (dest_conj tm) in (MK_COMB((AP_TERM "$/\" c),cs)) TRANS T_AND_T) ? conv tm in simp;; % --------------------------------------------------------------------- % % Internal function: T_AND_CONV % % % % T_AND_CONV "T /\ t" returns |- T /\ t = t % % % % --------------------------------------------------------------------- % let T_AND_CONV = let T_AND = GEN_ALL (CONJUNCT1 (SPEC_ALL AND_CLAUSES)) in \tm. let t = snd(dest_conj tm) in SPEC t T_AND;; % --------------------------------------------------------------------- % % Internal function: GENL_T % % % % GENL_T [x1;...;xn] returns |- (!x1...xn.T) = T % % % % --------------------------------------------------------------------- % let GENL_T l = if (null l) then REFL "T" else let gen = list_mk_forall(l,"T") in let imp1 = DISCH gen (SPECL l (ASSUME gen)) and imp2 = DISCH "T" (GENL l (ASSUME "T")) in IMP_ANTISYM_RULE imp1 imp2;; % --------------------------------------------------------------------- % % Internal function: SIMP_CONV % % % % SIMP_CONV is used by prove_induction_thm to simplify to "T" terms of % % the following two forms: % % % % 1: !x1...xn. (\x.T)v = (\x1...xn.T) x1 ... xn % % % % 2: !x1...xn. (\x.T)v = % % (\y1...ym x1..xn. (y1 /\.../\ ym) \/ t) ((\x.T)u1)...((\x.T)um) % % x1 ... xn % % % % If tm, a term of one of these two forms, is the argument to SIMP_CONV % % then the theorem returned is |- tm = T. % % --------------------------------------------------------------------- % let SIMP_CONV = let DISJ_SIMP = let v = genvar ":bool" and tr = "T" in let T_OR = GEN v (CONJUNCT1 (SPEC v OR_CLAUSES)) in \tm. let cs,ds = (dest_disj tm) in let eqn = SYM(CONJS_SIMP BETA_CONV cs) in SUBST [eqn,v] (mk_eq((mk_disj(v,ds)),tr)) (SPEC ds T_OR) in let eq = "$=:bool->bool->bool" and T_EQ_T = EQT_INTRO(REFL "T") in \tm. let vs,l,r = (I # dest_eq) (strip_forall tm) in let rsimp = (LIST_BETA_CONV THENC (DISJ_SIMP ORELSEC REFL)) r and lsimp = AP_TERM eq (BETA_CONV l) and gent = GENL_T vs in let eqsimp = (MK_COMB(lsimp,rsimp)) TRANS T_EQ_T in (itlist FORALL_EQ vs eqsimp) TRANS gent;; % --------------------------------------------------------------------- % % Internal function: HYP_SIMP % % % % HYP_SIMP is used by prove_induction_thm to simplify induction % % hypotheses according to the following scheme: % % % % 1: !x1...xn. P t = (\x1...xn.T) x1...xn % % % % simplifies to % % % % !x1...xn. P t % % % % 2: !x1...xn. P t = % % (\y1..ym x1..xn. y1 /\ ... /\ ym) \/ P t) v1 ... vm x1 ... xn % % % % simplifies to % % % % !x1...xn. (v1 /\ ... /\ vm) ==> P t % % % % --------------------------------------------------------------------- % let HYP_SIMP = let R_SIMP = let v = genvar ":bool" and tr = "T" in let EQ_T = GEN v (CONJUNCT1 (CONJUNCT2 (SPEC v EQ_CLAUSES))) in \tm. let l,r = dest_eq tm in if (r = tr) then SPEC l EQ_T else let cs = fst(dest_disj r) in SPECL [l;cs] OR_IMP_THM in let eq = "$=:bool->bool->bool" in \tm. let vs,l,r = (I # dest_eq) (strip_forall tm) in let eqsimp = AP_TERM (mk_comb(eq,l)) (LIST_BETA_CONV r) in let rsimp = CONV_RULE (RAND_CONV R_SIMP) eqsimp in (itlist FORALL_EQ vs rsimp);; % --------------------------------------------------------------------- % % Internal function: ANTE_ALL_CONV % % % % ANTE_ALL_CONV "!x1...xn. P ==> Q" restricts the scope of as many of % % the quantified x's as possible to the term Q. % % --------------------------------------------------------------------- % let ANTE_ALL_CONV tm = let vs,hy,c = (I # dest_imp) (strip_forall tm) in let ov,iv = partition (C free_in hy) vs in let thm1 = GENL iv (UNDISCH (SPECL vs (ASSUME tm))) in let thm2 = GENL ov (DISCH hy thm1) in let asm = concl thm2 in let thm3 = SPECL iv (UNDISCH (SPECL ov (ASSUME asm))) in let thm4 = GENL vs (DISCH hy thm3) in IMP_ANTISYM_RULE (DISCH tm thm2) (DISCH asm thm4);; % --------------------------------------------------------------------- % % Internal function: CONCL_SIMP % % % % CONCL_SIMP "\x.T = P" returns: |- (\x.T = P) = (!y. P y) where y is % % an appropriately chosen variable. % % --------------------------------------------------------------------- % let CONCL_SIMP = let v = genvar ":bool" in let T_EQ = GEN v (CONJUNCT1 (SPEC v EQ_CLAUSES)) in \tm. let eq = FUN_EQ_CONV tm in let y,ap,bd = (I # dest_eq)(dest_forall(rhs(concl eq))) in let eqn = RATOR_CONV(RAND_CONV BETA_CONV) (mk_eq(ap,bd)) and simp = SPEC bd T_EQ in eq TRANS (FORALL_EQ y (eqn TRANS simp));; % --------------------------------------------------------------------- % % prove_induction_thm: prove a structural induction theorem from a type % % axiom of the form returned by define_type. % % % % EXAMPLE: % % % % Input: % % % % |- !x f. ?! fn. (fn[] = x) /\ (!h t. fn(CONS h t) = f(fn t)h t) % % % % Output: % % % % |- !P. P[] /\ (!t. P t ==> (!h. P(CONS h t))) ==> (!l. P l) % % % % --------------------------------------------------------------------- % let prove_induction_thm = letrec gen n = if (n=0) then [] else (genvar ":bool" . gen (n-1)) in let mk_fn P ty tm = let body = snd(strip_forall tm) in let c,args = (rand # (snd o strip_comb))(dest_eq body) in let vars = filter is_var args in let n = length(filter (\t.type_of t = ty) vars) in if (n=0) then list_mk_abs (vars, "T") else let bools = gen n in let term = mk_disj (list_mk_conj bools,mk_comb(P,c)) in list_mk_abs((bools @ vars),term) in let LCONV = RATOR_CONV o RAND_CONV in let conv1 = LCONV(CONJS_SIMP SIMP_CONV) THENC T_AND_CONV and conv2 = CONJS_CONV (HYP_SIMP THENC TRY_CONV ANTE_ALL_CONV) in \th. (let fn,body = dest_abs(rand(snd(strip_forall(concl th)))) in let [ty;rty] = snd(dest_type (type_of fn)) in let inst = INST_TYPE [":bool",rty] th in let P = mk_primed_var(`P`,mk_type(`fun`,[ty;":bool"])) and v = genvar ty and cases = conjuncts body in let uniq = let vs,tm = strip_forall(concl inst) in let thm = UNIQUENESS(SPECL vs inst) in GENL vs (SPECL [mk_abs(v,"T");P] thm) in let spec = SPECL (map (mk_fn P ty) cases) uniq in let simp = CONV_RULE (LCONV(conv1 THENC conv2)) spec in GEN P (CONV_RULE (RAND_CONV CONCL_SIMP) simp)) ? failwith `prove_induction_thm`;; % --------------------------------------------------------------------- % % Bind the function prove_induction_thm to "it", so as to export it % % outside the current section. % % --------------------------------------------------------------------- % prove_induction_thm;; end_section prove_induction_thm;; % --------------------------------------------------------------------- % % Save the exported value of prove_induction_thm. % % --------------------------------------------------------------------- % let prove_induction_thm = it;; % ===================================================================== % % CASES FOR RECURSIVE TYPES % % ===================================================================== % begin_section prove_cases_thm;; % --------------------------------------------------------------------- % % Internal function: NOT_ALL_THENC % % % % This conversion first moves negation inwards through an arbitrary % % number of nested universal quantifiers. It then applies the supplied % % conversion to the resulting inner negation. For example if: % % % % conv "~tm" ---> |- ~tm = tm' % % then % % % % NOT_ALL_THENC conv "~(!x1 ... xn. tm)" % % % % yields: % % % % |- ~(!x1...xn.tm) = ?x1...xn.tm' % % --------------------------------------------------------------------- % letrec NOT_ALL_THENC conv tm = (NOT_FORALL_CONV THENC (RAND_CONV (ABS_CONV (NOT_ALL_THENC conv)))) tm ? (conv tm);; % --------------------------------------------------------------------- % % Internal function: BASE_CONV % % % % This conversion does the following simplification: % % % % BASE_CONV "~((\x.~tm)y)" ---> |- ~((\x.~tm)y) = tm[y/x] % % % % --------------------------------------------------------------------- % let BASE_CONV = let NOT_NOT = CONJUNCT1 NOT_CLAUSES and neg = "$~" in \tm. let beta = BETA_CONV (dest_neg tm) in let simp = SPEC (rand(rhs(concl beta))) NOT_NOT in TRANS (AP_TERM neg beta) simp;; % --------------------------------------------------------------------- % % Internal function: STEP_CONV % % % % This conversion does the following simplification: % % % % STEP_CONV "~(tm' ==> !x1..xn.(\x.~tm)z" % % % % yields: % % % % |- ~(tm' ==> !x1..xn.(\x.~tm)z = tm' /\ ?x1..xn.tm[z/x] % % --------------------------------------------------------------------- % let STEP_CONV = let v1 = genvar ":bool" and v2 = genvar ":bool" in \tm. let a,c = dest_imp(dest_neg tm) in let th1 = SPEC c (SPEC a NOT_IMP) in let simp = NOT_ALL_THENC BASE_CONV (mk_neg c) in SUBST [simp,v2] (mk_eq(tm,mk_conj(a,v2))) th1;; % --------------------------------------------------------------------- % % Internal function: NOT_IN_CONV % % % % This first conversion moves negation inwards through conjunction and % % universal quantification: % % % % NOT_IN_CONV "~(!x1..xn.c1 /\ ... /\ !x1..xm.cn)" % % % % to transform the input term into: % % % % ?x1..xn.~c1 \/ ... \/ ?x1..xm.~cn % % % % It then applies either BASE_CONV or STEP_CONV to each subterm ~ci. % % --------------------------------------------------------------------- % let NOT_IN_CONV = let DE_MORG = GEN_ALL(CONJUNCT1(SPEC_ALL DE_MORGAN_THM)) and cnv = BASE_CONV ORELSEC STEP_CONV and v1 = genvar ":bool" and v2 = genvar ":bool" in letrec conv tm = (let c,cs = dest_conj(dest_neg tm) in let thm = SPEC cs (SPEC c DE_MORG) in let cth = NOT_ALL_THENC cnv (mk_neg c) and csth = conv (mk_neg cs) in SUBST [cth,v1;csth,v2] (mk_eq(tm,(mk_disj(v1,v2)))) thm) ? NOT_ALL_THENC cnv tm in conv;; % --------------------------------------------------------------------- % % Internal function: STEP_SIMP % % % % This rule does the following simplification: % % % % STEP_RULE "?x1..xi. tm1 /\ ?xj..xn. tm2" % % % % yields: % % % % ?x1..xi.tm1 /\ ?xj..xn.tm2 |- ?x1..xn.tm2 % % % % For input terms of other forms, the rule yields: % % % % STEP_RULE "tm" ---> tm |- tm % % --------------------------------------------------------------------- % let STEP_SIMP = let EX tm th = EXISTS (mk_exists(tm,concl th),tm) th and CH tm th = CHOOSE (tm,ASSUME (mk_exists(tm,hd(hyp th)))) th in \tm. (let vs,body = strip_exists tm in itlist (\t.CH t o EX t) vs (CONJUNCT2 (ASSUME body))) ? ASSUME tm;; % --------------------------------------------------------------------- % % Internal function: DISJ_CHAIN % % % % Suppose that % % % % rule "tmi" ---> tmi |- tmi' (for 1 <= i <= n) % % % % then: % % % % |- tm1 \/ ... \/ tmn % % --------------------------- DISJ_CHAIN rule % % |- tm1' \/ ... \/ tmn' % % --------------------------------------------------------------------- % letrec DISJS_CHAIN rule th = (let d1,d2 = dest_disj(concl th) in let i1 = rule d1 and i2 = DISJS_CHAIN rule (ASSUME d2) in DISJ_CASES th (DISJ1 i1 (concl i2)) (DISJ2 (concl i1) i2)) ? MP (DISCH (concl th) (rule (concl th))) th;; % --------------------------------------------------------------------- % % prove_cases_thm: prove a cases or "exhaustion" theorem for a concrete % % recursive type from a structural induction theorem of the form % % returned by prove_induction_thm. % % % % EXAMPLE: % % % % Input: % % % % |- !P. P[] /\ (!t. P t ==> (!h. P(CONS h t))) ==> (!l. P l) % % % % Output: % % % % |- !l. (l = []) \/ (?t h. l = CONS h t) % % % % --------------------------------------------------------------------- % let prove_cases_thm th = (let x,P = dest_forall(snd(dest_imp(snd(dest_forall(concl th))))) in let v = genvar (type_of x) in let pred = mk_abs(v,mk_neg(mk_eq(x,v))) in let th1 = CONV_RULE BETA_CONV (SPEC x (UNDISCH(SPEC pred th))) in let th2 = NOT_INTRO (DISCH_ALL (NOT_MP th1 (REFL x))) in let th3 = CONV_RULE NOT_IN_CONV th2 in GEN x (DISJS_CHAIN STEP_SIMP th3)) ? failwith `prove_cases_thm: invalid input theorem`;; % --------------------------------------------------------------------- % % Bind the function prove_cases_thm to "it", so as to export it % % outside the current section. % % --------------------------------------------------------------------- % prove_cases_thm;; end_section prove_cases_thm;; % --------------------------------------------------------------------- % % Save the exported value of prove_cases_thm. % % --------------------------------------------------------------------- % let prove_cases_thm = it;; % ===================================================================== % % PROOF THAT CONSTRUCTORS OF RECURSIVE TYPES ARE ONE-TO-ONE % % ===================================================================== % begin_section prove_constructors_one_one;; % --------------------------------------------------------------------- % % Internal function: PAIR_EQ_CONV % % % % A call to PAIR_EQ_CONV "(x1,...,xn) = (y1,...,yn)" returns: % % % % |- ((x1,...,xn) = (y1,...,yn)) = (x1 = y1) /\ ... /\ (xn = yn) % % % % --------------------------------------------------------------------- % let PAIR_EQ_CONV = let v = genvar ":bool" in letrec conv tm = (let (x,xs),(y,ys) = (dest_pair # dest_pair) (dest_eq tm) in let xty = type_of x and xsty = type_of xs in let thm = INST_TYPE [xty,":*";xsty,":**"] PAIR_EQ in let spec = SPEC ys (SPEC y (SPEC xs (SPEC x thm))) in let reqn = conv (mk_eq(xs,ys)) in let pat = mk_eq(tm,mk_conj(mk_eq(x,y),v)) in SUBST [reqn,v] pat spec) ? REFL tm in conv;; % --------------------------------------------------------------------- % % Internal function: list_variant % % % % makes variants of the variables in l2 such that they are all not in % % l1 and are all different. % % --------------------------------------------------------------------- % letrec list_variant l1 l2 = if (null l2) then [] else (let v = variant l1 (hd l2) in (v.list_variant (v.l1) (tl l2)));; % --------------------------------------------------------------------- % % Internal function: prove_const_one_one. % % % % This function proves that a single constructor of a recursive type is % % one-to-one (it is called once for each appropriate constructor). The % % theorem input, th, is the characterizing theorem for the recursive % % type in question. The term, tm, is the defining equation for the % % constructor in question, taken from the mody of the theorem th. % % % % For example, if: % % % % th = |- !x f. ?! fn. (fn[] = x) /\ (!h t. fn(CONS h t) = f(fn t)h t) % % % % and % % % % tm = "!h t. fn(CONS h t) = f(fn t)h t" % % % % then prove_const_one_one th tm yields: % % % % |- !h t h' t'. (CONS h t = CONS h' t') = (h = h') /\ (t = t') % % % % --------------------------------------------------------------------- % let prove_const_one_one th tm = let vs,l,r = (I # dest_eq)(strip_forall tm) in let tup = end_itlist (curry mk_pair) (snd(strip_comb(rand l))) in let tupty = type_of tup in let eq = mk_eq(inst [] [tupty,type_of l] l, tup) in let eqn = prove_rec_fn_exists th eq in let vvs = list_variant vs vs in let C = rand l and C' = subst (combine (vvs,vs)) (rand l) in let vareqs = (list_mk_conj o (map mk_eq)) (combine (snd(strip_comb C),(snd(strip_comb C')))) in let asms = combine(CONJUNCTS (ASSUME vareqs),snd(strip_comb C)) in let imp1 = DISCH vareqs (SUBST_CONV asms C C) in let fn,fndef = (I # ASSUME) (dest_exists(concl eqn)) in let r1 = REWR_CONV fndef (mk_comb(fn,C)) and r2 = REWR_CONV fndef (mk_comb(fn,C')) and asm = AP_TERM fn (ASSUME (mk_eq(C,C'))) and v1 = genvar tupty and v2 = genvar tupty in let thm = (SUBST [r1,v1;r2,v2] (mk_eq(v1,v2)) asm) in let aimp = DISCH (mk_eq(C,C')) (CONV_RULE PAIR_EQ_CONV thm) in let imp2 = CHOOSE (fn,eqn) aimp in GENL vs (GENL vvs (IMP_ANTISYM_RULE imp2 imp1)) ;; % --------------------------------------------------------------------- % % prove_constructors_one_one : prove that the constructors of a given % % concrete recursive type are one-to-one. The input is a theorem of the % % form returned by define_type. % % % % EXAMPLE: % % % % Input: % % % % |- !x f. ?! fn. (fn[] = x) /\ (!h t. fn(CONS h t) = f(fn t)h t) % % % % Output: % % % % |- !h t h' t'. (CONS h t = CONS h' t') = (h = h') /\ (t = t') % % --------------------------------------------------------------------- % let prove_constructors_one_one th = (let eqns = conjuncts(snd(dest_abs(rand(snd(strip_forall(concl th)))))) in let funs = filter (\tm.is_comb(rand(lhs(snd(strip_forall tm))))) eqns in LIST_CONJ (map (prove_const_one_one th) funs)) ? failwith `prove_constructors_one_one: invalid input theorem`;; % --------------------------------------------------------------------- % % Bind the function prove_constructors_one_one to "it", so as to export % % it outside the current section. % % --------------------------------------------------------------------- % prove_constructors_one_one;; end_section prove_constructors_one_one;; % --------------------------------------------------------------------- % % Save the exported value of prove_constructors_one_one. % % --------------------------------------------------------------------- % let prove_constructors_one_one = it;; % ===================================================================== % % DISTINCTNESS OF VALUES FOR EACH CONSTRUCTOR % % ===================================================================== % % --------------------------------------------------------------------- % % prove_constructors_distinct : prove that the constructors of a given % % recursive type yield distict (non-equal) values. % % % % EXAMPLE: % % % % Input: % % % % |- !x f. ?! fn. (fn[] = x) /\ (!h t. fn(CONS h t) = f(fn t)h t) % % % % Output: % % % % |- !h t. ~([] = CONS h t) % % --------------------------------------------------------------------- % let prove_constructors_distinct = let NOT_SUC = theorem `num` `NOT_SUC` and INV_SUC = theorem `num` `INV_SUC` in letrec list_variant l1 l2 = if (null l2) then [] else (let v = variant l1 (hd l2) in (v.list_variant (v.l1) (tl l2))) in let SUC = "SUC" and zero = "0" and lemma = GEN_ALL(NOT_ELIM(NOT_EQ_SYM(SPEC_ALL NOT_SUC))) in letrec geneqs ls t = let vars,l,r = (I # dest_eq) (strip_forall(hd ls)) in if (null(tl ls)) then [],mk_eq(l,t) else let rl,tm = geneqs(tl ls) (mk_comb(SUC,t)) in ((t.rl), mk_conj (mk_eq(l,t),tm)) in letrec step ths = if (null (tl ths)) then [] else let [l;r] = snd(strip_comb(fst(dest_imp(concl (hd ths))))) in let th = IMP_TRANS (SPEC r (SPEC l INV_SUC)) (hd ths) in th. (step (tl ths)) in letrec mk_rot ths = if (null ths) then [] else ths. mk_rot (step ths) in let rule fn eth th = let asm = (mk_eq o (rand # rand))(dest_eq(fst(dest_imp(concl th)))) in let imp = (IMP_TRANS (DISCH asm (AP_TERM fn (ASSUME asm))) th) in GEN_ALL (NOT_INTRO(CHOOSE (fn,eth) imp)) in let gv1 = genvar ":num" and gv2 = genvar ":num" in let pat = mk_imp(mk_eq(gv1,gv2),"F") in letrec subsfn rul eq eqs l acc = if (null l) then acc else let vs = frees (rand(rhs(concl eq))) and nvs = frees (rand(rhs(concl(hd eqs)))) in let eqn = INST (combine ((list_variant vs nvs),nvs)) (hd eqs) in let rnum = rhs(fst(dest_imp(concl (hd l)))) in let thm = SUBST [eq,gv1;eqn,gv2] pat (hd l) in (rul thm).(subsfn rul eq (tl eqs) (tl l) acc) in letrec subs rul (eq.eqs) eqls = null eqls => [] | subsfn rul eq eqs (hd eqls) (subs rul eqs (tl eqls)) in \th. (let fn,body = dest_abs(rand(snd(strip_forall(concl th)))) in let _,[_;ty] = dest_type(type_of fn) in let eqns = conjuncts(inst [] [mk_type(`num`,[]),ty] body) in if (null(tl eqns)) then fail else let nums,eqs = (geneqs eqns zero) in let eth = prove_rec_fn_exists th eqs in let rots = mk_rot (map (C SPEC lemma) nums) in let fn,asm = dest_exists(concl eth) in let fneqs = map (SYM o SPEC_ALL) (CONJUNCTS (ASSUME asm)) in LIST_CONJ (subs (rule fn eth) fneqs rots)) ? failwith `prove_constructors_distinct: invalid input`;; hol88-2.02.19940316/ml/hol-in-out.ml0000640000212700021270000000501305071125075014662 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: hol-in-out.ml % % % % DESCRIPTION: Loads in the HOL parser and printer % % % % USES FILES: basic-hol lisp files % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: pathnames -- J. Joyce (April 1987) % %=============================================================================% % Modification J.Joyce Apr 87 % % lisp `(setdebug t)`;; % lisp (concat (concat `(load "` lisp_dir_pathname) `genfns")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `gnt")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `hol-pars")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `parslist")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `parslet")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `constp")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `hol-writ")`);; lisp (concat (concat `(load "` lisp_dir_pathname) `mk_pp_thm")`);; loadf (concat ml_dir_pathname `genfns`);; %general purpose functions% loadf (concat ml_dir_pathname `hol-syn`);; %basic syntax functions for HOL% hol88-2.02.19940316/ml/numconv.ml0000640000212700021270000000503405345641275014370 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: numconv.ml % % % % DESCRIPTION: Define the axiom scheme for numerals % % % % AUTHOR: T. F. Melham (87.08.23) % % % % USES FILES: assumes num.th as parent % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: 90.05.06 % %=============================================================================% % --------------------------------------------------------------------- % % num_CONV: axiom scheme for numerals % % --------------------------------------------------------------------- % let num_CONV = let num = ":num" and SUC = "SUC" in \tm. let n = int_of_string(fst(dest_const tm)) ? failwith `num_CONV: argument not a numeral` in if n<1 then failwith `num_CONV: argument less than 1` else let pre_n = mk_const(string_of_int (n-1),num) in fst(mk_thm([], mk_eq (tm,(mk_comb(SUC,pre_n)))), RecordStep(NumConvStep tm));; hol88-2.02.19940316/ml/stack.ml0000640000212700021270000001335605146273720014011 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: stack.ml % % % % DESCRIPTION: A system of routines to maintain goals and partial % % results. You create and traverse the proof tree % % top-down, left to right. You expand the current goal % % into a list of subgoals, which are pushed onto the % % goalstack, on top of the proof. % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-thyfn.ml, hol-rule.ml, hol-drule.ml, drul.ml, % % tacticals.ml, goals.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % Operations: % % set_goal g state the top-level goal % % expand tac apply a tactic to the topmost goal % % expandf tac fast expand -- don't check validity of tactic % % print_state n print topmost n goals % % top_thm () return the top of the theorem stack % % save_top_thm name call save_thm (name, top of thmstack) % % rotate n rotate goals to move the nth goal to the front % % backup () undo last proof step (may be repeated) % % % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, etc % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-thyfn`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`; loadf `ml/goals`);; abstype goalstack = subgoals list with abs_goals = abs_goalstack and rep_goals = rep_goalstack;; letref goals = abs_goals [] and (backup_list: goalstack list) = [];; %Parameters for the user to adjust% %Minimum number of previous states to retain% letref backup_limit = 12;; let print_state depth = print_stack (rep_goals goals) depth;; let change_state newgoals = do (let newbackup = fst (chop_list backup_limit backup_list) ? backup_list in %no failures in these assignments% backup_list := goals . newbackup; goals := newgoals);; % Set the top-level goal, initialize % % Added test for boolean goal, including assumptions [JRH 92.02.12] % let set_goal = let bty = ":bool" in let isbty tm = (type_of tm = bty) in \(asl,w). if forall isbty (w.asl) then change_state (abs_goals (new_stack (asl,w))) else failwith `Term in goal not of type ":bool"`;; %Expand the top subgoal using the tactic% let expandf tac = change_state (abs_goals (push_fsubgoals (rep_goals goals) tac));; %Expand after validating tactic % let expand = expandf o VALID;; %Rotate goals of current proof% let rotate n = change_state (abs_goals (rotate_top n (rep_goals goals)));; %Restore the previous proof state; discard current state. % let (backup : void->void) () = (let newgoals.newbackup = backup_list in if null (rep_goals newgoals) then fail else do (goals := newgoals; backup_list := newbackup; print_state 1)) ? failwith `backup: backup list is empty`;; %Get top theorem (added by MJCG 17/10/89)% let top_thm = set_fail_prefix `top_thm` (\():void. top_proof(rep_goals goals));; %Record topmost theorem on a Fact file.% let save_top_thm = set_fail_prefix `save_top_thm` (\name. save_thm(name, top_thm()));; let top_goal : void->goal = set_fail_prefix `top_goal` (\(). let (g.gl),prf = hd (rep_goals goals) in g);; let get_state: void -> goalstack = \().goals;; let set_state goals = change_state goals; print_state 1;; % Added TFM 88.03.31 and MJCG 89.01.17 % let g = \t. set_goal([],t) and e = expand and p = print_state and b = backup and r = rotate;; hol88-2.02.19940316/ml/tacont.ml0000640000212700021270000002521505521161526014166 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: tacont.ml % % % % DESCRIPTION: Theorem continuations % % AUTHOR: Larry Paulson % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: Revised for HOL by MJCG % %=============================================================================% % Many inference rules, particularly those involving disjunction and % % existential quantifiers, produce intermediate results that are needed % % only briefly. One approach is to treat the assumption list like a % % stack, pushing and popping theorems from it. However, it is % % traditional to regard the assumptions as unordered; also, stack % % operations are crude. % % % % Instead, we adopt a continuation approach: a continuation is a % % function that maps theorems to tactics. It can put the theorem on % % the assumption list, produce a case split, throw it away, etc. The % % text of a large theorem continuation should be a readable description % % of the flow of inference. % % % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`);; lettype thm_tactic = thm -> tactic;; lettype thm_tactical = thm_tactic -> thm_tactic;; ml_curried_infix `THEN_TCL`;; ml_curried_infix `ORELSE_TCL`;; let $THEN_TCL (ttcl1: thm_tactical) (ttcl2: thm_tactical) ttac = ttcl1 (ttcl2 ttac) ;; let $ORELSE_TCL (ttcl1: thm_tactical) (ttcl2: thm_tactical) ttac th = (ttcl1 ttac th) ? (ttcl2 ttac th);; letrec REPEAT_TCL (ttcl: thm_tactical) ttac th = ((ttcl THEN_TCL (REPEAT_TCL ttcl)) ORELSE_TCL I) ttac th;; % --------------------------------------------------------------------- % % New version of REPEAT for ttcl's. Designed for use with IMP_RES_THEN.% % TFM 91.01.20. % % --------------------------------------------------------------------- % letrec REPEAT_GTCL (ttcl: thm_tactical) ttac th (A,g) = ttcl (REPEAT_GTCL ttcl ttac) th (A,g) ? ttac th (A,g);; let ALL_THEN : thm_tactical = I;; let NO_THEN : thm_tactical = \ttac th. failwith `NO_THEN`;; % Uses every theorem tactical. EVERY_TCL [ttcl1;...;ttcln] = ttcl1 THEN_TCL ... THEN_TCL ttcln % let EVERY_TCL ttcll = itlist $THEN_TCL ttcll ALL_THEN;; % Uses first successful theorem tactical. FIRST_TCL [ttcl1;...;ttcln] = ttcl1 ORELSE_TCL ... ORELSE_TCL ttcln % let FIRST_TCL ttcll = itlist $ORELSE_TCL ttcll NO_THEN;; % Conjunction elimination C ============== |- A1 /\ A2 C ===== ttac1 |-A1 ... ===== ttac2 |-A2 ... % let CONJUNCTS_THEN2 (ttac1: thm_tactic) ttac2 cth : tactic = let th1,th2 = CONJ_PAIR cth ? failwith `CONJUNCTS_THEN2` in ttac1 th1 THEN ttac2 th2;; let CONJUNCTS_THEN ttac = CONJUNCTS_THEN2 ttac ttac;; % Disjunction elimination C ============================= |- A1 \/ A2 C C ===== ttac1 A1|-A1 ===== ttac2 A2|-A2 ... ... % % -------------------------------------------------------------------------- % % REVISED 22 Oct 1992 by TFM. Bugfix. % % % % The problem was, for example: % % % % th = |- ?n. ((?n. n = SUC 0) \/ F) /\ (n = 0) % % set_goal ([], "F");; % % expandf (STRIP_ASSUME_TAC th);; % % OK.. % % "F" % % [ "n = SUC 0" ] (n.b. should be n') % % [ "n = 0" ] % % % % let DISJ_CASES_THEN2 ttac1 ttac2 disth :tactic = % % let a1,a2 = dest_disj (concl disth) ? failwith `DISJ_CASES_THEN2` in % % \(asl,w). % % let gl1,prf1 = ttac1 (ASSUME a1) (asl,w) % % and gl2,prf2 = ttac2 (ASSUME a2) (asl,w) % % in % % gl1 @ gl2, % % \thl. let thl1,thl2 = chop_list (length gl1) thl in % % DISJ_CASES disth (prf1 thl1) (prf2 thl2);; % % -------------------------------------------------------------------------- % let DISJ_CASES_THEN2 ttac1 ttac2 disth :tactic = let a1,a2 = dest_disj (concl disth) ? failwith `DISJ_CASES_THEN2` in \(asl,w). let gl1,prf1 = ttac1 (itlist ADD_ASSUM (hyp disth) (ASSUME a1)) (asl,w) and gl2,prf2 = ttac2 (itlist ADD_ASSUM (hyp disth) (ASSUME a2)) (asl,w) in gl1 @ gl2, \thl. let thl1,thl2 = chop_list (length gl1) thl in DISJ_CASES disth (prf1 thl1) (prf2 thl2);; %Single-, multi-tactic versions% let DISJ_CASES_THEN ttac = DISJ_CASES_THEN2 ttac ttac;; let DISJ_CASES_THENL = end_itlist DISJ_CASES_THEN2;; % Implication introduction A ==> B ============== B ============== ttac |-A . . . % % DISCH changed to NEG_DISCH for HOL % % Deleted: TFM 88.03.31 % % % % let DISCH_THEN ttac :tactic (asl,w) = % % let ante,conc = dest_imp w ? failwith `DISCH_THEN` in % % let gl,prf = ttac (ASSUME ante) (asl,conc) in % % gl, (NEG_DISCH ante) o prf;; % % Added: TFM 88.03.31 (bug fix) % let DISCH_THEN ttac :tactic (asl,w) = let ante,conc = dest_neg_imp w ? failwith `DISCH_THEN` in let gl,prf = ttac (ASSUME ante) (asl,conc) in gl, (if is_neg w then NEG_DISCH ante else DISCH ante) o prf;; % --------------------------------------------------------------------- % % If-and-only-iff elimination DELETED [TFM 91.01.20] % % % % C % % ============== |- A1 <=> A2 % % C % % ===== ttac1 |-A1==>A2 % % ... % % ===== ttac2 |-A2==>A1 % % ... % % % % let IFF_THEN2 (ttac1: thm_tactic) ttac2 iffth : tactic = % % let th1,th2 = CONJ_PAIR (IFF_CONJ iffth) ? failwith `IFF_THEN2` in % % ttac1 th1 THEN ttac2 th2;; % % % % let IFF_THEN ttac = IFF_THEN2 ttac ttac;; % % --------------------------------------------------------------------- % % Existential elimination B ================== |- ?x. A(x) B ================== ttac A(y) ... explicit version for tactic programming % let X_CHOOSE_THEN y ttac xth :tactic = let x,body = dest_exists (concl xth) ? failwith `X_CHOOSE_THEN` in \(asl,w). let th = itlist ADD_ASSUM (hyp xth) (ASSUME (subst [y,x] body)) in let gl,prf = ttac th (asl,w) in gl, (CHOOSE (y, xth)) o prf;; % chooses a variant for the user % let CHOOSE_THEN ttac xth :tactic = let x,body = dest_exists (concl xth) ? failwith `CHOOSE_THEN` in \(asl,w). let y = variant ((thm_frees xth) @ (freesl (w.asl))) x in X_CHOOSE_THEN y ttac xth (asl,w);; %Cases tactics% %for a generalized disjunction |-(?xl1.B1(xl1)) \/...\/ (?xln.Bn(xln)) where the xl1...xln are vectors of zero or more variables, and the variables in each of yl1...yln have the same types as the corresponding xli do A ============================================= A A ======= ttac1 |-B1(yl1) ... ======= ttacn |-Bn(yln) ... ... % let X_CASES_THENL varsl ttacl = DISJ_CASES_THENL (map (\(vars,ttac). EVERY_TCL (map X_CHOOSE_THEN vars) ttac) (varsl com ttacl));; %needed??? = X_CASES_THENL varsl (map (K ttac) varsl) % let X_CASES_THEN varsl ttac = DISJ_CASES_THENL (map (\vars. EVERY_TCL (map X_CHOOSE_THEN vars) ttac) varsl);; %Version that chooses the y's as variants of the x's% let CASES_THENL ttacl = DISJ_CASES_THENL (map (REPEAT_TCL CHOOSE_THEN) ttacl);; %Tactical to strip off ONE disjunction, conjunction, or existential% let STRIP_THM_THEN = FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN; CHOOSE_THEN];; hol88-2.02.19940316/ml/tydefs.ml0000640000212700021270000015521205521015701014166 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: tydefs.ml % % % % DESCRIPTION: Recursive type definition package % % AUTHOR: T. F. Melham (87.08.23) % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 1990 % % % % REVISION HISTORY: 90.09.03 % %=============================================================================% % --------------------------------------------------------------------- % % begin a section. % % --------------------------------------------------------------------- % begin_section define_type;; % ===================================================================== % % Parser for input grammar % % ===================================================================== % % --------------------------------------------------------------------- % % ignore c = true iff c is a white space character (tab, carrage return % % line feed, space, form feed). % % --------------------------------------------------------------------- % let ignore c = let n = ascii_code c in n=9 or n=10 or n=12 or n=13 or n=32;; % --------------------------------------------------------------------- % % is_sing c = true iff c is one of `#`, `+`, `|`, `(`, `)`, `,` or `=`. % % --------------------------------------------------------------------- % let is_sing c = c=`#` or c=`+` or c=`|` or c=`(` or c=`)` or c=`=` or c=`,`;; % --------------------------------------------------------------------- % % getid: strip an alphanumeric token off the front of a character list. % % --------------------------------------------------------------------- % letrec getid tok (c.cs) = (is_alphanum c => getid (tok ^ c) cs | (tok,c.cs));; % --------------------------------------------------------------------- % % getid: strip a token consisting of alphanumeric characters or `*`'s % % off the front of a character list. % % --------------------------------------------------------------------- % letrec gettyvid tok (c.cs) = (is_alphanum c or c=`*` => gettyvid (tok ^ c) cs | (tok,c.cs));; % --------------------------------------------------------------------- % % gnt: get next token, where tok ::= id | tyvar | other | end % % --------------------------------------------------------------------- % letrec gnt (c1.c2.cs) = (ignore c1) => gnt (c2.cs) | (is_sing c1) => inr(inr(inl c1)),(c2.cs) | (c1 = `*`) => ((inr o inl) # I ) (gettyvid c1 (c2.cs)) | (c1=`-` & c2=`>`) => (inr(inr(inl `->`))),cs | (is_letter c1) => (inl # I) (getid c1 (c2.cs)) | (c1 = ascii 1 & c2 = ascii 1 & null cs) => inr(inr(inr())),[] | failwith `illegal character: "` ^ c1 ^ `"`;; % --------------------------------------------------------------------- % % Recognizers for tokens % % --------------------------------------------------------------------- % let isid = isl and istyvar = can (outl o outr) and is tok st = st = outl(outr(outr tok)) ? false and end = can (outr o outr o outr);; % --------------------------------------------------------------------- % % Recognizer for type operators % % --------------------------------------------------------------------- % let istyop op = (not(arity(outl op) = 0)) ? false;; % --------------------------------------------------------------------- % % Test for presence of closing parenthesis. % % --------------------------------------------------------------------- % let ckrb tok = if (is tok `)`) then tok else failwith `missing ")"`;; % --------------------------------------------------------------------- % % Make a type, but issue an informative error message on error. % % --------------------------------------------------------------------- % let mk_ty(name,tys) = if (is_type name) then if (arity name = length tys) then mk_type(name,tys) else let n = string_of_int (arity name) in failwith `"` ^ name ^ `" has arity ` ^ n else failwith `"` ^ name ^ `" is not a type constant or operator`;; % --------------------------------------------------------------------- % % parse_types: parse a sequence consisting of type expressions or % % instances of a special (supplied) identifier, terminated by or % % by "|". % % --------------------------------------------------------------------- % let parse_types = letrec getops ty rest = let tok,rem = gnt rest in if istyop tok then getops (mk_type(outl tok,[ty])) rem else ty,rest in % ------------------------------------------------------------------ % % ::= * "|" * % % % % ::= | % % ------------------------------------------------------------------ % letrec parse_seq name cs = let tok,rest = gnt cs in if (end tok) then [],cs else if (is tok `|`) then [],rest else if (tok = inl name) then ((curry $. (inr ())) # I) (parse_seq name rest) else let ty,rest = parse_fun name cs in ((curry $. (inl ty)) # I) (parse_seq name rest) % ------------------------------------------------------------------ % % ::= -> | % % ------------------------------------------------------------------ % and parse_fun name cs = let ty,rest = parse_sum name cs in let tok,rem = gnt rest in if (is tok `->`) then let ty2,Rem = parse_fun name rem in mk_type(`fun`,[ty;ty2]),Rem else ty,rest % ------------------------------------------------------------------ % % ::= + | % % ------------------------------------------------------------------ % and parse_sum name cs = let ty,rest = parse_prod name cs in let tok,rem = gnt rest in if (is tok `+`) then let ty2,Rem = parse_sum name rem in mk_type(`sum`,[ty;ty2]),Rem else ty,rest % ------------------------------------------------------------------ % % ::= # | % % ------------------------------------------------------------------ % and parse_prod name cs = let ty,rest = parse_comp1 name cs in let tok,rem = gnt rest in if (is tok `#`) then let ty2,Rem = parse_prod name rem in mk_type(`prod`,[ty;ty2]),Rem else ty,rest % ------------------------------------------------------------------ % % ::= op | % % ------------------------------------------------------------------ % and parse_comp1 name cs = let ty,rest = parse_basic name cs in getops ty rest % ------------------------------------------------------------------ % % ::= () op % % | () % % | % % | % % ------------------------------------------------------------------ % and parse_basic name cs = let tok,rest = gnt cs in if (is tok `(`) then let ty,(next,rem) = (I # gnt) (parse_fun name rest) in if (is next `,`) then let args,opl = parse_args name rem in let op,Rem = (gnt o snd) ((ckrb # I) (gnt opl)) in if (isid op & not(op = inl name)) then mk_ty(outl op,ty.args),Rem else failwith `missing tyop after "(,...,)"` else if (is next `)`) then ty,rem else failwith `missing ")"` else if (isid tok & not(tok = inl name)) then mk_ty(outl tok,[]),rest else if (istyvar tok) then (mk_vartype(outl(outr tok))),rest else failwith `ill-formed type expression(s)` % ------------------------------------------------------------------ % % ::= , | % % ------------------------------------------------------------------ % and parse_args name cs = let ty,rest = parse_fun name cs in let tok,rem = gnt rest in if (is tok `,`) then ((\l.ty.l) # I) (parse_args name rem) else [ty],rest in parse_seq;; % --------------------------------------------------------------------- % % Parse one clause in the input grammar % % % % Bugfix: "or (tok = inl name)" deleted in third line. [TFM 91.02.23] % % --------------------------------------------------------------------- % let parse_clause after name used cs = let tok,rest = gnt cs in if (not(isid tok)) then % or (tok = inl name)) then [TFM 91.02.23] % failwith `missing constructor name after ` ^ after else let con = outl tok in if (mem con used) then failwith `duplicate constructor: "` ^ con ^ `"`else if (is_constant con) then failwith `"` ^ con ^ `" is already a constant` else con,(parse_types name rest);; % --------------------------------------------------------------------- % % Parse the clauses in the input grammar % % --------------------------------------------------------------------- % letrec parse_clauses name used cs = let tok,rest = gnt cs in if (end tok) then [] else let con,(args,rem) = parse_clause `"|"` name used cs in (con,args). parse_clauses name (con.used) rem;; % --------------------------------------------------------------------- % % Parse the user's input grammar % % --------------------------------------------------------------------- % let parse_input = let endc = ascii 1 in let check c = (c=endc => failwith `illegal character: "` ^ c ^ `"` | c) in \st. let cs = (map check (explode st)) @ [endc;endc] in let ty,rest = gnt cs in if (end ty) then failwith `empty input string` else if (not(isid ty)) then failwith `ill-formed name for new type` else let name = outl ty in if (is_type name) then failwith `"`^name^` " is already a type` else let eq,rem = gnt rest in if (not(is eq `=`)) then failwith `missing "=" after "`^name^`"` else let con,(args,clcs) = parse_clause `"="` name [] rem in let cls = parse_clauses name [con] clcs in (name,((con,args).cls));; % ===================================================================== % % Code for constructing the type definiton subset predicate % % ===================================================================== % % --------------------------------------------------------------------- % % pargs : split the list of argument types for a constructor (returned % % by parse_input) into a list of types (for non-recursve arguments) and % % a numerical constant giving a count of the number of recursive args. % % % % For example: % % % % pargs [inl ":ty1";inl ":ty2";inr (); inl ":ty3"] % % % % yields 1) [":ty1";":ty2";":ty3"] (types of non recursive args) % % 2) "SUC 0" (the no. of recursive arguments) % % % % --------------------------------------------------------------------- % let pargs = let SUC = curry mk_comb "SUC" and consf h t = h.t in letrec argsf n as = if (null as) then ([],n) else (let ty = outl (hd as) in (consf ty # I) (argsf n (tl as))) ? argsf (SUC n) (tl as) in argsf "0";; % --------------------------------------------------------------------- % % mk_tuple_ty : make a tuple type of a list of types. % % % % Special case: if the list is empty, then the output is ":one". % % --------------------------------------------------------------------- % let mk_tuple_ty = let mk_prod ty1 ty2 = mk_type(`prod`,[ty1;ty2]) in let onety = ":one" in \l. end_itlist mk_prod l ? onety;; % --------------------------------------------------------------------- % % mk_tuple : make a tuple of a list of terms. % % % % Special case: if the list is empty, then the output is "one:one". % % --------------------------------------------------------------------- % let mk_tuple = let onec = "one" in \l. end_itlist (curry mk_pair) l ? onec;; % --------------------------------------------------------------------- % % mk_sum_ty : make a tum type of a list of types. % % --------------------------------------------------------------------- % let mk_sum_ty = let mk_sum ty1 ty2 = mk_type(`sum`,[ty1;ty2]) in end_itlist mk_sum;; % --------------------------------------------------------------------- % % inject : make a list of injections of a list of values, given a sum % % type into which they are to be injected. % % % % For example, if ty = (ty1,(ty2,ty3))sum and vs = [v1;v2;v3] then: % % % % inject ty vs = [INL v1; INL(INR v2); INR(INR v3)] % % --------------------------------------------------------------------- % letrec inject ty (v.vs) = if (null vs) then [v] else let _,[lty;rty] = dest_type ty in let inlty = mk_type(`fun`,[lty;ty]) in let res = mk_comb(mk_const(`INL`,inlty),v) in let inrty = mk_type(`fun`,[rty;ty]) in let Inr = curry mk_comb (mk_const(`INR`,inrty)) in res.(map Inr (inject rty vs));; % --------------------------------------------------------------------- % % mkvars : generate sensible variable names for the arguments to the % % non-recursive constructors of a newly-defined type. A call to mkvars % % takes the form: % % % % mkvars [t1;...;tn] % % % % where t1,...,tn are the types required for the variables. % % --------------------------------------------------------------------- % let mkvars = let fch ty = (hd o explode o fst o dest_type) ty ? `x` in let suff f c l = if (f c = ``) then if (exists (\x. fch x = c) l) then `0`, \ch. (ch=c) => `0` | f ch else ``,f else let n = string_of_int(int_of_string(f c) + 1) in n,\ch. (ch=c) => n | f ch in letrec mkvs fn rvs l = if (null l) then [] else let c = fch (hd l) in let s,fn' = suff fn c (tl l) in let v = variant rvs (mk_primed_var(c^s,hd l)) in v . mkvs fn' (v.rvs) (tl l) in \l. mkvs (\x.``) [] l;; % --------------------------------------------------------------------- % % mk_subset_pred : make a subset predicate from the parse of the user's % % input. For a full description of the form of this predicate, see: % % % % Melham, T.F. % % "Automating Recursive Type Definitions in Higher Order Logic", % % in: Current Trends in Hardware Verification and Automated % % Theorem Proving, edited by G. Birtwistle and P.A. Subrahmanyam, % % (Springer-Verlag 1989) pp. 341-386. % % --------------------------------------------------------------------- % let mk_subset_pred = let boolty = ":bool" in let zero = let Z = "0" in \n. n = Z in let LEN = let numty = ":num" and eq = "$=:num->num->bool" in \tl. let lenty = mk_type(`fun`,[type_of tl;numty]) in let lentl = mk_comb(eq,mk_comb(mk_const(`LENGTH`,lenty),tl)) in \n. mk_comb(lentl,n) in \tysl. let tys,rectys = split (map pargs tysl) in if (not(exists zero rectys)) then failwith `no non-recursive constructor` else let repty = mk_sum_ty (map mk_tuple_ty tys) in let tlty = mk_type(`list`,[mk_type(`ltree`,[repty])]) in let v = mk_var(`v`,repty) and tlv = mk_var(`tl`,tlty) in let lens = map (LEN tlv) rectys in let cases = if (null(tl tys)) then (let vars = mkvars (hd tys) in [list_mk_exists(vars, mk_eq(v,mk_tuple vars))]) else (let vsl = map mkvars tys in let tuples = (map mk_tuple vsl) in let injs = inject repty tuples in let eqs = map (curry mk_eq v) injs in map list_mk_exists (combine(vsl,eqs))) in let body = list_mk_disj (map mk_conj (combine(cases,lens))) in mk_abs(v,mk_abs(tlv,body));; % ===================================================================== % % existence proof for the subset predicate % % ===================================================================== % % --------------------------------------------------------------------- % % splitf : split a list at a value satisfying a given predicate. % % --------------------------------------------------------------------- % letrec splitf p (x.xs) = if (p x) then [],x,xs else (curry $. x # I) (splitf p xs);; % --------------------------------------------------------------------- % % prove_existence_thm : prove the existence theorem required for making % % the type definition. % % % % Given a subset predicate, pred, of the form: % % % % \v tl. (?x1 ... xn. v = INL(x1,...,xn) /\ LENGTH tl = l1) /\ % % (?x1 ... xm. v = INL(INR(x1...xm)) /\ LENGTH tl = l2) % % : % % etc % % % % this function look for a case where "LENGTH tl = 0" and then proves % % that |- ?r. TRP pred r % % % % --------------------------------------------------------------------- % let prove_existence_thm = let LEN0 = CONJUNCT1 (definition `list` `LENGTH`) in let EXTH = theorem `tydefs` `exists_TRP` in let zero = let Z = "0" in \tm. tm = Z in let efn (nv,ov) th = let vs,l,r = (I # dest_eq) (strip_exists (concl th)) in let pat = list_mk_exists(ov.vs,mk_eq(l,subst[ov,nv]r)) in EXISTS (pat,nv) th in \pred. let rty = hd(snd(dest_type(type_of pred))) in let [v;tl],cs = (I # disjuncts)(strip_abs pred) in let b,cl,a = splitf (zero o rand o rand) cs in let body = rand(rator cl) in let vs,val = (I # rand) (strip_exists body) in let nvs = map (\v. variant vs v,v) vs in let nval = subst nvs val in let veth = itlist efn nvs (REFL nval) in let lem = EXISTS (mk_exists(v,body),nval) veth in let ltrty = mk_type(`ltree`,[rty]) in let cth = CONJ (ASSUME body) (INST_TYPE [ltrty,":*"] LEN0) in let Nil = mk_const(`NIL`,mk_type(`list`,[ltrty])) in let app = mk_comb(mk_comb (pred,v),Nil) in let beta = EXISTS_EQ v (SYM(LIST_BETA_CONV app)) in let thm1 = if (null a) then cth else DISJ1 cth (list_mk_disj a) in let thm2 = INST [Nil,tl](itlist DISJ2 b thm1) in let eth = CHOOSE (v,lem) (EXISTS (lhs(concl beta),v) thm2) in let exth = SPEC pred (INST_TYPE [rty,":*"] EXTH) in NOT_MP exth (EQ_MP beta eth);; % ===================================================================== % % variant_tyvar: Find the type variable with the least number of stars % % that doesn't occur in the given list (for instantiating TY_DEF_THM). % % ===================================================================== % letrec variant_tyvar l1 l2 = let ty = mk_vartype(implode l2) in if (exists (\t.t=ty) l1) then variant_tyvar l1 (`*`.l2) else ty;; % ===================================================================== % % Procedures for cleaning up the type axiom after instantiation. % % ===================================================================== % % --------------------------------------------------------------------- % % OR_IMP_CONV: eliminate disjuncts in the antecedent of an implication. % % % % Given a term "(D1 \/ ... \/ Dn) ==> C", OR_IMP_CONV returns: % % % % |- ((D1 \/ ... \/ Dn) ==> C) = (D1 ==> C /\ ... /\ Dn ==> C) % % --------------------------------------------------------------------- % let OR_IMP_CONV = letrec proveimp f DS = (let (D1,D2) = dest_disj DS in let res = DISCH D1 (f (DISJ1 (ASSUME D1) D2)) in CONJ res (proveimp (f o (DISJ2 D1)) D2)) ? DISCH DS (f (ASSUME DS)) in let disjfn th1 th2 = let D = mk_disj(rand(rator(concl th1)),rand(rator(concl th2))) in DISCH D (DISJ_CASES (ASSUME D) (UNDISCH th1) (UNDISCH th2)) in \tm. let DS,C = (dest_imp tm) in let imp1 = DISCH tm (proveimp (MP (ASSUME tm)) DS) in let rtm = snd(dest_imp(concl imp1)) in let imp2 = DISCH rtm (end_itlist disjfn (CONJUNCTS(ASSUME rtm))) in IMP_ANTISYM_RULE imp1 imp2;; % --------------------------------------------------------------------- % % FORALL_IN_CONV: move two universal quantifiers into a conjunction. % % % % Given a term "!x y. C1 /\ ... /\ Cn", the conversion proves: % % % % |- (!x y. C1 /\ ... /\ Cn) = (!x y. C1) /\ ... /\ (!x y. Cn) % % % % Note: this conversion can easily be adapted to deal with more than % % two universally quantified variables by using SPECL and GENL. % % --------------------------------------------------------------------- % let FORALL_IN_CONV = letrec mconj f th = (let th1,th2 = (f # mconj f) (CONJ_PAIR th) in CONJ th1 th2) ? f th in \tm. let [x;y],cs = (I # conjuncts) (strip_forall tm) in let spec = (SPEC y) o (SPEC x) and gen = (GEN x) o (GEN y) in let imp1 = DISCH tm (mconj gen (spec (ASSUME tm))) in let acs = snd(dest_imp(concl imp1)) in let imp2 = DISCH acs (gen (mconj spec (ASSUME acs))) in IMP_ANTISYM_RULE imp1 imp2;; % --------------------------------------------------------------------- % % CONJS_CONV : apply a given conversion to a sequence of conjuncts % % % % CONJS_CONV conv "t1 /\ t2 /\ ... /\ tn" applies conv to each of the % % n conjuncts t1,t2,...,tn and then rebuilds the conjunction from the % % results. % % % % --------------------------------------------------------------------- % letrec CONJS_CONV conv tm = (let c,cs = (conv # CONJS_CONV conv) (dest_conj tm) in MK_COMB((AP_TERM "$/\" c),cs)) ? conv tm;; % --------------------------------------------------------------------- % % EQN_ELIM_CONV : eliminate antecedent defining equations for the node % % verticies (see below). % % % % The terms in question have the form: % % % % "!v tl. ((?x1...xn. v=tm) /\ P) ==> Q" % % % % This conversion transforms this term as follows: % % % % |- (!v tl. ((?x1...xn. v=tm) /\ P) ==> Q) % % = % % !tl. P ==> !x1...xn. Q[tm/v] % % % % --------------------------------------------------------------------- % let EQN_ELIM_CONV = let efn (nv,ov) th = let vs,(l,r) = (I # dest_eq) (strip_exists(concl th)) in let pat = list_mk_exists(nv.vs,mk_eq(l,subst[nv,ov]r)) in EXISTS (pat,ov) th in let chfn fn v th = let asm = ASSUME (mk_exists(v,find fn (hyp th))) in CHOOSE (v,asm) th in \tm. let [v;tl],ANTE,Q = (I # dest_imp) (strip_forall tm) in let (vs,def),P = (strip_exists # I) (dest_conj ANTE) in let thm1 = SPEC tl (SPEC (rand def) (ASSUME tm)) in let goal = fst(dest_conj(fst(dest_imp(concl thm1)))) in let nvs = fst(strip_exists goal) in let thm2 = itlist efn (combine(nvs,vs)) (REFL (rand def)) in let thm3 = DISCH P (GENL vs (MP thm1 (CONJ thm2 (ASSUME P)))) in let imp1 = DISCH tm (GEN tl thm3) in let res = snd(dest_imp(concl imp1)) in let a1,a2 = CONJ_PAIR(ASSUME ANTE) in let asm = MP (SPEC tl (ASSUME res)) a2 in let thm4 = SUBST [SYM (ASSUME def),v] Q (SPECL vs asm) in let fn tm = lhs(snd(strip_exists tm)) = v ? false in let thm5 = PROVE_HYP a1 (itlist (chfn fn) vs thm4) in let imp2 = DISCH res (GEN v (GEN tl (DISCH ANTE thm5))) in IMP_ANTISYM_RULE imp1 imp2;; % --------------------------------------------------------------------- % % LENGTH_MAP_CONV : eliminate the "LENGTH (MAP REP tl) = n" terms in % % favour of "LENGTH tl = n". % % % % The terms in question have the form: % % % % "!tl. (LENGTH (MAP REP tl) = n) ==> Q" % % % % The conversion is supplied with the theorem: % % % % |- $= LENGTH (MAP REP tl) = $= LENGTH tl % % % % and transforms the input term as follows: % % % % |- !tl. (LENGTH (MAP REP tl) = n) ==> Q % % = % % !tl. (LENGTH tl = n) ==> Q % % % % --------------------------------------------------------------------- % let LENGTH_MAP_CONV = let IMP = "==>" in \eq tm. let tl,n,Q = (I # ((rand # I) o dest_imp)) (dest_forall tm) in FORALL_EQ tl (AP_THM (AP_TERM IMP (AP_THM eq n)) Q);; % --------------------------------------------------------------------- % % LENGTH_ELIM_CONV : Eliminate "LENGTH" expressions. % % % % If n is a number in successor notation (e.g. "0", "SUC 0", etc) then: % % % % LENGTH_ELIM_CONV ":ty" "!l:(ty)list. (LENGTH l = n) ==> tm[l]" % % % % returns: % % % % |- (!l. (LENGTH l = n) ==> tm[l]) = !x0...xi. tm[[x0;...;xi]/l] % % % % where i = n-1, and the `x`'s have sensibly-chosen names. % % --------------------------------------------------------------------- % let LENGTH_ELIM_CONV = let ZERO = "0" and N = "n:num" in let lcons = theorem `list` `LENGTH_EQ_CONS` and lnil = theorem `list` `LENGTH_EQ_NIL` in let genvs = let ONE = "SUC 0" in let mkvar ty st i = mk_primed_var(st ^ string_of_int i,ty) in letrec gvs bvs ty st n i = if (n=ZERO) then [] else let v = variant bvs (mkvar ty st i) in v. gvs (v.bvs) ty st (rand n) (i+1) in \bvs ty st n. if (n=ONE) then let v = mk_primed_var(st,ty) in [variant bvs v] else gvs bvs ty st n 1 in let pred_ty = let bty = ":bool" in \ty. mk_type(`fun`,[ty;bty]) in letrec bconv tm = (let (l,v,bd),ar = (((I # dest_forall) o dest_abs) # I)(dest_comb tm) in let th = FORALL_EQ v (bconv bd) in RIGHT_BETA (AP_THM (ABS l th) ar)) ? BETA_CONV tm in letrec conv (cth,nth) Pv P n vs = if (n=ZERO) then INST [P,Pv] nth else let pre = rand n in let th1 = INST [P,Pv] (INST [pre,N] cth) in let l,body = dest_forall(rand(concl th1)) in let l',x,bdy = (I # dest_forall) (dest_abs(rator(rand body))) in let P' = mk_abs(l',mk_forall(hd vs,subst[hd vs,x]bdy)) in TRANS th1 (conv (cth,nth) Pv P' pre (tl vs)) in \tm. let l,lenl,body = (I # dest_comb) (dest_forall tm) in let n = rand(rand lenl) in let _,[ty] = dest_type(type_of l) in let (st._) = explode(fst(dest_type ty)) in let bvs = fst(strip_forall body) in let vs = genvs bvs ty st n in let lam = mk_abs(l,body) in let bth = AP_TERM lenl (SYM(BETA_CONV (mk_comb(lam,l)))) in let Pv = genvar (pred_ty(type_of l)) in let cth = SPEC N (SPEC Pv (INST_TYPE [ty,":*"] lcons)) in let nth = SPEC Pv (INST_TYPE [ty,":*"] lnil) in let thm1 = conv (cth,nth) Pv lam n vs in let thm2 = TRANS (FORALL_EQ l bth) thm1 in CONV_RULE (RAND_CONV bconv) thm2;; % --------------------------------------------------------------------- % % MAP_CONV : expand "MAP f [...]" with the definition of "MAP" % % --------------------------------------------------------------------- % let MAP_CONV = let mnil,mcons = CONJ_PAIR (definition `list` `MAP`) in letrec conv (nth,cth) tm = (let _,[h;t] = strip_comb tm in let thm = SPEC t (SPEC h cth) in let cfn = rator(rand(concl thm)) in TRANS thm (AP_TERM cfn (conv (nth,cth) t))) ? nth in \tm. let _,[f;l] = strip_comb tm in conv (ISPEC f mnil, ISPEC f mcons) l;; % --------------------------------------------------------------------- % % ELIM_MAP_CONV : use MAP_CONV where appropriate. % % --------------------------------------------------------------------- % let ELIM_MAP_CONV tm = let vs,(EQ,[l;r]) = (I # strip_comb) (strip_forall tm) in let fn,A,Na,arg = (I # ((I # dest_comb) o dest_comb)) (dest_comb l) in let thm1 = AP_TERM fn (AP_TERM A (AP_TERM Na (MAP_CONV arg))) in let f,[a1;a2;a3] = strip_comb r in let thm2 = AP_THM (AP_THM (AP_TERM f (MAP_CONV a1)) a2) a3 in let thm = MK_COMB (AP_TERM EQ thm1, thm2) in itlist FORALL_EQ vs thm;; % --------------------------------------------------------------------- % % TRANSFORM : transform the type axiom towards its final form: % % % % |- !f. ?!fn. !v tl. % % --------------------------------- % % |- ?!fn. % % % % The transformations are: % % % % (1) two beta conversions: % % % % "(\v tl. tm) t1 t2" ---> "tm[t1/v,t2/tl]" % % % % (2) eliminate the antecedent disjunction: % % % % "D1 \/ .. \/ Dn ==> Q" ---> "D1 ==> Q /\ .. /\ Dn ==> Q" % % % % (3) move universally quantified vars into resulting conjunction: % % % % "!v tl. i1 /\ .. /\ in ---> "!v tl. i1 /\ .. /\ !v tl. in" % % % % (4) apply the transfomation given by EQN_ELIM_CONV to each conjunct. % % % % (5) transform LENGTH(MAP REP tl) into LENGTH tl (as described above) % % % % (6) eliminate "LENGTH tl = n ==> P" using LENGTH_ELIM_CONV. % % % % (7) expand "MAP f [...]" using the definition of MAP. % % % % % % NB: the function drops the "f", and returns it. % % --------------------------------------------------------------------- % let TRANSFORM = let EQ = "$=:num->num->bool" in let lmap = theorem `list` `LENGTH_MAP` in let cconv lm = EVERY_CONV [EQN_ELIM_CONV; % (4) % LENGTH_MAP_CONV lm; % (5) % LENGTH_ELIM_CONV; % (6) % ELIM_MAP_CONV] in % (7) % \REP th. let f,EU,body = (I # dest_comb) (dest_forall (concl th)) in let fn,[v;tl],imp = (I # strip_forall) (dest_abs body) in let (IMP,hy),cncl = (dest_comb # I) (dest_comb imp) in let beta = (RATOR_CONV BETA_CONV THENC BETA_CONV) hy in % (1) % let thm1 = AP_THM (AP_TERM IMP beta) cncl in let red = rand (concl thm1) in let thm2 = TRANS thm1 (OR_IMP_CONV red) in % (2) % let thm3 = FORALL_EQ v (FORALL_EQ tl thm2) in let gen = rand (concl thm3) in let thm4 = TRANS thm3 (FORALL_IN_CONV gen) in % (3) % let cs = rand (concl thm4) in let lmth = AP_TERM EQ (ISPECL [tl;REP] lmap) in let thm5 = TRANS thm4 (CONJS_CONV (cconv lmth) cs) in let thm6 = AP_TERM EU (ABS fn thm5) in (f,EQ_MP thm6 (SPEC f th));; % ===================================================================== % % Define the constructors of the recursive type. % % ===================================================================== % % --------------------------------------------------------------------- % % part : split a list into two parts: a list of the first n elements, % % and a list of the remaining elements. % % --------------------------------------------------------------------- % letrec part n l = (n=0 => [],l | (curry $. (hd l) # I) (part (n-1) (tl l)));; % --------------------------------------------------------------------- % % define_const : define one of the constructors for the concrete % % recursive type specified by the user. The arguments are: % % % % c : the constructor name % % tys : its types, as returned by parse_input % % tm : the equation for that constructor, in its current state. % % --------------------------------------------------------------------- % let define_const = let cfn ty n = (isl ty => n+1 | n) in letrec combin evs rvs tys = if (null tys) then [] else if (isl (hd tys)) then hd evs . combin (tl evs) rvs (tl tys) else hd rvs . combin evs (tl rvs) (tl tys) in let mkfnty v ty = mk_type(`fun`,[type_of v;ty]) in let geneq uovs odvs tm = let imp1 = GENL odvs (SPECL uovs (ASSUME tm)) in let body = concl imp1 in let imp2 = DISCH body (GENL uovs (SPECL odvs (ASSUME body))) in IMP_ANTISYM_RULE (DISCH tm imp1) imp2 in \(c,tys,tm). let vs,(EQ,[l;r]) = (I # strip_comb) (strip_forall tm) in let f = fst(strip_comb r) in let count = itlist (\ty n. isl ty => n | n+1) tys 0 in let rvs,evs = (rev # I) (part count vs) in let vars = combin evs rvs tys in let cty = itlist mkfnty vars (type_of (rand l)) in let Ccomb = list_mk_comb(mk_var(c,cty),vars) in let def = new_definition(c^`_DEF`,mk_eq(Ccomb,rand l)) in let dvs = fst(strip_forall(concl def)) in let thm1 = AP_TERM EQ (AP_TERM (rator l) (SPECL dvs def)) in let thm2 = itlist FORALL_EQ dvs (SYM (AP_THM thm1 r)) in (TRANS (geneq vs vars tm) thm2) ;; % --------------------------------------------------------------------- % % DEFINE_CONSTRUCTORS : defines the constructors for the concrete % % recursive type specified by the user. This function just maps % % define_const over the conjuncts of the current theorem. % % --------------------------------------------------------------------- % let DEFINE_CONSTRUCTORS = let mkconj = let AND = "/\" in \t1 t2. MK_COMB(AP_TERM AND t1,t2) in \cs atys th. let EU,(fn,body) = (I # dest_abs) (dest_comb (concl th)) in let dcs = map define_const (combine(cs,combine(atys,conjuncts body))) in let thm = end_itlist mkconj dcs in EQ_MP (AP_TERM EU (ABS fn thm)) th;; % ===================================================================== % % Construct the function which applies a separate function variable to % % the values present on the right-hand side of each defining equation % % in the recursive function definition. % % ===================================================================== % % --------------------------------------------------------------------- % % mk_tests : make the discriminator tests for each clause of the type % % definition theorem. A call to: % % % % mk_tests [x1,x2...,xn] ":ty1 + ty2 + ... + tyn" % % % % returns a variable v, and a list of tests: % % % % [ISL v; ISL (OUTR v); ... ; ISL (OUTR ... (OUTR v)..)] % % % % where v is a genvar of type ":ty1 + ty2 + ... + tyn" % % % % --------------------------------------------------------------------- % let mk_tests = let boolty = ":bool" in letrec make (c.cs) v ty = if (null cs) then [] else let _,[_;outty] = dest_type ty in let Isl = mk_const(`ISL`,mk_type(`fun`,[ty;boolty])) in let Outr = mk_const(`OUTR`,mk_type(`fun`,[ty;outty])) in let test = mk_comb(Isl,v) and out = mk_comb(Outr,v) in test . make cs out outty in \cs ty. let v = genvar ty in v, make cs v ty;; % --------------------------------------------------------------------- % % mk_proj : make the projections for each clause of the type definition % % theorem. A call to: % % % % mk_proj v [x1,x2...,xn] ":ty1 + ty2 + ... + tyn" % % % % returns a list of projections: % % % % [OUTL v; OUTL(OUTR v); ... ; OUTR (OUTR ... (OUTR v)..)] % % % % where v is a supplied genvar of type ":ty1 + ty2 + ... + tyn" % % % % --------------------------------------------------------------------- % letrec mk_proj v (c.cs) ty = if (null cs) then [v] else let _,[ty1;ty2] = dest_type ty in let Outr = mk_const(`OUTR`,mk_type(`fun`,[ty;ty2])) in let Outl = mk_const(`OUTL`,mk_type(`fun`,[ty;ty1])) in let ltm = mk_comb(Outl,v) and rtm = mk_comb(Outr,v) in ltm . mk_proj rtm cs ty2;; % --------------------------------------------------------------------- % % extract_list : generate expressions that extract the components of an % % object-language list. A call to: % % % % extract_list "(ty)list" "v:ty list" "[x1:ty;...,xn]" % % % % returns a list of terms: % % % % ["HD v"; "HD(TL v)"; ... ; "HD(TL ... (TL v)..)"] % % % % Note: the list can be empty. % % --------------------------------------------------------------------- % let extract_list ty = let _,[ety] = dest_type ty in let Hd = mk_const(`HD`,mk_type(`fun`,[ty;ety])) in let Tl = mk_const(`TL`,mk_type(`fun`,[ty;ty])) in letrec extr Hd Tl v tm = (let _,[h;t] = strip_comb tm in let hval = mk_comb(Hd,v) in let tval = mk_comb(Tl,v) in hval . extr Hd Tl tval t) ? [] in extr Hd Tl;; % --------------------------------------------------------------------- % % strip_inj : strip an arbitrary number of injections off a term. A % % typical call to strip_inj looks like: % % % % strip_inj "INR(INR(INR....(INL )..) % % % % and returns . % % --------------------------------------------------------------------- % letrec strip_inj tm = (let op,arg = ((fst o dest_const) # I) (dest_comb tm) in if (op = `INR` or op = `INL`) then strip_inj arg else tm) ? tm;; % --------------------------------------------------------------------- % % extract_tuple : generate expressions that extract the components of % % an object-language tuple. A call to: % % % % extract_tuple "ty" "v:ty" "(x1,...,xn)ty" % % % % returns a list of terms: % % % % ["FST v"; "FST(SND v)"; ... ; "FST(SND ... (SND v)..)"] % % % % Note: the list will not be empty. % % --------------------------------------------------------------------- % letrec extract_tuple ty v tm = (let _,[c1;c2] = strip_comb tm in let _,[ty1;ty2] = dest_type ty in let Fst = mk_const(`FST`,mk_type(`fun`,[ty;ty1])) in let Snd = mk_const(`SND`,mk_type(`fun`,[ty;ty2])) in let fval = mk_comb(Fst,v) in let sval = mk_comb(Snd,v) in fval . extract_tuple ty2 sval c2) ? [v];; % --------------------------------------------------------------------- % % gen_names : generate reasonable names for the function variables on % % the right-hand sides of the equations in the type axiom. There are % % two kinds of names: % % % % `e` and `f` % % % % A name has the e-form if the corresponding "function" is just a % % constant (this information is obtained from the "cs" list). Otherwise % % the name has the f-form. Suffixes are numerical, and are generated % % in the order: 0,1,2...etc. When ef is true, however, there will be % % only one e-type name, for which the suffix will be empty. Likewise % % for functions proper when the ff flag is true. % % --------------------------------------------------------------------- % let gen_names = letrec gen (ef,ff) (n,m) cs = if (null cs) then [] else if (null (hd cs)) then let ename = (`e` ^ (if ef then string_of_int n else ``)) in ename . gen (ef,ff) (n+1,m) (tl cs) else let fname = (`f` ^ (if ff then string_of_int m else ``)) in fname . gen (ef,ff) (n,m+1) (tl cs) in \(ef,ff) cs. gen (ef,ff) (0,0) cs;; % --------------------------------------------------------------------- % % mk_fun_ty : construct a function type, given a term and the type of % % the expected result. % % % % mk_fun_ty "tm:ty1" ":ty2" = ":ty1 -> ty2" % % --------------------------------------------------------------------- % let mk_fun_ty tm ty = mk_type(`fun`,[type_of tm;ty]);; % --------------------------------------------------------------------- % % make_rhs : make the right-hand side for one clause of the type axiom. % % The ty argument is the resulting type of the right-hand side. The % % variables rv and tv are genvars, standing for the list of results of % % recursive applications of the recursive function and the subtrees, % % respectively. The variable pv is the result of projecting out the % % tuple of non-recursive values, and the flag fl indicates if any such % % values are actually present (this distinguishes between a constructor % % with a single argument of the user-specified type :one and the use of % % ":one" to represent constant constructors). The terms rl, val, and % % tl are the right-hand side values to be extracted. The string `name` % % gives the function name for this right-hand side. % % --------------------------------------------------------------------- % let make_rhs ty rv tv (fl,pv,name,[rl;val;tl]) = let exrl = extract_list (type_of rl) rv rl in let extl = extract_list (type_of tl) tv tl in let svl = strip_inj val in let extu = (fl => [] | extract_tuple (type_of pv) pv svl) in let args = exrl @ extu @ extl in let v = mk_var(name,itlist mk_fun_ty args ty) in v,list_mk_comb(v,args);; % --------------------------------------------------------------------- % % make_conditional : make an interated conditional. A call to: % % % % make_conditional ["t1";...;"tn"] ["x1";...;"xn+1"] % % % % returns: % % % % "(t1 => x1 | (t2 => x2 | ... | xn+1))]" % % % % Note that n can be zero, in which case the result is "x1". % % --------------------------------------------------------------------- % letrec make_conditional ts rs = if (null ts) then hd rs else mk_cond (hd ts,hd rs,make_conditional (tl ts) (tl rs));; % --------------------------------------------------------------------- % % make_function : Make the function that extracts the values present on % % the right-hand sides of each clause, and introduces separate function % % variables for each clause. % % --------------------------------------------------------------------- % let make_function = let mkflag l = not(length l = 1) in let nonrec l = not(exists isl l) in \atys th. let cs = conjuncts(snd(dest_abs(rand(concl th)))) in let ef,ff = (mkflag # mkflag) (partition null atys) in let names = gen_names (ef,ff) atys in let f,[rl;val;ts] = strip_comb (rand(snd(strip_forall(hd cs)))) in let _,[resty] = dest_type(type_of rl) in let rv = genvar (type_of rl) and tv = genvar (type_of ts) in let vv,tests = mk_tests names (type_of val) in let proj = mk_proj vv names (type_of val) in let vs,rs = (flat # I) (split(map ((I # rand) o strip_forall) cs)) in let rhss = map (snd o strip_comb) rs in let arg = combine(map nonrec atys,combine(proj,combine(names,rhss))) in let vs,res = split(map (make_rhs resty rv tv) arg) in (vs, list_mk_abs ([rv;vv;tv],make_conditional tests res));; % ===================================================================== % % Procedures for simplifying the type axiom into its final form. % % ===================================================================== % % --------------------------------------------------------------------- % % PROJ_CONV : simplify right-projections of right-injections. % % % % A call to: PROJ_CONV "OUTR(OUTR ... (INR(INR x)))" returns: % % % % |- OUTR(OUTR ... (INR(INR x))) = x % % --------------------------------------------------------------------- % let PROJ_CONV = let thm = definition `sum` `OUTR` in let rew = \tm. REWR_CONV thm tm ? (REFL tm) in letrec conv tm = (let C,arg = dest_comb tm in if (fst(dest_const C) = `OUTR`) then let th = AP_TERM C (conv arg) in TRANS th (rew (rand(concl th))) else REFL tm) ? REFL tm in conv;; % --------------------------------------------------------------------- % % TEST_SIMP_CONV : repeatedly simplify conditionals as follows: % % % % (1) TEST_SIMP_CONV "(ISL...(INL x)) => a | b" returns: % % % % |- (ISL...(INL x) => a | b) = a % % % % (2) TEST_SIMP_CONV "(ISL...(INR x)) => a | b" returns: % % % % |- (ISL...(INR x) => a | b) = b % % % % where the dots "..." stand for any number of intermediate right % % projections of left injections as simplified by PROJ_CONV. % % --------------------------------------------------------------------- % let TEST_SIMP_CONV = let thm = definition `sum` `ISL` in let th1,th2 = (SPEC "x:*" # SPEC "y:**") (CONJ_PAIR thm) in let Tth = EQT_INTRO th1 and Fth = EQF_INTRO th2 in let rewconv = FIRST_CONV [REWR_CONV Fth;REWR_CONV Tth] in letrec conv cond = (let C,[test;a;b] = strip_comb cond in let simp = ((RAND_CONV PROJ_CONV) THENC rewconv) test in let thm2 = MK_COMB(AP_THM (AP_TERM C simp) a, conv b) in CONV_RULE (RAND_CONV COND_CONV) thm2) ? REFL cond in conv;; % --------------------------------------------------------------------- % % LIST_ELS : extract the elements of a list. % % % % Given "[x1;x2;...;xn]", LIST_ELS produces a list of theorems: % % % % [|- HD [x1;x2;...;xn] = x1; % % HD (TL [x1;x2;...;xn]) = x2; % % ... etc ... = xn] % % --------------------------------------------------------------------- % let LIST_ELS = let H = definition `list` `HD` and T = definition `list` `TL` in letrec genels (hth,tth) (hf,tf) th = (let _,[h;t] = strip_comb(rand(concl th)) in let thm = TRANS (hf th) (SPEC t (SPEC h hth)) in let tthm = TRANS (tf th) (SPEC t (SPEC h tth)) in thm . genels (hth,tth) (hf,tf) tthm) ? [] in \tm. let lty = type_of tm in let _,[ty] = dest_type lty in let hth = INST_TYPE [ty,":*"] H and tth = INST_TYPE [ty,":*"] T in let hf = AP_TERM(mk_const(`HD`,mk_type(`fun`,[lty;ty]))) in let tf = AP_TERM(mk_const(`TL`,mk_type(`fun`,[lty;lty]))) in genels (hth,tth) (hf,tf) (REFL tm);; % --------------------------------------------------------------------- % % GEN_PROJ_CONV : generate projections of sum-injections. % % % % A call to GEN_PROJ_CONV generates a theorem that projects a value % % which has been injected into a sum. For example: % % % % PROJ_CONV "INL x" = |- OUTL(INL x) = x % % PROJ_CONV "INR(INL x)" = |- OUTL(OUTR(INR(INL x))) = x % % ... etc. % % --------------------------------------------------------------------- % let GEN_PROJ_CONV = let orth = definition `sum` `OUTR` in let olth = definition `sum` `OUTL` in let inst = let v1,v2 = ":*",":**" in \t1 t2. INST_TYPE [t1,v1;t2,v2] in letrec conv th = (let inj = rand(concl th) in let C,arg = dest_comb inj in let injty = type_of inj in let _,[lty;rty] = dest_type injty in if (fst(dest_const C) = `INR`) then let proj = mk_const(`OUTR`,mk_type(`fun`,[injty;rty])) in let thm1 = AP_TERM proj th in let thm2 = SPEC arg (inst lty rty orth) in conv (TRANS thm1 thm2) else if (fst(dest_const C) = `INL`) then let proj = mk_const(`OUTL`,mk_type(`fun`,[injty;lty])) in let thm1 = AP_TERM proj th in let thm2 = SPEC arg (inst lty rty olth) in conv (TRANS thm1 thm2) else th) ? th in \tm. conv (REFL tm);; % --------------------------------------------------------------------- % % TUPLE_COMPS : extract the components of a tuple. % % % % Given a theorem of the form: % % % % |- tm = (x1,x2,...,xn) % % % % TUPLE_COMPS produces a list of theorems: % % % % [|- FST tm = x1; % % FST(SND tm) = x2; % % . % % . % % SND(...(SND tm)...) = xn] % % % % There are two special cases: % % % % 1) when given a theorem of the form |- tm = v, where v is a variable % % the function returns [|- tm = v]. % % % % 2) when given a theorem of the form |- tm = one, where one is the % % constant value of type one, the function returns []. % % --------------------------------------------------------------------- % let TUPLE_COMPS = letrec generate th = (let _,[f;s] = strip_comb(rand(concl th)) in let thm1 = ISPECL [f;s] FST in let thm = TRANS (AP_TERM (rator(lhs(concl thm1))) th) thm1 in let thm2 = ISPECL [f;s] SND in let tthm = TRANS (AP_TERM (rator(lhs(concl thm2))) th) thm2 in thm . generate tthm) ? [th] in let onec = "one:one" in \th. rand(concl th) = onec => [] | generate th;; % --------------------------------------------------------------------- % % SIMP_CONV : simplifies the conditional expression on the right-hand % % side of an equation. % % --------------------------------------------------------------------- % let SIMP_CONV = let itfn th1 th2 = MK_COMB(th2,th1) in \tm. let vs,(Leq,r) = (I # dest_comb) (strip_forall tm) in let thm1 = LIST_BETA_CONV r in let cond = rand(concl thm1) in let thm2 = TRANS thm1 (TEST_SIMP_CONV cond) in let [l1;lab;l2] = snd(strip_comb r) in let eqs1 = LIST_ELS l1 and eqs3 = LIST_ELS l2 in let eqs2 = TUPLE_COMPS (GEN_PROJ_CONV lab) in let fn = fst(strip_comb(rand(concl thm2))) in let thm3 = rev_itlist itfn (eqs1 @ eqs2 @ eqs3) (REFL fn) in let thm = TRANS thm2 thm3 in itlist FORALL_EQ vs (AP_TERM Leq thm);; % --------------------------------------------------------------------- % % SIMPLIFY : simplifies the type axiom into its final form. % % --------------------------------------------------------------------- % let SIMPLIFY = let mkconj = let AND = "/\" in \t1 t2. MK_COMB(AP_TERM AND t1,t2) in \th. let EU,(fn,body) = (I # dest_abs) (dest_comb (concl th)) in let thm = CONJS_CONV SIMP_CONV body in EQ_MP (AP_TERM EU (ABS fn thm)) th;; % ===================================================================== % % Now, the main program % % ===================================================================== % % --------------------------------------------------------------------- % % define_type: construct a user-specified concrete recursive type and % % derive an abstract characterization of it. % % % % E.g. define_type name `ty = C1 * | C2 ty * | C3 ty ty` defines: % % % % 1) a type operator (*)ty % % 2) constants C1:*->(*)ty, % % C2:(*)ty->*->(*)ty, % % C3:(*)ty->(*)ty->(*)ty % % % % and proves that ty has the following property: % % % % |- !f0 f1 f2. ?!fn. % % (!x. fn(C1 x) = f0 x) /\ % % (!x t. fn(C2 t x) = f1(fn t)x t) /\ % % (!t t'. fn(C3 t t') = f2(fn t)(fn t')t t') % % % % the axiom is stored under "name" and is returned. % % --------------------------------------------------------------------- % let define_type = let TYDEFTHM = theorem `tydefs` `TY_DEF_THM` in \savename spec. let name,cs,atys = (I # split) (parse_input spec) in let isodef = name ^ `_ISO_DEF` in if is_axiom (current_theory(),isodef) then failwith `"` ^ isodef ^ `" already an axiom or definition` else let ABS = `ABS_` ^ name and REP = `REP_` ^ name in if (is_constant ABS) then failwith ABS ^ ` is already a constant` else if (is_constant REP) then failwith REP ^ ` is already a constant` else if can (theorem (current_theory())) savename then failwith `"` ^ savename ^ `" already a theorem in current thy` else let pred = mk_subset_pred atys in let eth = prove_existence_thm pred in let predtm = rator(snd(dest_exists(concl eth))) in let tyax = new_type_definition(name, predtm, eth) in let ARth = define_new_type_bijections isodef ABS REP tyax in let rty = hd(snd(dest_type(type_of pred))) in let newty = hd(snd(dest_type(type_of(fst(dest_exists(concl tyax)))))) in let resty = variant_tyvar (type_tyvars rty) [`*`] in let Pthm = INST_TYPE [rty,":*";newty,":**";resty,":***"] TYDEFTHM in let A,R = let _,AR = dest_forall(rand(rator(concl ARth))) in (I # rator) (dest_comb(lhs AR)) in let Sthm = MP (SPEC pred (SPEC A (SPEC R Pthm))) ARth in let f,trans = TRANSFORM R Sthm in let defns = DEFINE_CONSTRUCTORS cs atys trans in let fs,funct = make_function atys defns in let newfs = INST [funct,f] defns in let abstax = GENL fs (SIMPLIFY newfs) in save_thm(savename,abstax);; % --------------------------------------------------------------------- % % Bind the value of define_type to "it". % % --------------------------------------------------------------------- % define_type;; % --------------------------------------------------------------------- % % end the section. % % --------------------------------------------------------------------- % end_section define_type;; % --------------------------------------------------------------------- % % Save define_type. % % --------------------------------------------------------------------- % let define_type = it;; % ===================================================================== % %< TESTS: new_theory `temp`;; let void_Axiom = define_type `void_Axiom` `void = Void`;; let pair = define_type `pair` `pair = CONST *#**`;; let onetest = define_type `onetest` `onetest = OOOO one`;; let tri_Axiom = define_type `tri_Axiom` `tri = Hi | Lo | Fl`;; let iso_Axiom = define_type `iso_Axiom` `iso = ISO *`;; let List_Axiom = define_type `List_Axiom` `List = Nil | Cons * List`;; let ty_Axiom = define_type `ty_Axiom` `ty = C1 * | C2 | C3 * ** ty | C4 ty *** ty * ** | C5 ty ty`;; define_type `bintree` `bintree = LEAF * | TREE bintree bintree`;; define_type `seven` `typ = C one one#one (one->(one->(*)list)) (*,one#one,(*)list)ty`;; >% % ===================================================================== % hol88-2.02.19940316/ml/tacticals.ml0000640000212700021270000002430205374466523014654 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: tacticals.ml % % % % DESCRIPTION: Monomorphic tacticals % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml % % hol-rule.ml, hol-drule.ml, drul.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`);; % --------------------------------------------------------------------- % % ML type abbreviations. % % --------------------------------------------------------------------- % lettype proof = thm list -> thm ;; lettype goal = term list # term;; lettype tactic = goal -> ((goal list) # proof);; % --------------------------------------------------------------------- % % TAC_PROOF (g,tac) uses tac to prove the goal g % % --------------------------------------------------------------------- % let TAC_PROOF : (goal # tactic) -> thm = set_fail_prefix `TAC_PROOF` (\(g,tac). let gl,p = tac g in if null gl then p[] else failwith `unsolved goals`);; % --------------------------------------------------------------------- % % prove (t,tac) : prove the boolean term t using the tactic tac. % % [MJCG 17/1/89 for HOL88] % % --------------------------------------------------------------------- % let prove(t,tac) = TAC_PROOF(([],t), tac);; % --------------------------------------------------------------------- % % Provide a function (tactic) with the current assumption list % % --------------------------------------------------------------------- % let (ASSUM_LIST: (thm list -> tactic) -> tactic) aslfun (asl,w) = aslfun (map ASSUME asl) (asl,w);; % --------------------------------------------------------------------- % % Pop the first assumption and give it to a function (tactic) % % --------------------------------------------------------------------- % let POP_ASSUM (thfun:thm->tactic) ((as.asl),w) = thfun (ASSUME as) (asl,w);; % --------------------------------------------------------------------- % % Pop off the entire assumption list and give it to a function (tactic) % % --------------------------------------------------------------------- % let POP_ASSUM_LIST (asltac : thm list -> tactic) (asl,w) = asltac (map ASSUME asl) ([],w);; % --------------------------------------------------------------------- % % The tacticals THEN and THENL. % % --------------------------------------------------------------------- % ml_curried_infix `THEN` ;; ml_curried_infix `THENL` ;; begin_section THEN_THENL;; letrec mapshape nl fl l = if null nl then [] else (let m,l = chop_list (hd nl) l in (hd fl)m . mapshape(tl nl)(tl fl)l) ;; let ((tac1 : tactic) THEN (tac2 : tactic)) g = let gl,p = tac1 g in let gll,pl = split(map tac2 gl) in flat gll , (p o mapshape(map length gll)pl) ;; let ((tac1:tactic) THENL (tac2l : tactic list)) g = let gl,p = tac1 g in let gll,pl = split(map (\(tac2,g). tac2 g) tac2gl) where tac2gl = combine(tac2l,gl) ? failwith `THENL` in flat gll , (p o mapshape(map length gll)pl);; (THEN,THENL);; end_section THEN_THENL;; let (THEN,THENL) = it;; ml_curried_infix `ORELSE` ;; let ((tac1:tactic) ORELSE tac2) (g:goal) = tac1 g ? tac2 g ;; % Fail with the given token. Useful in tactic programs to check that a tactic produces no subgoals. Write TAC THEN FAIL_TAC `TAC did not solve the goal` % let FAIL_TAC tok : tactic = \g. failwith tok;; %Tactic that succeeds on no goals; identity for ORELSE% let NO_TAC : tactic = FAIL_TAC `NO_TAC`;; %Tactic that succeeds on all goals; identity for THEN% let ALL_TAC : tactic = \g. [g],hd;; let TRY tac = tac ORELSE ALL_TAC;; % The abstraction around g is essential to avoid looping, due to applicative order semantics % letrec REPEAT tac g = ((tac THEN REPEAT tac) ORELSE ALL_TAC) g ;; % Check whether a theorem achieves a goal, using no extra assumptions % let achieves th : goal -> bool = \(asl,w). aconv (concl th) w & forall (\h. (exists (aconv h)) asl) (hyp th);; % MJCG 17/1/89 for HOL88. mk_fthm not used. let fakethms gl = map mk_fthm gl;; % % Check the goal list and proof returned by a tactic. At top-level, it is convenient to type "chktac it;;" MJCG 17/1/89 for HOL88: mk_thm used instead of mk_fthm. This introduces slight insecurity into the system, but since chktak is assignable this insecurity can be removed by doing: chktak := \(gl,prf). fail % letref chktac((gl:goal list),(prf:proof)) = prf(map mk_thm gl);; %Check whether a prospective (goal list, proof) pair is valid. MJCG 17/1/89 for HOL88: "falsity.asl" changed to "asl". % let check_valid : goal -> (goal list # proof) -> bool = \(asl,w). set_fail_prefix `check_valid` (\glp. achieves (chktac glp) (asl, w));; % Tactical to make any tactic valid. "VALID tac" is the same as "tac", except it will fail in the cases where "tac" returns an invalid proof. VALID uses mk_thm; the proof could assign its arguments to global theorem variables, making them accessible outside. This kind of insecurity is very unlikely to lead to accidental proof of false theorems; see comment preceding check_valid for how to remove insecurity. Previously mk_fthm was used by check_valid instead of mk_thm (see hol-drule.ml), but this lead to problems with tactics (like resolution) that checked for "F". A possible solution would be to use another constant that was defined equal to F. % let (VALID: tactic -> tactic) tac g = let gl,prf = tac g in if check_valid g (gl,prf) then gl,prf else failwith `Invalid tactic`;; %Tactical quantifiers -- Apply a list of tactics in succession% % Uses every tactic. EVERY [TAC1;...;TACn] = TAC1 THEN ... THEN TACn % let EVERY tacl = itlist $THEN tacl ALL_TAC;; % Uses first tactic that succeeds. FIRST [TAC1;...;TACn] = TAC1 ORELSE ... ORELSE TACn % let FIRST tacl g = tryfind (\tac:tactic. tac g) tacl ? failwith `FIRST`;; let MAP_EVERY tacf lst = EVERY (map tacf lst);; let MAP_FIRST tacf lst = FIRST (map tacf lst);; %Call a thm-tactic for every assumption% % --------------------------------------------------------------------- % % Optimized 13.5.93 by JVT to remove the function composition to % % enhance speed. % % % % OLD VERSION: % % % % let EVERY_ASSUM : (thm -> tactic) -> tactic = % % ASSUM_LIST o MAP_EVERY;; % % --------------------------------------------------------------------- % let EVERY_ASSUM : (thm -> tactic) -> tactic = \x. (ASSUM_LIST (MAP_EVERY x));; % --------------------------------------------------------------------- % % Call a thm-tactic for the first assumption at which it succeeds % % % % Revised: TFM 91.04.20 : failures of ttac to produce a tactic are now % % filtered out. % % % % Old implementation: % % % % let FIRST_ASSUM : (thm->tactic)->tactic = ASSUM_LIST o MAP_FIRST;; % % % % Revised: TFM 91.05.24 : optimized; no longer constructs extra tactics.% % % % OLD CODE: % % let FIRST_ASSUM (ttac:thm->tactic) (A,g) = % % FIRST (mapfilter (ttac o ASSUME) A) (A,g) ? failwith `FIRST_ASSUM`;; % % --------------------------------------------------------------------- % let FIRST_ASSUM = letrec find ttac as g = if (null as) then failwith `FIRST_ASSUM` else (ttac (ASSUME(hd as)) g ? find ttac (tl as) g) in \(ttac:thm->tactic). \(A,g). find ttac A (A,g);; % Split off a new subgoal and provide it as a theorem to a tactic SUBGOAL_THEN wa (\tha. tac) makes a subgoal of wa, and also assumes wa for proving the original goal. Most convenient when the tactic solves the original goal, leaving only the new subgoal wa. % let SUBGOAL_THEN wa ttac :tactic (asl,w) = let gl,p = ttac (ASSUME wa) (asl,w) in (asl,wa) . gl, \(tha.thl). PROVE_HYP tha (p thl);; % A tactical that makes a tactic fail if it has no effect % %< (Comment corrected by MJCG on 17.10.90 and "letrec" changed to "let") >% let CHANGED_TAC (tac:tactic) g = let gl,p = tac g in if set_equal gl [g] then fail else (gl,p);; hol88-2.02.19940316/ml/ml-curry.ml0000640000212700021270000001054105071132625014442 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: ml-curry.ml % % % % DESCRIPTION: Currying of Meta Language functions % % % % These functions are more conveninent in curried form, % % but it is difficult to define curried ML functions % % via "dml" % % % % USES FILES: hol-lcf lisp files % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % The following definitions OVERWRITE the old meanings of the functions % % they define, which were originally paired functions (list utilities) % % defined in f-lis.l % % --------------------------------------------------------------------- % let mem x l = mem(x,l);; let map f l = map(f,l);; let exists p l = exists(p,l);; let forall p l = forall(p,l);; let find p l = find(p,l);; let tryfind f l = tryfind(f,l);; let filter p l = filter(p,l);; let mapfilter f l = mapfilter(f,l);; let rev_itlist f l x = rev_itlist(f,l,x);; % --------------------------------------------------------------------- % % The following definitions OVERWRITE the old meanings of the functions % % they define, which were originally paired functions (obj utilities) % % defined in f-obj.l % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % obj primititives deleted [TFM 90.09.09] % % % % let set_left x y = set_left(x,y) % % and set_right x y = set_right(x,y) % % and eq x y = eq(x,y) % % and cons x y = cons(x,y);; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Added TFM/MJCG 88.10.07 % % % % This was added to simplify the makefile for HOL. The boolean flag % % `compiling' is true during compilation and false otherwise. The % % definitions below overwrite the old definitions so that the flag % % `compiling' is maintained. % % --------------------------------------------------------------------- % letref compiling = false;; letref compiling_stack = ([]:bool list);; let load p = (compiling_stack := compiling . compiling_stack; compiling := false; load p; compiling := hd compiling_stack; compiling_stack := tl compiling_stack; ());; let compile p = (compiling_stack := compiling . compiling_stack; compiling := true; compile p; compiling := hd compiling_stack; compiling_stack := tl compiling_stack; ());; hol88-2.02.19940316/ml/new-tactics.ml0000640000212700021270000000513605071125100015103 0ustar cammcamm % ML type of goals with flagged assumptions % lettype fgoal = (string # term)list # term;; % ML type of tactics using flagged goals % lettype ftactic = fgoal -> (fgoal list) # proof;; % Suppose tac is a tactic such that: tac g = [g1;...;gn],p where each goal gi has the form ([ti1;...;tin],ti), then FLAG `flag` tac g = [fg1;...;fgn],p where fgi = [(`flag_i_1`,ti1);...;(`flag_i_n`,tin)]. Thus FLAG has ML type: FLAG : string -> tactic -> goal -> (fgoal list) # proof Before coding FLAG we need a couple of auxiliary functions. % % mapcount f [x1;x2; ... ;xn] = [f 1 x1; f 2 x2; ... ;f n xn] % let mapcount f l = letrec fn n l = if null l then [] else f n (hd l).fn(n+1)(tl l) in fn 1 l;; % flagfn m n `flag` ---> `flag_m_n` % ml_curried_infix `++`;; let $++ = concat;; let flagfn m n tok = tok ++ `_` ++ (string_of_int m) ++ `_` ++ (string_of_int n);; let FLAG flag (tac:tactic) g = let gl,p = tac g in (mapcount(\m (A,t).(mapcount(\n t'.(flagfn m n flag, t'))A,t))gl, p);; % FLAGIFY : string -> tactic -> ftactic Suppose fg = ([`f1`,t1; ... ;`fn`,tn],t) is a flagged goal. Suppose: tac ([t1;...;tn],t) = [g1;...;gn],p where gi = ([ti1;...;tin],ti) Then FLAGIFY `flag` tac fg = ([fg1;...;fgn],p) where fgi = ([fi1,ti1; ... ;fin,tin],ti) where fij is `fk` if tij=tk (so flags on assumptions that are `passed through' are preserved), otherwise it is `flag_i_j` % let FLAGIFY flag (tac:tactic) ((fl,t):fgoal) = let gl,p = tac(map snd fl,t) in (mapcount (\m (A,t). (mapcount(\n t'.((fst(rev_assoc t' fl) ? flagfn m n flag), t'))A,t)) gl, p);; % GET_ASMS : (string list) -> ((thm list) -> ftactic) -> ftactic GET_ASMS fl ftac fg ---> ftac thl fg where thl is the list of ASSUMEd assumptions in fg flagged by members of fl. % let GET_ASMS (fl:string list) (ftac:(thm list) -> ftactic) fg = let thl = mapfilter (\(flag,t).if mem flag fl then ASSUME t else fail) (fst fg) in ftac thl fg;; % BEGIN_FLAG : string -> goal -> (fgoal list # proof) END_FLAG : fgoal -> (goal list # proof) % let BEGIN_FLAG (flag:string) (g:goal) = ([(mapcount(\n t.(flag++`_`++(string_of_int n),t)) # I)g], (hd:proof));; let END_FLAG (fg:fgoal) = ([(map snd # I) fg], (hd:proof));; % An example: let g = (["x=1";"x=2";"x=3"], "(x=1)\/(x=2)\/(x=3)");; let fgl1,p1 = BEGIN_FLAG `test` g;; let tac flag = BEGIN_FLAG `test` THEN GET_ASMS[flag](\thl.FLAGIFY `` (PURE_REWRITE_TAC thl));; let tac1 = tac `test_1` and tac2 = tac `test_2` and tac3 = tac `test_3`;; tac1 g;; tac2 g;; tac3 g;; let fgl2,p2 = (tac2 THEN (FLAGIFY `` (REWRITE_TAC[]))) g;; %hol88-2.02.19940316/ml/lcf-net.ml0000640000212700021270000002110405071125077014220 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: lcf-net.ml % % % % DESCRIPTION: Nets file from LCF. Currently superceded by % % hol-nets.ml, but containing some code that might be % % usefule if backchaining is ever implemented. % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % ML interface to Lisp-coded ol network functions. These provide the ability to store data indexed by terms or formulas, particularly for simplification. Since "dml" cannot define objects of abstract types, they are defined with type "* list" instead of "* term_net" or "* form_net". This abstract type definition introduces the correct types. Polymorphism works because "* list" involves a type variable. This is a hack but there seems to be no ideal solution. % abstype * term_net = * list with nil_term_net = abs_term_net [] and enter_term (tm,data) tnet = abs_term_net (enter_term_rep (data,tm, rep_term_net tnet)) and lookup_term tnet tm = lookup_term_rep (rep_term_net tnet, tm) and merge_term_nets tnet1 tnet2 = abs_term_net (merge_nets_rep (rep_term_net tnet1, rep_term_net tnet2)) ;; abstype * form_net = * list with nil_form_net = abs_form_net [] and enter_form (fm,data) fnet = abs_form_net (enter_form_rep (data,fm, rep_form_net fnet)) and lookup_form fnet fm = lookup_form_rep (rep_form_net fnet, fm) and merge_form_nets fnet1 fnet2 = abs_form_net (merge_nets_rep (rep_form_net fnet1, rep_form_net fnet2)) ;; % The following is for HOL --- added by MJCG % let nil_form_net = nil_term_net and enter_form = enter_term and lookup_form = lookup_term and merge_form_nets = merge_term_nets;; %beta-conversion, paired with the appropriate pattern% let BETA_CONV2 = "(\x:*.y:**)z", K BETA_CONV;; % Match a given part of "th" to a formula, instantiating "th" The part should be free in the theorem, except for outer bound variables. Returns the pattern used for matching, and a function to match and instantiate the theorem. % let PART_FMATCH2 partfn th = let pth = GSPEC (GEN_ALL th) in let pat = partfn(concl pth) in let match = form_match pat in pat, (\fm. INST_TY_TERM (match fm) pth);; % Match a given part of "th" to a term, instantiating "th" The part should be free in the theorem, except for outer bound variables. % let PART_TMATCH2 partfn th = let pth = GSPEC (GEN_ALL th) in let pat = partfn(concl pth) in let match = term_match pat in pat, (\t. INST_TY_TERM (match t) pth);; % Conversion for implicative rewrites |- !x1 ... xn. A1 ==> ... ==> Am ==> t==u Returns the pattern it matches, for building the net. Proves the instantiated antecedents A1' ... An' using the tactic % let IMP_REW_CONV2 = set_fail_prefix `IMP_REW_CONV` (\irth. %fail if thm has the wrong form% let t,u = (dest_equiv o snd o strip_imp o snd o strip_forall o concl) irth in let pat,matchfn = PART_TMATCH2 (fst o dest_equiv o snd o strip_imp) irth in if (can matchfn u) then failwith `rewriting would loop` else pat, \(tac:tactic) tm. let irth' = matchfn tm in let antel,() = strip_imp (concl irth') in let ANTEL = map (\w. TAC_PROOF ( ([],w), tac )) antel in LIST_MP ANTEL irth');; let IMP_REW_FCONV2 = set_fail_prefix `IMP_REW_FCONV2` (\irth. %fail if thm has the wrong form% let b,c = (dest_iff o snd o strip_imp o snd o strip_forall o concl) irth in let pat, matchfn = PART_FMATCH2 (fst o dest_iff o snd o strip_imp) irth in if can matchfn c then failwith `rewriting would loop` else pat, \(tac:tactic) fm. let irth' = matchfn fm in let antel,() = strip_imp (concl irth') in let thl = map (\w. TAC_PROOF ( ([],w), tac )) antel in LIST_MP thl irth');; %Use the theorem for term rewriting or formula rewriting if possible. Enter it into existing term/formula nets. % let use_rewrite_lemma th (cnet,fcnet) = let can_thl = IMP_CANON th in (rev_itlist enter_term (mapfilter IMP_REW_CONV2 can_thl) cnet, rev_itlist enter_form (mapfilter (IMP_REW_FCONV2 o FCONV_CANON) can_thl) fcnet);; % map_ap x [f1;...;fn] ---> [f1 x;...;fn x] % let map_ap x = map (\f. f x);; %Rather ad-hoc functions for applying conversions stored in nets% let FIRST_NET_CONV cnet tac tm = FIRST_CONV (map_ap tac (lookup_term cnet tm)) tm and FIRST_NET_FCONV fcnet tac fm = FIRST_FCONV (map_ap tac (lookup_form fcnet fm)) fm;; %Main conversion for rewriting formulas. Calls itself recursively to solve implicative rewrites and to introduce local assumptions. % letrec MAIN_REWRITE_FCONV (cnet,fcnet) = letrec tac g = FCONV_TAC fconv g and fconv fm = LOCAL_BASIC_FCONV (FIRST_NET_CONV cnet tac) (FIRST_NET_FCONV fcnet tac) (\th. MAIN_REWRITE_FCONV (use_rewrite_lemma th (cnet,fcnet))) fm in fconv;; %Build discrimination nets containing the rewriting theorems% let build_nets thms = rev_itlist use_rewrite_lemma thms (enter_term BETA_CONV2 nil_term_net, nil_form_net);; %rewrite a formula using a list of theorems% let rewrite_form = MAIN_REWRITE_FCONV o build_nets;; %rewrite a term using a list of theorems% let rewrite_term thms = let cnet,fcnet = build_nets thms in let tac = FCONV_TAC (MAIN_REWRITE_FCONV (cnet,fcnet)) in TOP_DEPTH_CONV (FIRST_NET_CONV cnet tac);; %Added for HOL: "t=t" --> |- (t=t) = T % let REFL_CONV t = (let t1,t2 = dest_eq t in if t1=t2 then EQT_INTRO(REFL t1) else fail ) ? REFL t;; let hol_rewrite_term ths = rewrite_term ths THENC REFL_CONV;; %Added for HOL% let CONV_TAC conv :tactic (asl,w) = let th = conv w in let left,right = dest_eq(concl th) in if right="T" then ([], \[]. EQ_MP (SYM th) TRUTH) else ([asl,right], \[th']. EQ_MP (SYM th) th');; %Rewrite a goal% let REWRITE_TAC = CONV_TAC o hol_rewrite_term;; %Changed for HOL% %Rewrite a goal with the help of its assumptions% let ASM_REWRITE_TAC thl = ASSUM_LIST (\asl. REWRITE_TAC (asl @ thl));; %Added for HOL% let CONV_RULE conv th = EQ_MP (conv(concl th)) th;; %Rewrite a theorem% let REWRITE_RULE = CONV_RULE o hol_rewrite_term;; %Changed for HOL% %Rewrite a theorem with the help of its assumptions% let ASM_REWRITE_RULE thl th = REWRITE_RULE ((map ASSUME (hyp th)) @thl) th;; %Reverse the direction of a term/formula rewrite% let REV_REWRITE th0 = (let [th] = IMP_CANON th0 in let (),conseq = strip_imp (concl th) in if is_equiv conseq then ONCE_DEPTH_CHAIN SYM th else if is_iff conseq then ONCE_DEPTH_CHAIN FSYM th else fail) ? failwith `REV_REWRITE`;; %return the arg if f accepts it, else pass on f's failure% let good_arg f x = (f x; x);; %return a pair of lists: all clauses used as term/formula rewrites. This should give the user some idea of what REWRITE_TAC is doing. % let used_rewrites thl = let can_thl = flat (map IMP_CANON thl) in (mapfilter (good_arg IMP_REW_CONV2) can_thl, mapfilter (good_arg IMP_REW_FCONV2) (mapfilter FCONV_CANON can_thl));; %include the assumptions in the list of potential rewrites% let asm_used_rewrites thl = ASSUM_LIST (\asl. K (used_rewrites (asl @ thl)));; hol88-2.02.19940316/ml/hol-net.ml0000640000212700021270000000613205071125075014240 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: hol-net.ml % % % % DESCRIPTION: HOL version of the ML interface to Lisp-coded ol net- % % work functions. These provide the ability to store % % data indexed by terms, particularly for simplifica- % % tion. % % % % Since "dml" cannot define objects of abstract types, % % they are defined with type "* list" instead of % % "* term_net". This abstract type definition intro- % % duces the correct types. Polymorphism works because % % "* list" involves a type variable. This is a hack but% % there seems to be no ideal solution. % % % % USES FILES: basci-hol lisp files, bool.th, genfns.ml, hol-syn.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % if compiling then (loadf `ml/hol-in-out`);; abstype * term_net = * list with nil_term_net = abs_term_net [] and enter_term (tm,data) tnet = abs_term_net (enter_term_rep (data,tm, rep_term_net tnet)) and lookup_term tnet tm = lookup_term_rep (rep_term_net tnet, tm) and merge_term_nets tnet1 tnet2 = abs_term_net (merge_nets_rep (rep_term_net tnet1, rep_term_net tnet2)) ;; hol88-2.02.19940316/ml/ind.ml0000640000212700021270000002247705071125076013457 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: ind.ml % % % % DESCRIPTION: General induction tactic for recursive types. % % % % AUTHOR: T. F. Melham (87.08.23) % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 1990 % % % % REVISION HISTORY: 90.06.02 % %=============================================================================% begin_section INDUCT_THEN;; % --------------------------------------------------------------------- % % Internal function: % % % % BETAS "f" tm : returns a conversion that, when applied to a term with % % the same structure as the input term tm, will do a % % beta reduction at all top-level subterms of tm which % % are of the form "f ", for some argument . % % % % --------------------------------------------------------------------- % letrec BETAS fn body = if ((is_var body) or (is_const body)) then REFL else if (is_abs body) then ABS_CONV (BETAS fn (snd(dest_abs body))) else let (rt,ra) = dest_comb body in if (rt = fn) then BETA_CONV else let cnv1 = (BETAS fn rt) and cnv2 = (BETAS fn ra) in (MK_COMB o ((cnv1 # cnv2) o dest_comb));; % --------------------------------------------------------------------- % % Internal function: GTAC % % % % !x. tm[x] % % ------------ GTAC "y" (primes the "y" if necessary). % % tm[y] % % % % NB: the x is always a genvar, so optimized for this case. % % --------------------------------------------------------------------- % let GTAC y (A,g) = let x,body = dest_forall g and y' = (variant (freesl (g.A)) y) in [(A,subst[y',x]body)],\[th]. GEN x (INST [(x,y')] th);; % --------------------------------------------------------------------- % % Internal function: TACF % % % % TACF is used to generate the subgoals for each case in an inductive % % proof. The argument tm is formula which states one generalized % % case in the induction. For example, the induction theorem for num is: % % % % |- !P. P 0 /\ (!n. P n ==> P(SUC n)) ==> !n. P n % % % % In this case, the argument tm will be one of: % % % % 1: "P 0" or 2: !n. P n ==> P(SUC n) % % % % TACF applied to each these terms to construct a parameterized tactic % % which will be used to further break these terms into subgoals. The % % resulting tactic takes a variable name x and a user supplied theorem % % continuation ttac. For a base case, like case 1 above, the resulting % % tactic just throws these parameters away and passes the goal on % % unchanged (i.e. \x ttac. ALL_TAC). For a step case, like case 2, the % % tactic applies GTAC x as many times as required. It then strips off % % the induction hypotheses and applies ttac to each one. For example, % % if tac is the tactic generated by: % % % % TACF "!n. P n ==> P(SUC n)" "x:num" ASSUME_TAC % % % % then applying tac to the goal A,"!n. P[n] ==> P[SUC n] has the same % % effect as applying: % % % % GTAC "x:num" THEN DISCH_THEN ASSUME_TAC % % % % TACF is a strictly local function, used only to define TACS, below. % % --------------------------------------------------------------------- % let TACF = letrec ctacs tm = if (is_conj tm) then let tac2 = ctacs (snd(dest_conj tm)) in \ttac. CONJUNCTS_THEN2 ttac (tac2 ttac) else \ttac.ttac in \tm. let vs,body = strip_forall tm in if (is_imp body) then let TTAC = ctacs (fst(dest_imp body)) in \x ttac. MAP_EVERY (GTAC o (K x)) vs THEN DISCH_THEN (TTAC ttac) else \x ttac. ALL_TAC;; % --------------------------------------------------------------------- % % Internal function: TACS % % % % TACS uses TACF to generate a paramterized list of tactics, one for % % each conjunct in the hypothesis of an induction theorem. % % % % For example, if tm is the hypothesis of the induction thoerem for the % % natural numbers---i.e. if: % % % % tm = "P 0 /\ (!n. P n ==> P(SUC n))" % % % % then TACS tm yields the paremterized list of tactics: % % % % \x ttac. [TACF "P 0" x ttac; TACF "!n. P n ==> P(SUC n)" x ttac] % % % % TACS is a strictly local function, used only in INDUCT_THEN. % % --------------------------------------------------------------------- % letrec TACS tm = let cf,csf = ((TACF # TACS) (dest_conj tm) ? TACF tm,K(K[])) in \x ttac. (cf x ttac) . (csf x ttac);; % --------------------------------------------------------------------- % % Internal function: GOALS % % % % GOALS generates the subgoals (and proof functions) for all the cases % % in an induction. The argument A is the common assumption list for all % % the goals, and tacs is a list of tactics used to generate subgoals % % from these goals. % % % % GOALS is a strictly local function, used only in INDUCT_THEN. % % --------------------------------------------------------------------- % letrec GOALS A tacs tm = if (null (tl tacs)) then let sg,pf = (hd tacs) (A,tm) in [sg],[pf] else let c,cs = dest_conj tm in let sgs,pfs = GOALS A (tl tacs) cs in let sg,pf = (hd tacs (A,c)) in sg.sgs,pf.pfs;; % --------------------------------------------------------------------- % % Internal function: GALPH % % % % GALPH "!x1 ... xn. A ==> B": alpha-converts the x's to genvars. % % --------------------------------------------------------------------- % let GALPH = let rule v = let gv = genvar(type_of v) in \eq. let th = FORALL_EQ v eq in TRANS th (GEN_ALPHA_CONV gv (rhs(concl th))) in \tm. let vs,hy = strip_forall tm in if (is_imp hy) then itlist rule vs (REFL hy) else REFL tm;; % --------------------------------------------------------------------- % % Internal function: GALPHA % % % % Applies the conversion GALPH to each conjunct in a sequence. % % --------------------------------------------------------------------- % letrec GALPHA tm = (let c,cs = (GALPH # GALPHA) (dest_conj tm) in MK_COMB((AP_TERM "$/\" c),cs)) ? GALPH tm;; % --------------------------------------------------------------------- % % Internal function: mapshape % % % % Applies the functions in fl to argument lists obtained by splitting % % the list l into sublists of lengths given by nl. % % --------------------------------------------------------------------- % letrec mapshape nl fl l = if null nl then [] else (let m,l = chop_list (hd nl) l in (hd fl)m . mapshape(tl nl)(tl fl)l) ;; % --------------------------------------------------------------------- % % INDUCT_THEN : general induction tactic for concrete recursive types. % % --------------------------------------------------------------------- % let INDUCT_THEN th : (thm_tactic -> tactic) = (let P,hy,_ = (I # dest_imp) (dest_forall (concl th)) in let bconv = BETAS P hy and tacsf = TACS hy in let v = genvar (type_of P) and bv = genvar ":bool" in let eta_th = CONV_RULE(RAND_CONV ETA_CONV) (UNDISCH(SPEC v th)) in let [asm],con = dest_thm eta_th in let dis = ((DISCH asm) eta_th) in let ind = GEN v (SUBST [GALPHA asm,bv] (mk_imp(bv,con)) dis) in (\ttac.\(A,t). (let lam = snd(dest_comb t) in let spec = SPEC lam (INST_TYPE (snd(match v lam)) ind) in let an,sp = dest_imp(concl spec) in let beta = SUBST [bconv an,bv] (mk_imp(bv,sp)) spec in let tacs = tacsf (fst(dest_abs lam)) ttac in let gll,pl = GOALS A tacs (fst(dest_imp(concl beta))) in let pf = ((MP beta) o LIST_CONJ) o mapshape(map length gll)pl in (flat gll, pf)) ? failwith `INDUCT_THEN`)) ? failwith `INDUCT_THEN: ill-formed induction theorem`;; % Bind INDUCT_THEN to "it", so as to export it outside the section. % INDUCT_THEN;; end_section INDUCT_THEN;; % Save the exported value. % let INDUCT_THEN = it;; hol88-2.02.19940316/ml/abs-rep.ml0000640000212700021270000002537605071125073014234 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: abs-rep.ml % % % % DESCRIPTION: Defines derived inference rules for automatic % % definition of abstraction and representation % % functions for defined logical types. % % % % AUTHOR: T. F. Melham (87.02.26) % % % % USES FILES: basic-hol lisp files, BASIC-HOL.th, genfns.ml, % % hol-syn.ml, hol-rule.ml, hol-drule.ml, drul.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: 90.04.10 % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of certain HOL inference rules. So % % load hol-rule.ml and hol-drule.ml. For this, we need hol-in-out. And % % this loads genfns.ml and hol-syn.ml too (which are also needed). The % % HOL term parser is also loaded (and needed). % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`);; % Fetch ABS_REP_THM. % let ABS_REP_THM = theorem `BASIC-HOL` `ABS_REP_THM`;; % --------------------------------------------------------------------- % % NAME: define_new_type_bijections % % % % DESCRIPTION: define isomorphism constants based on a type definition. % % % % USAGE: define_new_type_bijections name ABS REP tyax % % % % ARGUMENTS: tyax -- a type-defining axiom of the form returned by % % new_type_definition. For example: % % % % ?rep. TYPE_DEFINITION P rep % % % % ABS --- the name of the required abstraction function % % % % REP --- the name of the required representation function % % % % name --- the name under which the definition is stored % % % % SIDE EFFECTS: Introduces a definition for two constants "ABS" and % % "REP" by the constant specification: % % % % |- ?ABS REP. (!a. ABS(REP a) = a) /\ % % (!r. P r = (REP(ABS r) = r) % % % % The resulting constant specification is stored under % % the name given as the first argument. % % % % FAILURE: if 1) ABS or REP are already constants. % % 2) not in draft mode. % % 3) input theorem of wrong form. % % % % RETURNS: The defining property of the representation and abstraction % % functions, given by: % % % % |- (!a. ABS(REP a) = a) /\ (!r. P r = (REP(ABS r) = r) % % --------------------------------------------------------------------- % let define_new_type_bijections name ABS REP tyax = if (not(draft_mode())) then failwith `not in draft mode` else if is_axiom (current_theory(),name) then failwith `"` ^ name ^ `" already an axiom or definition` else if not(null (hyp tyax)) then failwith `input theorem must have no assumptions` else if (is_constant ABS) then failwith ABS ^ ` is already a constant` else if (is_constant REP) then failwith REP ^ ` is already a constant` else ((let _,[P;rep] = strip_comb(snd(dest_exists(concl tyax))) in let _,[aty;rty] = dest_type(type_of rep) in let eth = MP (SPEC P (INST_TYPE[aty,":**";rty,":*"]ABS_REP_THM)) tyax in new_specification name [`constant`,REP;`constant`,ABS] eth) ? failwith `define_new_type_bijections`);; % --------------------------------------------------------------------- % % NAME: prove_rep_fn_one_one % % % % DESCRIPTION: prove that a type representation function is one-to-one. % % % % USAGE: if th is a theorem of the kind returned by the ML function % % define_new_type_bijections: % % % % |- (!a. ABS(REP a) = a) /\ (!r. P r = (REP(ABS r) = r) % % % % then prove_rep_fn_one_one th will prove and return a theorem % % stating that the representation function REP is one-to-one: % % % % |- !a a'. (REP a = REP a') = (a = a') % % % % --------------------------------------------------------------------- % let prove_rep_fn_one_one th = (let thm = CONJUNCT1 th in let A,R = (I # rator) (dest_comb(lhs(snd(dest_forall(concl thm))))) in let _,[aty;rty] = dest_type (type_of R) in let a = mk_primed_var(`a`,aty) in let a' = variant [a] a in let a_eq_a' = mk_eq(a,a') and Ra_eq_Ra' = mk_eq(mk_comb(R,a),mk_comb (R,a')) in let th1 = AP_TERM A (ASSUME Ra_eq_Ra') in let ga1 = genvar aty and ga2 = genvar aty in let th2 = SUBST [SPEC a thm,ga1;SPEC a' thm,ga2] (mk_eq(ga1,ga2)) th1 in let th3 = DISCH a_eq_a' (AP_TERM R (ASSUME a_eq_a')) in GEN a (GEN a' (IMP_ANTISYM_RULE (DISCH Ra_eq_Ra' th2) th3))) ? failwith `prove_rep_fn_one_one`;; % --------------------------------------------------------------------- % % NAME: prove_rep_fn_onto % % % % DESCRIPTION: prove that a type representation function is onto. % % % % USAGE: if th is a theorem of the kind returned by the ML function % % define_new_type_bijections: % % % % |- (!a. ABS(REP a) = a) /\ (!r. P r = (REP(ABS r) = r) % % % % then prove_rep_fn_onto th will prove and return a theorem % % stating that the representation function REP is onto: % % % % |- !r. P r = (?a. r = REP a) % % % % --------------------------------------------------------------------- % let prove_rep_fn_onto th = (let [th1;th2] = CONJUNCTS th in let r,eq = (I # rhs)(dest_forall(concl th2)) in let RE,ar = dest_comb(lhs eq) and sr = (mk_eq o (\x,y.y,x) o dest_eq) eq in let a = mk_primed_var (`a`,type_of ar) in let sra = mk_eq(r,mk_comb(RE,a)) in let ex = mk_exists(a,sra) in let imp1 = EXISTS (ex,ar) (SYM(ASSUME eq)) in let v = genvar (type_of r) and A = rator ar and as = AP_TERM RE (SPEC a th1) in let th = SUBST[SYM(ASSUME sra),v](mk_eq(mk_comb(RE,mk_comb(A,v)),v))as in let imp2 = CHOOSE (a,ASSUME ex) th in let swap = IMP_ANTISYM_RULE (DISCH eq imp1) (DISCH ex imp2) in GEN r (TRANS (SPEC r th2) swap)) ? failwith `prove_rep_fn_onto`;; % --------------------------------------------------------------------- % % NAME: prove_abs_fn_onto % % % % DESCRIPTION: prove that a type absstraction function is onto. % % % % USAGE: if th is a theorem of the kind returned by the ML function % % define_new_type_bijections: % % % % |- (!a. ABS(REP a) = a) /\ (!r. P r = (REP(ABS r) = r) % % % % then prove_abs_fn_onto th will prove and return a theorem % % stating that the abstraction function ABS is onto: % % % % |- !a. ?r. (a = ABS r) /\ P r % % % % --------------------------------------------------------------------- % let prove_abs_fn_onto th = (let [th1;th2] = CONJUNCTS th in let a,A,R = (I#((I#rator)o dest_comb o lhs))(dest_forall(concl th1)) in let thm1 = EQT_ELIM(TRANS (SPEC (mk_comb (R,a)) th2) (EQT_INTRO (AP_TERM R (SPEC a th1)))) in let thm2 = SYM(SPEC a th1) in let r,P = (I # (rator o lhs)) (dest_forall(concl th2)) in let ex = mk_exists(r,mk_conj(mk_eq(a,mk_comb(A,r)),mk_comb(P,r))) in GEN a (EXISTS(ex,mk_comb(R,a)) (CONJ thm2 thm1))) ? failwith `prove_abs_fn_onto`;; % --------------------------------------------------------------------- % % NAME: prove_abs_fn_one_one % % % % DESCRIPTION: prove that a type abstraction function is one-to-one. % % % % USAGE: if th is a theorem of the kind returned by the ML function % % define_new_type_bijections: % % % % |- (!a. ABS(REP a) = a) /\ (!r. P r = (REP(ABS r) = r) % % % % then prove_abs_fn_one_one th will prove and return a theorem % % stating that the abstraction function ABS is one-to-one: % % % % |- !r r'. P r ==> % % P r' ==> % % (ABS r = ABS r') ==> (r = r') % % % % --------------------------------------------------------------------- % let prove_abs_fn_one_one th = (let [th1;th2] = CONJUNCTS th in let r,P = (I # (rator o lhs)) (dest_forall(concl th2)) and A,R = (I # rator) (dest_comb(lhs(snd(dest_forall(concl th1))))) in let r' = variant [r] r in let as1 = ASSUME(mk_comb(P,r)) and as2 = ASSUME(mk_comb(P,r')) in let t1 = EQ_MP (SPEC r th2) as1 and t2 = EQ_MP (SPEC r' th2) as2 in let eq = (mk_eq(mk_comb(A,r),mk_comb(A,r'))) in let v1 = genvar(type_of r) and v2 = genvar(type_of r) in let i1 = DISCH eq (SUBST [t1,v1;t2,v2] (mk_eq(v1,v2)) (AP_TERM R (ASSUME eq))) and i2 = DISCH (mk_eq(r,r')) (AP_TERM A (ASSUME (mk_eq(r,r')))) in let thm = IMP_ANTISYM_RULE i1 i2 in let disch = DISCH (mk_comb(P,r)) (DISCH (mk_comb(P,r')) thm) in GEN r (GEN r' disch)) ? failwith `prove_abs_fn_one_one`;; hol88-2.02.19940316/ml/READ-ME0000640000212700021270000000040304610714365013274 0ustar cammcamm+ ===================================================================== + | HOL DISTRIBUTION DIRECTORY: ml | + ===================================================================== + This directory contains all the ML source code used in the HOL system. hol88-2.02.19940316/ml/site.ml.orig0000640000212700021270000000422605071125102014566 0ustar cammcamm%=============================================================================% % HOL 88 % % % % FILE NAME: site.ml.orig % % % % DESCRIPTION: Source file for site dependent information % % % % USES FILES: hol-lcf lisp files % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % VERSION: 2.0 % % REVISION HISTORY: 91.02.24 TFM % %=============================================================================% % Must be compiled when other ml sources are compiled % let concat tok1 tok2 = implode( explode tok1 @ explode tok2);; let ml_dir_pathname = `ml/`;; let lisp_dir_pathname = `lisp/`;; % No longer needed. [TFM 91.02.24] % % let theories_dir_pathname = `theories/`;; % hol88-2.02.19940316/ml/list.ml0000640000212700021270000013352705524755450013667 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: list.ml % % % % DESCRIPTION: Defined procedures for list induction and definition % % by primitive recursion on lists. Derived inference % % rules for reasoning about lists. % % % % The induction/primitive recursion are really only for % % compatibility with old HOL. % % % % AUTHOR: T. F. Melham (87.05.30) % % W. Wong (31 Jan 94) % % % % USES FILES: ind.ml, prim_rec.ml, numconv.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 1990 % % % % REVISION HISTORY: 90.09.08 % %=============================================================================% if compiling then (loadf `../ml/ind`; loadf `../ml/prim_rec`; loadf `../ml/numconv`; loadf `../ml/num`);; % --------------------------------------------------------------------- % % LIST_INDUCT: (thm # thm) -> thm % % % % A1 |- t[[]] A2 |- !tl. t[tl] ==> !h. t[CONS h t] % % ---------------------------------------------------------- % % A1 u A2 |- !l. t[l] % % % % --------------------------------------------------------------------- % let LIST_INDUCT = let list_INDUCT = theorem `list` `list_INDUCT` in \(base,step). (let (tl,body) = dest_forall(concl step) in let (asm,h,con) = (I # dest_forall) (dest_imp body) in let P = "\^tl.^asm" and b1 = genvar bool_ty and b2 = genvar bool_ty in let base' = EQ_MP (SYM(BETA_CONV "^P []")) base and step' = DISCH asm (SPEC h (UNDISCH(SPEC tl step))) and hypth = SYM(RIGHT_BETA(REFL "^P ^tl")) and concth = SYM(RIGHT_BETA(REFL "^P(CONS ^h ^tl)")) and IND = SPEC P (INST_TYPE [type_of h,":*"] list_INDUCT) in let th1 = SUBST [hypth,b1;concth,b2] "^(concl step') = (^b1 ==> ^b2)" (REFL (concl step')) in let th2 = GEN tl (DISCH "^P ^tl" (GEN h(UNDISCH (EQ_MP th1 step')))) in let th3 = SPEC tl (MP IND (CONJ base' th2)) in GEN tl (EQ_MP (BETA_CONV(concl th3)) th3))?failwith `LIST_INDUCT`;; % --------------------------------------------------------------------- % % % % LIST_INDUCT_TAC % % % % [A] !l.t[l] % % ================================ % % [A] t[[]], [A,t[l]] !h. t[CONS h t] % % % % --------------------------------------------------------------------- % let LIST_INDUCT_TAC = let list_INDUCT = theorem `list` `list_INDUCT` in INDUCT_THEN list_INDUCT ASSUME_TAC;; % --------------------------------------------------------------------- % % % % SNOC_INDUCT_TAC % % % % [A] !l.t[l] % % ================================ % % [A] t[[]], [A,t[l]] !h. t[SNOC x t] % % % % --------------------------------------------------------------------- % let SNOC_INDUCT_TAC = let SNOC_INDUCT = theorem `list` `SNOC_INDUCT` in INDUCT_THEN SNOC_INDUCT ASSUME_TAC;; % ------------------------------------------------------------------------- % % EQ_LENGTH_INDUCT_TAC : tactic % % A ?- !l1 l2. (LENGTH l1 = LENGTH l2) ==> t[l1, l2] % % ==================================================== EQ_LENGTH_INDUCT_TAC % % A ?- t[ []/l1, []/l2 ] % % A,LENGTH l1 = LENGTH l2 ?- t[(CONS h l1)/l1,(CONS h' l2)/l2] % % ------------------------------------------------------------------------- % let EQ_LENGTH_INDUCT_TAC = let SUC_NOT = theorem `arithmetic` `SUC_NOT` and NOT_SUC = theorem `num` `NOT_SUC` and INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ` and LENGTH = definition `list` `LENGTH` in LIST_INDUCT_TAC THENL[ LIST_INDUCT_TAC THENL[ REPEAT (CONV_TAC FORALL_IMP_CONV) THEN DISCH_THEN (\t.ALL_TAC); REWRITE_TAC[LENGTH;SUC_NOT]]; GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_SUC;INV_SUC_EQ] THEN GEN_TAC THEN REPEAT (CONV_TAC FORALL_IMP_CONV) THEN DISCH_TAC];; % ------------------------------------------------------------------------- % % EQ_LENGTH_SNOC_INDUCT_TAC : tactic % % A ?- !l1 l2.(LENGTH l1 = LENGTH l2) ==> t[l1,l2] % % =============================================== EQ_LENGTH_SNOC_INDUCT_TAC % % A ?- t[ []/l1, []/l2 ] % % A,LENGHT l1 = LENGTH l2 ?- t[(SNOC h l1)/l1,(SNOC h' l2)/l2] % % ------------------------------------------------------------------------- % let EQ_LENGTH_SNOC_INDUCT_TAC = let SUC_NOT = theorem `arithmetic` `SUC_NOT` and NOT_SUC = theorem `num` `NOT_SUC` and INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ` and LENGTH = definition `list` `LENGTH` and LENGTH_SNOC = theorem `list` `LENGTH_SNOC` in SNOC_INDUCT_TAC THENL[ SNOC_INDUCT_TAC THENL[ REPEAT (CONV_TAC FORALL_IMP_CONV) THEN DISCH_THEN (\t.ALL_TAC); REWRITE_TAC[LENGTH;LENGTH_SNOC;SUC_NOT]]; GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;NOT_SUC;INV_SUC_EQ] THEN GEN_TAC THEN REPEAT (CONV_TAC FORALL_IMP_CONV) THEN DISCH_TAC];; % --------------------------------------------------------------------- % % Definition by primitive recursion for lists % % (For compatibility of new/old HOL.) % % --------------------------------------------------------------------- % let new_list_rec_definition = let list_Axiom = theorem `list` `list_Axiom` in \(name,tm). new_recursive_definition false list_Axiom name tm;; let new_infix_list_rec_definition = let list_Axiom = theorem `list` `list_Axiom` in \(name,tm). new_recursive_definition true list_Axiom name tm;; % --------------------------------------------------------------------- % % LENGTH_CONV: compute the length of a list % % % % A call to LENGTH_CONV "LENGTH[x1;...;xn]" returns: % % % % |- LENGTH [x1;...;xn] = n where n is a numeral constant % % --------------------------------------------------------------------- % let LENGTH_CONV = let LEN = definition `list` `LENGTH` in let dcons tm = snd(((\c.fst(dest_const c)=`CONS`) # I)(strip_comb tm)) in let cend tm = (fst(dest_const tm) = `NIL` => [] | fail) in letrec stripl tm = (let [h;t] = dcons tm in (h . stripl t)) ? cend tm in let SUC = let suctm = "SUC" and numty = ":num" in \(i,th). let n = mk_const(string_of_int i,numty) in TRANS (AP_TERM suctm th) (SYM(num_CONV n)) in let itfn cth h (i,th) = i+1,TRANS (SPEC (rand(lhs(concl th))) (SPEC h cth)) (SUC (i,th)) in let check = assert(curry $= `LENGTH` o fst o dest_const) in \tm. (let _,[ty] = dest_type(type_of (snd((check # I)(dest_comb tm)))) in let nil,cons = CONJ_PAIR (INST_TYPE [ty,":*"] LEN) in snd(itlist (itfn cons) (stripl (rand tm)) (1,nil))) ? failwith `LENGTH_CONV`;; % --------------------------------------------------------------------- % % list_EQ_CONV: equality of lists. % % % % This conversion proves or disproves the equality of two lists, given % % a conversion for deciding the equality of elements. % % % % A call to: % % % % list_EQ_CONV conv "[x1;...;xn] = [y1;...;ym]" % % % % returns: % % % % |- ([x1;...;xn] = [y1;...;ym]) = F % % % % if: % % % % 1: ~(n=m) or 2: conv proves |- (xi = yi) = F for any 1<=i<=n,m % % % % and: % % % % |- ([x1;...;xn] = [y1;...;ym]) = T % % % % if: % % % % 1: (n=m) and xi is syntactically identical to yi for 1<=i<=n,m, or % % 2: (n=m) and conv proves |- (xi=yi)=T for 1<=i<=n,m % % --------------------------------------------------------------------- % let list_EQ_CONV = let T = "T" and F = "F" in let cnil = theorem `list` `NOT_CONS_NIL` in let lne = theorem `list` `LIST_NOT_EQ` in let nel = theorem `list` `NOT_EQ_LIST`in let leq = theorem `list` `EQ_LIST` in let dcons tm = snd(((\c.fst(dest_const c)=`CONS`) # I)(strip_comb tm)) in let cend tm = (fst(dest_const tm) = `NIL` => [] | fail) in letrec stripl tm = (let [h;t] = dcons tm in (h . stripl t)) ? cend tm in let Cons ty = let lty = mk_type(`list`,[ty]) in let cty = mk_type(`fun`,[ty;mk_type(`fun`,[lty;lty])]) in \h t. mk_comb(mk_comb(mk_const(`CONS`,cty),h),t) in let Nil ty = let lty = mk_type(`list`,[ty]) in mk_const(`NIL`,lty) in letrec split n l = if (n=0) then [],l else ((curry $. (hd l)) # I)(split (n-1) (tl l)) in let itfn cnv [leq;lne;nel] (h1,h2) th = if (is_neg (concl th)) then let l1,l2 = dest_eq(dest_neg (concl th)) in SPEC h2 (SPEC h1 (MP (SPEC l2 (SPEC l1 lne)) th)) else let l1,l2 = dest_eq(concl th) in let heq = cnv (mk_eq(h1,h2)) in if (rand(concl heq) = T) then let th1 = MP (SPEC h2 (SPEC h1 leq)) (EQT_ELIM heq) in MP (SPEC l2 (SPEC l1 th1)) th else let th1 = MP (SPEC h2 (SPEC h1 nel)) (EQF_ELIM heq) in SPEC l2 (SPEC l1 th1) in \cnv tm. (let l1,l2 = (stripl # stripl) (dest_eq tm) in if (l1=l2) then EQT_INTRO(REFL (rand tm)) else let _,[ty] = dest_type(type_of(rand tm)) in let n = length l1 and m = length l2 in let thms = map (INST_TYPE [ty,":*"]) [leq;lne;nel] in let ifn = itfn cnv thms in if (n |- FOLDR f e [a0;...an] = tm FOLDR_CONV evaluates the input expression by iteratively apply the function f the successive element of the list starting from the end of the list. tm is the result of the calculation. FOLDR_CONV returns a theorem stating this fact. During each iteration, an expression "f e' ai" is evaluated. The user supplied conversion conv is used to derive a theorem |- f e' ai = e'' which is then used to reduce the expression to e''. For example, #FOLDR_CONV conv "FOLDR ^f 0 ([x0;x1;x2;x3;x4;x5]:* list)";; |- FOLDR(\x l'. SUC l')0[x0;x1;x2;x3;x4;x5] = 6 where f = (\x l'. SUC l') and conv = ((RATOR_CONV BETA_CONV) THENC BETA_CONV THENC SUC_CONV)) In general, if the function f is an explicit lambda abstraction (\x x'. t[x,x']), the conversion should be in the form ((RATOR_CONV BETA_CONV) THENC BETA_CONV THENC conv')) where conv' applied to t[x,x'] returns the theorem |-t[x,x'] = e''. -% let FOLDR_CONV = let (bthm,ithm) = CONJ_PAIR (definition `list` `FOLDR`) in \conv tm. let (_,[f;e;l]) = ((check_const`FOLDR`)#I)(strip_comb tm) in let ithm' = ISPECL[f;e] ithm in let (els,lty) = (dest_list l) in let itfn a th = let [f';e';l'] = snd(strip_comb(lhs(concl th))) in let lem = SUBS [th](SPECL[a;l'] ithm') in TRANS lem (conv (rhs (concl lem))) in (itlist itfn els (ISPECL [f;e] bthm)) ?\s failwith (`FOLDR_CONV: `^s);; %----------------------------------------------------------------% %- FOLDL_CONV conv "FOLDL f e [a0;...an]" ---> |- FOLDL f e [a0;...an] = tm FOLDL_CONV evaluates the input expression by iteratively apply the function f the successive element of the list starting from the head of the list. tm is the result of the calculation. FOLDL_CONV returns a theorem stating this fact. During each iteration, an expression "f e' ai" is evaluated. The user supplied conversion conv is used to derive a theorem |- f e' ai = e'' which is then used to reduce the expression to e''. For example, #FOLDL_CONV conv "FOLDL ^f 0 ([x0;x1;x2;x3;x4;x5]:* list)";; |- FOLDL(\l' x. SUC l')0[x0;x1;x2;x3;x4;x5] = 6 where f = (\l' x. SUC l') and conv = ((RATOR_CONV BETA_CONV) THENC BETA_CONV THENC SUC_CONV)) In general, if the function f is an explicit lambda abstraction (\x x'. t[x,x']), the conversion should be in the form ((RATOR_CONV BETA_CONV) THENC BETA_CONV THENC conv')) where conv' applied to t[x,x'] returns the theorem |-t[x,x'] = e''. -% let FOLDL_CONV = let (bthm,ithm) = CONJ_PAIR (definition `list` `FOLDL`) in \conv tm. let (_,[f;e;l]) = ((check_const `FOLDL`)#I)(strip_comb tm) in let ithm' = ISPEC f ithm in letrec itfn (term) = let (_,[f;e;l]) = strip_comb term in if (is_const l) then let (nil,_) = dest_const l in if not(nil = `NIL`) then failwith `expecting null list` else (ISPECL[f;e]bthm) else let [h;t] = snd(strip_comb l) in let th = ISPECL[e;h;t] ithm' in let lem = CONV_RULE ((RAND_CONV o RATOR_CONV o RAND_CONV) conv) th in (TRANS lem (itfn (rhs(concl lem)))) in (itfn tm) ?\s failwith (`FOLDL_CONV: `^s);; % --------------------------------------------------------------------- % % list_FOLD_CONV : thm -> conv -> conv % % list_FOLD_CONV foldthm conv tm % % where canme is the name of constant and foldthm is a theorem of the % % the following form: % % |- !x0 ... xn. CONST x0 ... xn = FOLD[LR] f e l % % and conv is a conversion which will be passed to FOLDR_CONV or % % FOLDL_CONV to reduce the right-hand side of the above theorem % % --------------------------------------------------------------------- % let list_FOLD_CONV = \foldthm conv tm. (let (cname,args) = (strip_comb tm) in let fthm = ISPECL args foldthm in let left,right = (dest_eq(concl fthm)) in let const = fst(strip_comb left) in let f = fst(dest_const(fst(strip_comb right))) in if not(cname = const) then failwith `theorem and term are different` else if (f = `FOLDL`) then TRANS fthm (FOLDL_CONV conv right) else if (f = `FOLDR`) then TRANS fthm (FOLDR_CONV conv right) else failwith `not FOLD theorem`) ?\s failwith (`list_FOLD_CONV: `^s);; let SUM_CONV = list_FOLD_CONV (theorem `list` `SUM_FOLDR`) ADD_CONV;; %----------------------------------------------------------------% %- Filter -% %- FILTER_CONV conv "FILTER P [a0;...an]" ---> |- FILTER P [a0,...;an] = [...;ai;...] where conv "P ai" returns a theorem |- P ai = T for all ai in the resulting list. -% let FILTER_CONV = let (bth,ith) = CONJ_PAIR (definition `list` `FILTER`) in \conv tm. (let (_,[P;l]) = ((check_const `FILTER`) # I) (strip_comb tm) in let bth' = ISPEC P bth and ith' = ISPEC P ith in let lis = fst(dest_list l) in let ffn x th = let (left,right) = dest_eq(concl th) in let (_,[p;ls]) = strip_comb left in let fthm = SPECL [x;ls] ith' and cthm = conv "^P ^x" in (CONV_RULE (RAND_CONV COND_CONV) (SUBS[cthm;th]fthm)) in (itlist ffn lis bth')) ?\s failwith (`FILTER_CONV: `^s);; %----------------------------------------------------------------% %- SNOC_CONV : conv SNOC_CONV "SNOC x [x0;...xn]" ---> |- SNOC x [x0;...xn] = [x0;...;xn;x] -% %----------------------------------------------------------------% let SNOC_CONV = let bthm,sthm = CONJ_PAIR (definition `list` `SNOC`) in \tm. (let _,[d;lst] = ((check_const `SNOC`) # I) (strip_comb tm) in let ty = type_of lst in let lst',ety = (dest_list lst) in let EMP = "[]:^ty" and CONS = "CONS:^ety -> ^ty ->^ty" in let itfn x (lst,ithm) = mk_comb(mk_comb(CONS,x),lst), (SUBS[ithm](ISPECL[d;x;lst]sthm)) in snd(itlist itfn lst' (EMP,(ISPEC d bthm)))) ?\s failwith(`SNOC_CONV: `^s);; %----------------------------------------------------------------% %- REVERSE_CONV : conv REVERSE_CONV "REVERSE [x0;...;xn]" ---> |- REVERSE [x0;...;xn] = [xn;...;x0] -% %----------------------------------------------------------------% let REVERSE_CONV = let fthm = theorem `list` `REVERSE_FOLDL` in let conv = ((RATOR_CONV BETA_CONV) THENC BETA_CONV) in \tm. (let _,lst = ((check_const `REVERSE`) # I) (dest_comb tm) in let fthm' = ISPEC lst fthm in TRANS fthm' (FOLDL_CONV conv (rhs(concl fthm')))) ?\s failwith (`REVERSE_CONV: `^s);; %----------------------------------------------------------------% %- FLAT_CONV : conv FLAT_CONV "FLAT [[x00;...;x0n];...;[xm0;...xmn]]" ---> |- "FLAT [[x00;...;x0n];...;[xm0;...xmn]]" = [x00;...;x0n;...;xm0;...xmn] -% %----------------------------------------------------------------% let FLAT_CONV = let lem = PROVE("APPEND = (\x1 x2:* list. APPEND x1 x2)", CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN REFL_TAC) in let ffthm = theorem `list` `FLAT_FOLDR` in let afthm = theorem `list` `APPEND_FOLDR` in let fthm = REWRITE_RULE[afthm](SUBS[lem] ffthm) in let conv = (RAND_CONV (FOLDR_CONV ((RATOR_CONV BETA_CONV) THENC BETA_CONV THENC (FOLDR_CONV ALL_CONV)))) in \tm. (let _,lst = ((check_const `FLAT`) # I) (dest_comb tm) in let fthm' = ISPEC lst fthm in CONV_RULE conv fthm') ?\s failwith (`FLAT_CONV: `^s);; %-----------------------------------------------------------------------% % EL_CONV : conv % % The argument to this conversion should be in the form of % % "EL k [x0; x1; ...; xk; ...; xn]" % % It returns a theorem % % |- EL k [x0; x1; ...; xk; ...; xn] = xk % % iff 0 <= k <= n, otherwise failure occurs. % %-----------------------------------------------------------------------% let EL_CONV = let bthm,ithm = CONJ_PAIR (definition `list` `EL`) in let HD = definition `list` `HD` and TL = definition `list``TL` in let dec n = let nn = int_of_term n in mk_const(string_of_int(nn - 1), ":num") in let tail lst = hd(tl(snd(strip_comb lst))) in let iter ct N bits = letref n',m',lst' = ct-1, (dec N), (tail bits) in letref sthm = PURE_ONCE_REWRITE_RULE[TL](ISPECL [bits; m'] ithm) in if (n' = 0) then (TRANS sthm (SUBS[ISPECL(snd(strip_comb lst'))HD](ISPEC lst' bthm))) loop (n' := n' -1; sthm := TRANS (RIGHT_CONV_RULE(RATOR_CONV(RAND_CONV num_CONV)) sthm) (SUBS[ISPECL(snd(strip_comb lst'))TL](ISPECL[lst';(dec m')] ithm)); lst' := tail lst'; m' := dec m') in \tm. (let _,[N;bits] = ((check_const `EL`) # I) (strip_comb tm) in let n = int_of_term N in let lst = bits and m = N in if (n = 0) then (PURE_ONCE_REWRITE_RULE[HD](ISPEC bits bthm)) else if (n < length(fst(dest_list bits))) then (SUBS [SYM (num_CONV N)](iter n N bits)) else failwith `index too large` )?\s failwith(`EL_CONV: `^s);; %-----------------------------------------------------------------------% % ELL_CONV : conv % % It takes a term of the form "ELL k [x(n-1); ... x0]" and returns % % |- ELL k [x(n-1); ...; x0] = x(k) % %-----------------------------------------------------------------------% let ELL_CONV = let bthm = theorem `list` `ELL_0_SNOC` and ithm = theorem `list` `ELL_SUC_SNOC` in let iter count (d,lst) elty = letref n = count and x = d and l = lst in letref th = (ISPECL[(term_of_int n); x; mk_list(l,elty)]ithm) in if (n = 0) then (x := last l; l := butlast l; (th := TRANS th (CONV_RULE ((RATOR_CONV o RAND_CONV o RAND_CONV) SNOC_CONV) (ISPECL [mk_list(l,elty);x] bthm)))) loop (n := n - 1; x := (last l); l := butlast l; th := TRANS (RIGHT_CONV_RULE ((RATOR_CONV o RAND_CONV) num_CONV) th) (CONV_RULE ((RATOR_CONV o RAND_CONV o RAND_CONV)SNOC_CONV) (ISPECL[(term_of_int n); x; mk_list(l,elty)]ithm))) in \tm. (let _,[N;lst] = ((check_const`ELL`) # I)(strip_comb tm) in let ty = type_of lst in let lst',ety = (dest_list lst) in let n = int_of_term N in if not(n < (length lst')) then failwith `index too large` else if (n = 0) then (CONV_RULE ((RATOR_CONV o RAND_CONV o RAND_CONV)SNOC_CONV) (ISPECL[mk_list(butlast lst', ety);(last lst')]bthm)) else SUBS_OCCS[[1],(SYM (num_CONV N))] (CONV_RULE ((RATOR_CONV o RAND_CONV o RAND_CONV)SNOC_CONV) (iter (n - 1) ((last lst'), (butlast lst')) ety))) ?\s failwith(`ELL_CONV: `^s);; % --------------------------------------------------------------------- % % MAP2_CONV conv "MAP2 f [x1;...;xn] [y1;...;yn]" % % % % Returns |- MAP2 f [x1;...;xn] [y1;...;yn] = [r1;...;rn] % % where conv "f xi yi" returns |- f xi yi = ri for 1 <= i <= n % % --------------------------------------------------------------------- % let MAP2_CONV = let mn,mc = CONJ_PAIR(definition `list` `MAP2`) in \conv tm. (let _,[fn;l1;l2] = ((check_const`MAP2`) # I) (strip_comb tm) in let el1s,ty1 = dest_list l1 and el2s,ty2 = dest_list l2 in let els = combine (el1s,el2s) in let nth = ISPEC fn mn and cth = ISPEC fn mc in let cns = rator(rator(rand(snd(strip_forall(concl cth))))) in let itfn (e1,e2) th = let _,[f;t1;t2] = strip_comb(lhs(concl th)) in let th1 = SPECL [e1; t1; e2; t2] cth in let r = conv (mk_comb(mk_comb(fn,e1),e2)) in (SUBS[r;th]th1) in itlist itfn els nth) ?\s failwith (`MAP2_CONV: `^s);; % --------------------------------------------------------------------- % % ALL_EL_CONV : conv -> conv % % ALL_EL_CONV conv "ALL_EL P [x0;...;xn]" ---> % % |- ALL_EL P [x0;...;xn] = T iff conv "P xi"---> |- P xi = T for all i % % |- ALL_EL P [x0;...;xn] = F otherwise % % --------------------------------------------------------------------- % let ALL_EL_CONV = let bth,ith = CONJ_PAIR (definition `list` `ALL_EL`) in let AND_THM = setify(flat(map (CONJ_LIST 5) [(SPEC "T" AND_CLAUSES);(SPEC "F" AND_CLAUSES)])) in \conv tm. (let (_,[P;l]) = ((check_const`ALL_EL`) # I)(strip_comb tm) in let bth' = ISPEC P bth and ith' = ISPEC P ith in let lis = fst(dest_list l) in let ffn x th = let (left,right) = dest_eq(concl th) in let (_,[p;ls]) = strip_comb left in let fthm = SPECL [x;ls] ith' and cthm = conv "^P ^x" in SUBS AND_THM (SUBS[cthm;th]fthm) in (itlist ffn lis bth')) ?\s failwith (`ALL_EL_CONV: `^s);; % --------------------------------------------------------------------- % % SOME_EL_CONV : conv -> conv % % SOME_EL_CONV conv "SOME_EL P [x0;...;xn]" ---> % % |- SOME_EL P [x0;...;xn] = F iff conv "P xi"---> |- P xi = F for all i% % |- SOME_EL P [x0;...;xn] = F otherwise % % --------------------------------------------------------------------- % let SOME_EL_CONV = let bth,ith = CONJ_PAIR (definition `list` `SOME_EL`) in let OR_THM = setify(flat(map (CONJ_LIST 5) [(SPEC "T" OR_CLAUSES);(SPEC "F" OR_CLAUSES)])) in \conv tm. (let (_,[P;l]) = ((check_const`SOME_EL`) # I)(strip_comb tm) in let bth' = ISPEC P bth and ith' = ISPEC P ith in let lis = fst(dest_list l) in let ffn x th = let (left,right) = dest_eq(concl th) in let (_,[p;ls]) = strip_comb left in let fthm = SPECL [x;ls] ith' and cthm = conv "^P ^x" in SUBS OR_THM (SUBS[cthm;th]fthm) in (itlist ffn lis bth')) ?\s failwith (`SOME_EL_CONV: `^s);; % --------------------------------------------------------------------- % % IS_EL_CONV : conv -> conv % % IS_EL_CONV conv "IS_EL P [x0;...;xn]" ---> % % |- IS_EL x [x0;...;xn] = T iff conv "x = xi" ---> % % |- (x = xi) = F for an i % % |- IS_EL x [x0;...;xn] = F otherwise % % --------------------------------------------------------------------- % let IS_EL_CONV = let bth = (definition `list` `IS_EL_DEF`) in \conv tm. (let (_,[x;l]) = ((check_const`IS_EL`) # I)(strip_comb tm) in let bth' = ISPECL[x;l] bth in let right = rhs (concl bth') in TRANS bth' (SOME_EL_CONV conv right)) ?\s failwith (`IS_EL_CONV: `^s);; % --------------------------------------------------------------------- % % LAST_CONV : conv % % LAST_CONV "LAST [x0;...;xn]" ---> |- LAST [x0;...;xn] = xn % % --------------------------------------------------------------------- % let LAST_CONV = let bth = theorem `list` `LAST` in \tm. (let _,l = ((check_const`LAST`) # I) (dest_comb tm) in let l',lty = dest_list l in if ((length l') = 0) then failwith `empty list` else (let x = last l' and lis = mk_list((butlast l'),lty) in let bth' = ISPECL[x;lis] bth in CONV_RULE ((RATOR_CONV o RAND_CONV o RAND_CONV)SNOC_CONV) bth')) ?\s failwith (`LAST_CONV: `^s);; % --------------------------------------------------------------------- % % BUTLAST_CONV : conv % % BUTLAST_CONV "BUTLAST [x0;...;xn-1;xn]" ---> % % |- BUTLAST [x0;...;xn-1;xn] = [x0;...;xn-1] % % --------------------------------------------------------------------- % let BUTLAST_CONV = let bth = theorem `list` `BUTLAST` in \tm. (let _,l = ((check_const`BUTLAST`) # I) (dest_comb tm) in let l',lty = dest_list l in if ((length l') = 0) then failwith `empty list` else (let x = last l' and lis = mk_list((butlast l'),lty) in let bth' = ISPECL[x;lis] bth in CONV_RULE ((RATOR_CONV o RAND_CONV o RAND_CONV)SNOC_CONV) bth')) ?\s failwith (`BUTLAST_CONV: `^s);; %----------------------------------------------------------------% let SUC_CONV = let numty = mk_type(`num`,[]) in \tm. let (SUC,(n,_)) = (I # dest_const)(dest_comb tm) in let n' = string_of_int(1 + (int_of_string n)) in SYM (num_CONV (mk_const(n', numty)));; %---------------------------------------------------------------% % SEG_CONV : conv % % SEG_CONV "SEG m k [x0;...;xk;...;xm+k;...xn]" ---> % % |- SEG m k [x0;...;xk;...;xm+k;...xn] = [xk;...xm+k-1] % %---------------------------------------------------------------% let SEG_CONV = let [bthm;mthm;kthm] = CONJ_LIST 3 (definition `list` `SEG`) in let SUC = "SUC" in let mifn mthm' x th = let [M';_;L] = snd(strip_comb(lhs(concl th))) in SUBS[(SUC_CONV(mk_comb(SUC,M')));th](SPECL[M';x;L]mthm') in let kifn kthm' x th = let [_;K';L] = snd(strip_comb(lhs(concl th))) in SUBS[(SUC_CONV(mk_comb(SUC,K')));th](SPECL[K';x;L]kthm') in \tm. (let _,[M;K;L] = ((check_const`SEG`)# I)(strip_comb tm) in let lis,lty = dest_list L in let m = int_of_term M and k = int_of_term K in if ((m + k) > (length lis)) then failwith `indexes too large` else if (m = 0) then (ISPECL[K;L]bthm) else let mthm' = INST_TYPE [(lty,":*")] mthm in if (k = 0) then let (ls,lt) = chop_list m lis in let bthm' = ISPECL["0";(mk_list(lt,lty))] bthm in (itlist (mifn mthm') ls bthm') else let lk,(ls,lt) = (I #(chop_list m))(chop_list k lis) in let bthm' = ISPECL["0";(mk_list(lt,lty))] bthm in let kthm' = SUBS[SYM(num_CONV M)] (INST_TYPE[(lty,":*")](SPEC (term_of_int(m-1)) kthm)) in let bbthm = itlist (mifn mthm') ls bthm' in (itlist (kifn kthm') lk bbthm)) ?\s failwith (`SEG_CONV: `^s);; %-----------------------------------------------------------------------% % LASTN_CONV : conv % % It takes a term of the form "LASTN k [x0; ...; x(n-k); ...; x(n-1)]" % % and returns the following theorem: % % |- LASTN k [x0; ...; x(n-k); ...; x(n-1)] = [x(n-k); ...; x(n-1)] % %-----------------------------------------------------------------------% let LASTN_CONV = let LASTN_LENGTH_APPEND = theorem `list` `LASTN_LENGTH_APPEND` and bthm = CONJUNCT1 (definition `list` `LASTN`) and ithm = (theorem `list` `LASTN_LENGTH_ID`) in let len_conv ty lst = LENGTH_CONV(mk_comb("LENGTH:(^ty)list -> num",lst)) in \tm. (let _,[N;lst] = ((check_const`LASTN`) # I) (strip_comb tm) in let n = int_of_term N in if (n = 0) then (ISPEC lst bthm) else (let bits,lty = (dest_list lst) in let len = (length bits) in if (n > len) then failwith `index too large` else if (n = len) then (SUBS[(len_conv lty lst)](ISPEC lst ithm)) else (let l1,l2 = (chop_list (len - n) bits) in let l1' = mk_list(l1, lty) and l2' = mk_list(l2, lty) in let APP = "APPEND:(^lty)list -> (^lty)list -> (^lty)list" in let thm2 = len_conv lty l2' in let thm3 = APPEND_CONV (mk_comb(mk_comb(APP, l1'),l2')) in (SUBS[thm2;thm3](ISPECL [l1';l2'] LASTN_LENGTH_APPEND)) ))) ?\s failwith (`LASTN_CONV: `^s);; %-----------------------------------------------------------------------% % BUTLASTN_CONV : conv % % It takes a term of the form "BUTLASTN k [x0;x1;...;x(n-k);...;x(n-1)]"% % and returns the following theorem: % % |- BUTLASTN k [x0; x1; ...; x(n-k);...;x(n-1)] = [x0; ...; x(n-k-1)] % %-----------------------------------------------------------------------% let BUTLASTN_CONV = let bthm = CONJUNCT1 (definition `list` `BUTLASTN`) in let lthm = (theorem `list` `BUTLASTN_LENGTH_NIL`) in let athm = (theorem `list` `BUTLASTN_LENGTH_APPEND`) in let len_conv ty lst = LENGTH_CONV(mk_comb("LENGTH:(^ty)list -> num",lst)) in \tm. (let _,[N;lst] = ((check_const`BUTLASTN`) # I) (strip_comb tm) in let n = int_of_term N in if (n = 0) then (ISPEC lst bthm) else (let bits,lty = (dest_list lst) in let len = (length bits) in if (n > len) then failwith `index too large` else if (n = len) then let thm1 = len_conv lty lst in (SUBS[thm1](ISPEC lst lthm)) else (let l1,l2 = (chop_list (len - n) bits) in let l1' = mk_list(l1, lty) and l2' = mk_list(l2, lty) in let APP = "APPEND:(^lty)list -> (^lty)list -> (^lty)list" in let thm2 = len_conv lty l2' in let thm3 = APPEND_CONV (mk_comb(mk_comb(APP, l1'),l2')) in (SUBS[thm2;thm3](ISPECL [l2';l1'] athm)) ))) ?\s failwith (`BUTLASTN_CONV: `^s);; %-----------------------------------------------------------------------% % BUTFIRSTN_CONV : conv % % BUTFIRSTN_CONV "BUTFIRSTN k [x0;...;xk;...;xn]" ---> % % |- BUTFIRSTN k [x0;...;xk;...;xn] = [xk;...;xn] % %-----------------------------------------------------------------------% let BUTFIRSTN_CONV = let bthm,ithm = CONJ_PAIR (definition `list` `BUTFIRSTN`) in let SUC = "SUC" in let itfn ithm' x th = let _,[N';L'] = strip_comb(lhs(concl th)) in SUBS[(SUC_CONV(mk_comb(SUC,N')));th](SPECL[N';x;L']ithm') in \tm. (let _,[K;L] = ((check_const`BUTFIRSTN`)# I)(strip_comb tm) in let k = int_of_term K and lis,lty = dest_list L in if (k > (length lis)) then failwith `index too large` else if (k = 0) then (ISPEC L bthm) else let ll,lr = chop_list k lis in let bthm' = ISPEC (mk_list(lr,lty)) bthm in let ithm' = INST_TYPE[(lty,":*")]ithm in itlist (itfn ithm') ll bthm') ?\s failwith (`BUTFIRSTN_CONV: `^s);; %-----------------------------------------------------------------------% % FIRSTN_CONV : conv % % FIRSTN_CONV "FIRSTN k [x0;...;xk;...;xn]" ---> % % |- FIRSTN k [x0;...;xk;...;xn] = [x0;...;xk] % %-----------------------------------------------------------------------% let FIRSTN_CONV = let bthm,ithm = CONJ_PAIR (definition `list` `FIRSTN`) in let SUC = "SUC" in let itfn ithm' x th = let _,[N';L'] = strip_comb(lhs(concl th)) in SUBS[(SUC_CONV(mk_comb(SUC,N')));th](SPECL[N';x;L']ithm') in \tm. (let _,[K;L] = ((check_const`FIRSTN`)# I)(strip_comb tm) in let k = int_of_term K and lis,lty = dest_list L in if (k > (length lis)) then failwith `index too large` else if (k = 0) then (ISPEC L bthm) else let ll,lr = chop_list k lis in let bthm' = ISPEC (mk_list(lr,lty)) bthm in let ithm' = INST_TYPE[(lty,":*")]ithm in itlist (itfn ithm') ll bthm') ?\s failwith (`FIRSTN_CONV: `^s);; %-----------------------------------------------------------------------% % SCANL_CONV : conv -> conv % % SCANL_CONV conv "SCANL f e [x0;...;xn]" ---> % % |- SCANL f e [x0;...;xn] = [e; t0; ...; tn] % % where conv "f ei xi" ---> |- f ei xi = ti % %-----------------------------------------------------------------------% let SCANL_CONV = let bthm,ithm = CONJ_PAIR (definition `list` `SCANL`) in \conv tm. (let _,[f;e;l] = ((check_const`SCANL`)#I)(strip_comb tm) in let bthm' = ISPEC f bthm and ithm' = ISPEC f ithm in letrec scan_conv tm' = let [_;E;L] = snd(strip_comb tm') in if (is_const L) then (SPEC E bthm') else let [x;l] = snd(strip_comb L) in let th1 = conv (mk_comb(mk_comb(f,E),x)) in let th2 = SUBS[th1](SPECL[E;x;l] ithm') in let th3 = scan_conv (last(snd(strip_comb(rhs(concl th2))))) in SUBS[th3]th2 in (scan_conv tm)) ?\s failwith (`SCANL_CONV: `^s);; %-----------------------------------------------------------------------% % SCANR_CONV : conv -> conv % % SCANR_CONV conv "SCANR f e [x0;...;xn]" ---> % % |- SCANR f e [x0;...;xn] = [t0; ...; tn; e] % % where conv "f xi ei" ---> |- f xi ei = ti % %-----------------------------------------------------------------------% let SCANR_CONV = let bthm,ithm = CONJ_PAIR (definition `list` `SCANR`) in let HD = definition `list` `HD` in \conv tm. (let _,[f;e;l] = ((check_const`SCANR`)#I)(strip_comb tm) in let bthm' = ISPEC f bthm and ithm' = ISPEC f ithm in letrec scan_conv tm' = let [_;E;L] = snd(strip_comb tm') in if (is_const L) then (SPEC E bthm') else let [x;l] = snd(strip_comb L) in let th2 = (SPECL[E;x;l] ithm') in let th3 = scan_conv (last(snd(strip_comb(rhs(concl th2))))) in let th4 = PURE_ONCE_REWRITE_RULE[HD](SUBS[th3]th2) in let th5 = conv (hd(snd(strip_comb(rhs(concl th4))))) in SUBS[th5]th4 in (scan_conv tm)) ?\s failwith (`SCANR_CONV: `^s);; %-----------------------------------------------------------------------% % REPLICATE_CONV : conv % % REPLICATE conv "REPLICATE f n" ---> % % |- REPLICATE n x = [x; ...; x] % %-----------------------------------------------------------------------% let REPLICATE_CONV = let (bthm,ithm) = CONJ_PAIR (definition `list` `REPLICATE`) in let dec n = term_of_int((int_of_term n) - 1) in letrec repconv (bthm, ithm) tm = let [n;x] = snd(strip_comb tm) in if ((int_of_term n) = 0) then bthm else (let th1 = SUBS[SYM (num_CONV n)](SPEC (dec n) ithm) in CONV_RULE ((RAND_CONV o RAND_CONV) (repconv(bthm,ithm))) th1) in \tm. (let _,[n;x] = ((check_const`REPLICATE`)#I)(strip_comb tm) in let xty = type_of x in let bthm' = ISPEC x bthm and ithm' = GEN_ALL(ISPECL[mk_var(`n`,xty);x] ithm) in (repconv (bthm',ithm') tm)) ?\s failwith (`REPLICATE_CONV: `^s);; %-----------------------------------------------------------------------% % GENLIST_CONV : conv -> conv % % GENLIST conv "GENLIST f n" ---> |- GENLIST f n = [f 0;f 1; ...;f(n-1)]% %-----------------------------------------------------------------------% let GENLIST_CONV = let (bthm,ithm) = CONJ_PAIR (definition `list` `GENLIST`) in let dec n = term_of_int((int_of_term n) - 1) in letrec genconv (bthm,ithm) conv tm = let n = last(snd(strip_comb tm)) in if ((int_of_term n) = 0) then CONV_RULE(ONCE_DEPTH_CONV conv) bthm else (let th1 = SUBS[SYM (num_CONV n)](SPEC (dec n) ithm) in let th2 = RIGHT_CONV_RULE ((RATOR_CONV o RAND_CONV) conv) th1 in RIGHT_CONV_RULE (RAND_CONV (genconv (bthm,ithm) conv)) th2) in \conv tm. (let _,[f;n] = ((check_const`GENLIST`)# I)(strip_comb tm) in let bthm' = ISPEC f bthm and ithm' = ISPEC f ithm in RIGHT_CONV_RULE (TOP_DEPTH_CONV SNOC_CONV)(genconv (bthm',ithm') conv tm)) ?\s failwith (`GENLIST_CONV: `^s);; (APPEND_CONV, MAP_CONV, FOLDR_CONV, FOLDL_CONV, list_FOLD_CONV, SUM_CONV, FILTER_CONV, SNOC_CONV, REVERSE_CONV, FLAT_CONV, EL_CONV, ELL_CONV, MAP2_CONV, ALL_EL_CONV, SOME_EL_CONV, IS_EL_CONV, LAST_CONV, BUTLAST_CONV, SEG_CONV, LASTN_CONV, BUTLASTN_CONV, BUTFIRSTN_CONV, FIRSTN_CONV, SCANL_CONV, SCANR_CONV, REPLICATE_CONV,GENLIST_CONV);; end_section `list_convs`;; let (APPEND_CONV, MAP_CONV, FOLDR_CONV, FOLDL_CONV, list_FOLD_CONV, SUM_CONV, FILTER_CONV, SNOC_CONV, REVERSE_CONV, FLAT_CONV, EL_CONV, ELL_CONV, MAP2_CONV, ALL_EL_CONV, SOME_EL_CONV, IS_EL_CONV, LAST_CONV, BUTLAST_CONV, SEG_CONV, LASTN_CONV, BUTLASTN_CONV, BUTFIRSTN_CONV, FIRSTN_CONV, SCANL_CONV, SCANR_CONV, REPLICATE_CONV,GENLIST_CONV) = it;; hol88-2.02.19940316/ml/resolve.ml0000640000212700021270000004667005521014760014362 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: resolve.ml % % % % DESCRIPTION: Resolution inference rules and tactics % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml % % hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, % % tacont.ml, tactics.ml, conv.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: new resolve.ml for HOL Version 1.12 [TFM 91.01.26] % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also load hol-rule.ml, hol-drule.ml, drul.ml, tacticals.ml, etc % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`; loadf `ml/hol-drule`; loadf `ml/drul`; loadf `ml/tacticals`; loadf `ml/tacont`; loadf `ml/tactics`; loadf `ml/conv`);; % --------------------------------------------------------------------- % % Search among a list of implications to perform Modus Ponens % % Used nowhere --- deleted until found useful [TFM 90.04.24] % % let MULTI_MP impl ante = % % tryfind (\imp. MATCH_MP imp ante) impl ? failwith `MULTI_MP`;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Forwards chaining by Modus Ponens % % Used nowhere --- deleted until found useful [TFM 90.04.24] % % let MP_CHAIN = REDEPTH_CHAIN o MULTI_MP;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Accept a theorem that, properly instantiated, satisfies the goal % % --------------------------------------------------------------------- % let MATCH_ACCEPT_TAC thm : tactic = let fmatch = PART_MATCH I thm in let atac (asl,w) = [], K (fmatch w) in set_fail_prefix `MATCH_ACCEPT_TAC` ((REPEAT GEN_TAC) THEN atac);; % --------------------------------------------------------------------- % % Basic unit for resolution tactics % % DELETED: TFM 88.03.31 (not used anywhere) % % % % let MATCH_MP_TAC impth = STRIP_ASSUME_TAC o (MATCH_MP impth);; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Resolve implicative assumptions with an antecedent % % --------------------------------------------------------------------- % let ANTE_RES_THEN ttac ante : tactic = ASSUM_LIST (EVERY o (mapfilter (\imp. ttac (MATCH_MP imp ante))));; % --------------------------------------------------------------------- % % Old versions of RESOLVE_THEN etc. [TFM 90.04.24] % % % % letrec RESOLVE_THEN antel ttac impth : tactic = % % let answers = mapfilter (MATCH_MP impth) antel in % % EVERY (mapfilter ttac answers) % % THEN % % (EVERY (mapfilter (RESOLVE_THEN antel ttac) answers));; % % % % let OLD_IMP_RES_THEN ttac impth = % % ASSUM_LIST % % (\asl. EVERY (mapfilter (RESOLVE_THEN asl ttac) % % (IMP_CANON impth)));; % % % % let OLD_RES_THEN ttac = % % ASSUM_LIST (EVERY o (mapfilter (OLD_IMP_RES_THEN ttac)));; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % A trick tactic for solving existential/disjunctive goals % % Too tricky, and depends on obsolete version of IMP_RES_THEN % % Deleted: TFM 90.04.24 % % let SELF_RES_TAC (asl,w) = % % OLD_IMP_RES_THEN ACCEPT_TAC % % (DISCH w (itlist ADD_ASSUM asl (ASSUME w))) (asl,w);; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Resolution tactics from LCF - uses IMP_CANON and GSPEC % % % % Deleted: TFM 90.04.24 % % % % let OLD_IMP_RES_TAC = OLD_IMP_RES_THEN STRIP_ASSUME_TAC;; % % let OLD_RES_TAC = OLD_RES_THEN STRIP_ASSUME_TAC;; % % --------------------------------------------------------------------- % % ===================================================================== % % Resolution tactics for HOL - uses RES_CANON and SPEC_ALL % % ===================================================================== % % --------------------------------------------------------------------- % % Put a theorem % % % % |- !x. t1 ==> !y. t2 ==> ... ==> tm ==> t % % % % into canonical form for resolution by splitting conjunctions apart % % (like IMP_CANON but without the stripping out of quantifiers and only % % outermost negations being converted to implications). % % % % ~t ---> t ==> F (at outermost level) % % t1 /\ t2 ---> t1, t2 % % (t1/\t2)==>t ---> t1==> (t2==>t) % % (t1\/t2)==>t ---> t1==>t, t2==>t % % % % % % Modification provided by David Shepherd of Inmos to make resolution % % work with equalities as well as implications. HOL88.1.08,23 jun 1989. % % % % t1 = t2 ---> t1=t2, t1==>t2, t2==>t1 % % % % Modification provided by T Melham to deal with the scope of % % universal quantifiers. [TFM 90.04.24] % % % % !x. t1 ==> t2 ---> t1 ==> !x.t2 (x not free in t1) % % % % The old code is given below: % % % % letrec RES_CANON_FUN th = % % let w = concl th in % % if is_conj w % % then RES_CANON_FUN(CONJUNCT1 th)@RES_CANON_FUN(CONJUNCT2 th) % % else if is_imp w & not(is_neg w) then % % let ante,conc = dest_imp w in % % if is_conj ante then % % let a,b = dest_conj ante in % % RES_CANON_FUN % % (DISCH a (DISCH b (MP th (CONJ (ASSUME a) (ASSUME b))))) % % else if is_disj ante then % % let a,b = dest_disj ante in % % RES_CANON_FUN (DISCH a (MP th (DISJ1 (ASSUME a) b))) @ % % RES_CANON_FUN (DISCH b (MP th (DISJ2 a (ASSUME b)))) % % else % % map (DISCH ante) (RES_CANON_FUN (UNDISCH th)) % % else [th];; % % % % This version deleted for HOL 1.12 (see below) [TFM 91.01.17] % % % % let RES_CANON = % % letrec FN th = % % let w = concl th in % % if (is_conj w) then FN(CONJUNCT1 th) @ FN(CONJUNCT2 th) else % % if ((is_imp w) & not(is_neg w)) then % % let ante,conc = dest_imp w in % % if (is_conj ante) then % % let a,b = dest_conj ante in % % let ath = ASSUME a and bth = ASSUME b in % % FN (DISCH a (DISCH b (MP th (CONJ ath bth)))) else % % if is_disj ante then % % let a,b = dest_disj ante in % % let ath = ASSUME a and bth = ASSUME b in % % FN (DISCH a (MP th (DISJ1 ath b))) @ % % FN (DISCH b (MP th (DISJ2 a bth))) else % % map (GEN_ALL o (DISCH ante)) (FN (UNDISCH th)) else % % if is_eq w then % % let l,r = dest_eq w in % % if (type_of l = ":bool") then % % let (th1,th2) = EQ_IMP_RULE th in % % (GEN_ALL th) . ((FN th1) @ (FN th2)) % % else [GEN_ALL th] % % else [GEN_ALL th] in % % \th. (let vars,w = strip_forall(concl th) in % % let th1 = if (is_neg w) % % then NOT_ELIM(SPEC_ALL th) % % else (SPEC_ALL th) in % % map GEN_ALL (FN th1) ? failwith `RES_CANON`);; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % New RES_CANON for version 1.12. [TFM 90.12.07] % % % % The complete list of transformations is now: % % % % ~t ---> t ==> F (at outermost level) % % t1 /\ t2 ---> t1, t2 (at outermost level) % % (t1/\t2)==>t ---> t1==>(t2==>t), t2==>(t1==>t) % % (t1\/t2)==>t ---> t1==>t, t2==>t % % t1 = t2 ---> t1==>t2, t2==>t1 % % !x. t1 ==> t2 ---> t1 ==> !x.t2 (x not free in t1) % % (?x.t1) ==> t2 ---> !x'. t1[x'/x] ==> t2 % % % % The function now fails if no implications can be derived from the % % input theorem. % % % % Bugfix: |- (?x. P[x]) ==> !x. Q[x] now transforms to the theorem % % |- !x. P[x] ==> !x'. Q[x']. [TFM 91.10.19] % % % % Bugfix: check thm_frees not just frees for previous bugfix (above). % % [TFM 92.05.11] % % --------------------------------------------------------------------- % let RES_CANON = let not_elim th = (is_neg (concl th) => true,(NOT_ELIM th) | (false,th)) in letrec canon fl th = let w = concl th in if (is_conj w) then let (th1,th2) = CONJ_PAIR th in (canon fl th1) @ (canon fl th2) else if ((is_imp w) & not(is_neg w)) then let ante,conc = dest_neg_imp w in if (is_conj ante) then let a,b = dest_conj ante in let cth = NOT_MP th (CONJ (ASSUME a) (ASSUME b)) in let th1 = DISCH b cth and th2 = DISCH a cth in (canon true (DISCH a th1)) @ (canon true (DISCH b th2)) else if (is_disj ante) then let a,b = dest_disj ante in let ath = DISJ1 (ASSUME a) b and bth = DISJ2 a (ASSUME b) in let th1 = DISCH a (NOT_MP th ath) and th2 = DISCH b (NOT_MP th bth) in (canon true th1) @ (canon true th2) else if (is_exists ante) then let v,body = dest_exists ante in let newv = variant (thm_frees th) v in let newa = subst [newv,v] body in let th1 = NOT_MP th (EXISTS (ante, newv) (ASSUME newa)) in canon true (DISCH newa th1) else map (GEN_ALL o (DISCH ante)) (canon true (UNDISCH th)) else if (is_eq w & (type_of (rand w) = ":bool")) then let (th1,th2) = EQ_IMP_RULE th in (fl => [GEN_ALL th] | []) @ (canon true th1) @ (canon true th2) else if (is_forall w) then let vs,body = strip_forall w in let fvs = thm_frees th in let vfn = \l. variant (l @ fvs) in let nvs = itlist (\v nv. let v' = vfn nv v in (v'.nv)) vs [] in canon fl (SPECL nvs th) else if fl then [GEN_ALL th] else [] in \th. (let args = map (not_elim o SPEC_ALL) (CONJUNCTS (SPEC_ALL th)) in let imps = flat (map (map GEN_ALL o (uncurry canon)) args) in assert ($not o null) imps) ? failwith `RES_CANON: no implication is derivable from input thm.`;; % --------------------------------------------------------------------- % % Definitions of the primitive: % % % % IMP_RES_THEN: Resolve all assumptions against an implication. % % % % The definition uses two auxiliary (local) functions: % % % % MATCH_MP : like the built-in version, but doesn't use GSPEC. % % RESOLVE_THEN : repeatedly resolve an implication % % % % This version deleted for HOL version 1.12 [TFM 91.01.17] % % % % begin_section IMP_RES_THEN;; % % % % let MATCH_MP impth = % % let sth = SPEC_ALL impth in % % let pat = fst(dest_imp(concl sth)) in % % let matchfn = match pat in % % (\th. MP (INST_TY_TERM (matchfn (concl th)) sth) th);; % % % % letrec RESOLVE_THEN antel ttac impth : tactic = % % let answers = mapfilter (MATCH_MP impth) antel in % % EVERY (mapfilter ttac answers) THEN % % (EVERY (mapfilter (RESOLVE_THEN antel ttac) answers));; % % % % let IMP_RES_THEN ttac impth = % % ASSUM_LIST (\asl. % % EVERY (mapfilter (RESOLVE_THEN asl ttac) (RES_CANON impth))) ? % % failwith `IMP_RES_THEN`;; % % % % IMP_RES_THEN;; % % % % end_section IMP_RES_THEN;; % % % % let IMP_RES_THEN = it;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Definition of the primitive: % % % % IMP_RES_THEN: Resolve all assumptions against an implication. % % % % The definition uses an auxiliary (local) function, MATCH_MP, which is % % just like the built-in version, but doesn't use GSPEC. % % % % New implementation for version 1.12: fails if no MP-consequences can % % be drawn, and does only one-step resolution. [TFM 90.12.07] % % --------------------------------------------------------------------- % begin_section resolution_ttcls;; let MATCH_MP impth = let sth = SPEC_ALL impth in let matchfn = match (fst(dest_neg_imp(concl sth))) in \th. NOT_MP (INST_TY_TERM (matchfn (concl th)) sth) th;; % --------------------------------------------------------------------- % % check st l : Fail with st if l is empty, otherwise return l. % % --------------------------------------------------------------------- % let check st l = (null l => failwith st | l);; % --------------------------------------------------------------------- % % IMP_RES_THEN : Resolve an implication against the assumptions. % % --------------------------------------------------------------------- % let IMP_RES_THEN ttac impth = let ths = RES_CANON impth ? failwith `IMP_RES_THEN: no implication` in ASSUM_LIST \asl. let l = itlist (\th.append (mapfilter (MATCH_MP th) asl)) ths [] in let res = check `IMP_RES_THEN: no resolvents ` l in let tacs = check `IMP_RES_THEN: no tactics` (mapfilter ttac res) in EVERY tacs;; % --------------------------------------------------------------------- % % RES_THEN : Resolve all implicative assumptions against the rest. % % --------------------------------------------------------------------- % let RES_THEN ttac (asl,g) = let as = map ASSUME asl in let ths = itlist append (mapfilter RES_CANON as) [] in let imps = check `RES_THEN: no implication` ths in let l = itlist (\th.append (mapfilter (MATCH_MP th) as)) imps [] in let res = check `RES_THEN: no resolvents ` l in let tacs = check `RES_THEN: no tactics` (mapfilter ttac res) in EVERY tacs (asl,g);; % --------------------------------------------------------------------- % % Export IMP_RES_THEN and RES_THEN outside of the section. % % --------------------------------------------------------------------- % (IMP_RES_THEN,RES_THEN);; end_section resolution_ttcls;; let (IMP_RES_THEN,RES_THEN) = it;; % --------------------------------------------------------------------- % % Definition of the standard resolution tactics IMP_RES_TAC and RES_TAC % % % % The function SA is like STRIP_ASSUME_TAC, except that it does not % % strip off existential quantifiers. And ST is like STRIP_THM_THEN, % % except that it also does not strip existential quantifiers. % % % % Old version: deleted for HOL version 1.12 [TFM 91.01.17] % % % % let (IMP_RES_TAC,RES_TAC) = % % let ST = FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN] in % % let SA = (REPEAT_TCL ST) CHECK_ASSUME_TAC in % % (IMP_RES_THEN SA, RES_THEN SA);; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % New versions of IMP_RES_TAC and RES_TAC: repeatedly resolve, and then % % add FULLY stripped, final, result(s) to the assumption list. % % --------------------------------------------------------------------- % let IMP_RES_TAC th g = IMP_RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) th g ? ALL_TAC g;; let RES_TAC g = RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) g ? ALL_TAC g;; % --------------------------------------------------------------------- % % Used to be for compatibility with the old system. % % Deleted: TFM 90.04.24 % % let HOL_IMP_RES_THEN = IMP_RES_THEN % % and HOL_RES_THEN = RES_THEN;; % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % MATCH_MP_TAC: Takes a theorem of the form % % % % |- !x1..xn. A ==> !y1 ... ym. B % % % % and matches B to the goal, reducing it to the subgoal consisting of % % some existentially-quantified instance of A: % % % % !v1...vi. B % % ======================= MATCH_MP_TAC |- !x1...1n. A ==> !y1...ym. B % % ?z1...zp. A % % % % where {z1,...,zn} is the subset of {x1,...,xn} whose elements to not % % appear free in B. % % % % Added: TFM 88.03.31 % % Revised: TFM 91.04.20 % % % % Old version: % % % % let MATCH_MP_TAC thm:tactic (gl,g) = % % let imp = ((PART_MATCH (snd o dest_imp) thm) g) ? % % failwith `MATCH_MP_TAC` in % % ([gl,(fst(dest_imp(concl imp)))], \thl. MP imp (hd thl));; % % --------------------------------------------------------------------- % let MATCH_MP_TAC : thm_tactic = let efn v (tm,th) = let ntm = mk_exists(v,tm) in ntm,CHOOSE (v, ASSUME ntm) th in \thm. let gvs,imp = strip_forall (concl thm) in let ant,cnc = dest_neg_imp imp ? failwith `MATCH_MP_TAC: not an implication` in let cvs,con = strip_forall cnc in let th1 = SPECL cvs (UNDISCH (SPECL gvs thm)) in let vs,evs = partition (C free_in con) gvs in let th2 = uncurry DISCH (itlist efn evs (ant,th1)) in \A,g. let vs,gl = strip_forall g in let ins = match con gl ? failwith `MATCH_MP_TAC: no match` in let ith = INST_TY_TERM ins th2 in let ant = fst(dest_neg_imp(concl ith)) in let gth = GENL vs (UNDISCH ith) ? failwith `MATCH_MP_TAC: generalized var(s)` in ([A,ant], \thl. NOT_MP (DISCH ant gth) (hd thl));; hol88-2.02.19940316/ml/hol-drule.ml0000640000212700021270000016345405521017456014603 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: hol-drule.ml % % % % DESCRIPTION: Derived theorems and rules. (Proper derivation are % % given as comments.) % % % % USES FILES: basic-hol lisp files, bool.th, genfns.ml, hol-syn.ml, % % hol-rule.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Must be compiled in the presence of the hol parser/pretty printer % % This loads genfns.ml and hol-syn.ml too. % % Also depends on hol-rule.ml % % --------------------------------------------------------------------- % if compiling then (loadf `ml/hol-in-out`; loadf `ml/hol-rule`);; % Add an assumption A |- t' ----------- A,t |- t' let ADD_ASSUM t th = MP (DISCH t th) (ASSUME t);; % let ADD_ASSUM t th = fst(mk_thm(union [t] (hyp th), concl th), RecordStep(AddAssumStep(t,th)));; % Symmetry of = A |- t1 = t2 ---------------- A |- t2 = t1 let SYM th = (let t1,t2 = dest_eq(concl th) in let v = genvar(type_of t1) in SUBST [th,v] "^v=^t1" (REFL "^t1") ) ? failwith`SYM`;; % let SYM th = (let hyps,conc = dest_thm th in let x,y = dest_eq conc in fst(mk_thm (hyps, mk_eq (y,x)), RecordStep(SymStep th))) ? failwith `SYM`;; % Transitivity of = A1 |- t1 = t2 , A2 |- t2 = t3 --------------------------------- A1 u A2 |- t1=t3 let TRANS th1 th2 = (let t1 ,t2 = dest_eq(concl th1) and t2',t3 = dest_eq(concl th2) in let v = genvar(type_of t1) in SUBST [th2,v] "^t1=^v" th1 ) ? failwith`TRANS`;; % ml_curried_infix `TRANS`;; let th1 TRANS th2 = (let x,y = dest_eq (concl th1) and y',z = dest_eq (concl th2) and hyps = union (hyp th1) (hyp th2) in if aconv y y' then fst(mk_thm (hyps, mk_eq(x,z)), RecordStep(TransStep(th1,th2))) else fail) ? failwith `TRANS`;; % Transitivity of ==> A1 |- t1 ==> t2 A2 |- t2 ==> t3 --------------------------------------------- A1 u A2 |- t1 ==> t3 let IMP_TRANS th1 th2 = (let t1,t2 = dest_imp(concl th1) in DISCH t1 (MP th2 (MP th1 (ASSUME t1))) ) ? failwith `IMP_TRANS`;; % % Modified: TFM 88.10.08 to use "union A1 A1" instead of A1 @ A2 % let IMP_TRANS th1 th2 = (let A1, (t1,t2) = ((I # dest_imp) o dest_thm) th1 and A2, (t2',t3) = ((I # dest_imp) o dest_thm) th2 in if aconv t2 t2' then fst(mk_thm(union A1 A2, mk_imp(t1,t3)), RecordStep(ImpTransStep(th1,th2))) else fail ) ? failwith `IMP_TRANS`;; %< Application of a term to a theorem A |- t1 = t2 ------------------ A |- t t1 = t t2 let AP_TERM tm th = (let t1,t2 = dest_eq(concl th) in let th1 = REFL "^tm ^t1" %< th1 = |- t t1 = t t1 >% and v = genvar(type_of t1) in SUBST [th,v] "^tm ^t1 = ^tm ^v" th1 ) ? failwith `AP_TERM`;; >% let AP_TERM tm th = (let t1,t2 = dest_eq(concl th) in fst(mk_thm(hyp th, mk_eq(mk_comb(tm,t1), mk_comb(tm,t2))), RecordStep(ApTermStep(tm,th))) ) ? failwith `AP_TERM`;; %< Application of a theorem to a term A |- t1 = t2 ---------------- A |- t1 t = t2 t let AP_THM th tm = (let t1,t2 = dest_eq(concl th) in let th1 = REFL "^t1 ^tm" %< th1 = |- t1 t = t1 t >% and v = genvar(type_of t1) in SUBST [th,v] "^t1 ^tm = ^v ^tm" th1 ) ? failwith `AP_THM`;; >% let AP_THM th tm = (let t1,t2 = dest_eq(concl th) in fst(mk_thm(hyp th, mk_eq(mk_comb(t1,tm), mk_comb(t2,tm))), RecordStep(ApThmStep(th,tm))) ) ? failwith `AP_THM`;; % Modus Ponens for = A1 |- t1 = t2 , A2 |- t1 ---------------------------- A1 u A2 |- t2 let EQ_MP th1 th2 = (let t1,t2 = dest_eq(concl th1) in let v = genvar(type_of t1) in SUBST [th1,v] v th2 ) ? failwith `EQ_MP`;; % let EQ_MP th1 th2 = (let t1,t2 = dest_eq(concl th1) and t1' = concl th2 in if aconv t1 t1' then fst(mk_thm(union(hyp th1)(hyp th2), t2), RecordStep(EqMpStep(th1,th2))) else fail ) ? failwith `EQ_MP`;; % A |- t1 = t2 ------------------------------------ A |- t1 ==> t2 A |- t2 ==> t1 let EQ_IMP_RULE th = (let t1,t2 = dest_eq(concl th) in (DISCH t1 (EQ_MP th (ASSUME t1)), DISCH t2 (EQ_MP(SYM th)(ASSUME t2))) ) ? failwith `EQ_IMP_RULE`;; % let EQ_IMP_RULE th = (let t1,t2 = dest_eq(concl th) and A = hyp th in fst((mk_thm(A,mk_imp(t1,t2)), mk_thm(A,mk_imp(t2,t1))), RecordStep(EqImpRuleStep th)) ) ? failwith `EQ_IMP_RULE`;; % |- T (type of "x" set to ":bool" for HOL88) % let TRUTH = EQ_MP (SYM T_DEF) (REFL "\x:bool.x");; % =T elimination A |- t = T ------------ A |- t % let EQT_ELIM th = EQ_MP (SYM th) TRUTH ? failwith `EQT_ELIM`;; %< Specialization A |- !(\x.u) -------------------- (where t is free for x in u) A |- u[t/x] let SPEC t th = (let F,body = dest_comb(concl th) in if not(fst(dest_const F)=`!`) then fail else let x,u = dest_abs body in let v1 = genvar(type_of F) and v2 = genvar(type_of body) in let th1 = SUBST [INST_TYPE[type_of x,":*"]FORALL_DEF,v1] "^v1 ^body" th %< th1 = |- (\P. P = (\x. T))(\x. t1 x) >% in let th2 = BETA_CONV(concl th1) %< th2 = |- (\P. P = (\x. T))(\x. t1 x) = ((\x. t1 x) = (\x. T)) >% in let th3 = EQ_MP th2 th1 %< th3 = |- (\x. t1 x) = (\x. T) >% in let th4 = SUBST [th3, v2] "^body ^t = ^v2 ^t" (REFL "^body ^t") %< th4 = |- (\x. t1 x)t = (\x. T)t >% in let ls,rs = dest_eq(concl th4) in let th5 = TRANS(TRANS(SYM(BETA_CONV ls))th4)(BETA_CONV rs) %< th5 = |- t1 t = T >% in EQT_ELIM th5 ) ? failwith `SPEC`;; >% let SPEC t th = (let x,w = dest_forall(concl th) in fst(mk_thm( hyp th , subst[t,x]w ), RecordStep(SpecStep(t,th)))) ? failwith `SPEC` ;; % |- !x1 ... xn. t[xi] -------------------------- SPECL [t1; ...; tn] |- t[ti] % let SPECL ts = \th. rev_itlist SPEC ts th ? failwith `SPECL`;; % Introduce =T A |- t ------------ A |- t=T let EQT_INTRO th = let t = concl th in MP (MP(SPEC "T" (SPEC t IMP_ANTISYM_AX))(DISCH t TRUTH)) (DISCH "T" th);; % let EQT_INTRO = let T = "T:bool" in \th. fst(mk_thm(hyp th, mk_eq(concl th,T)), RecordStep(EqtIntroStep th)) ? failwith `EQT_INTRO`;; %< Generalization A |- t ------------------- (where x not free in A) A |- !(\x.t) let GEN x th = (let th1 = ABS x (EQT_INTRO th) %< th1 = |- (\x. t1 x) = (\x. T) >% in let abs = "\^x.^(concl th)" and v1 = genvar ":(^(type_of x)->bool)->bool" and v2 = genvar ":bool" in let th2 = SUBST [INST_TYPE[type_of x,":*"]FORALL_DEF,v1] "$! ^abs = ^v1 ^abs" (REFL "$! ^abs") %< th2 = |- (!x. t1 x) = (\P. P = (\x. T))(\x. t1 x) >% in let th3 = TRANS th2 (BETA_CONV(snd(dest_eq(concl th2)))) %< th3 = |- (!x. t1 x) = ((\x. t1 x) = (\x. T)) >% in SUBST [SYM th3, v2] v2 th1 ) ? failwith `GEN`;; >% let GEN x th = (if exists (free_in x) (hyp th) then failwith `variable not free in assumption` else fst(mk_thm( hyp th , mk_forall(x, concl th)), RecordStep(GenStep(x,th))) ) ?\s failwith (`GEN: `^s);; let GENL = itlist GEN;; %< Simple version of alpha-conversion (needed for deriving ETA_CONV) "\x1. t x1" "\x2. t x2" ---> |- "(\x1.t x1)=(\x2.t x2)" let SIMPLE_ALPHA(t1,t2) = let x1,body1 = dest_abs t1 and x2,body2 = dest_abs t2 in let th1 = BETA_CONV "^t1 (x:^(type_of x1))" %< th1 = |- (\x1. t x1)x = t x >% and th2 = BETA_CONV "^t2 (x:^(type_of x2))" %< th2 = |- (\x2. t x2)x = t x >% and th3 = SPEC t1 (INST_TYPE [type_of x1,":*"; type_of body1, ":**"] ETA_AX) %< th3 = |- (\x. (\x1. t x1)x) = (\x1. t x1) >% and th4 = SPEC t2 (INST_TYPE [type_of x2,":*"; type_of body2, ":**"] ETA_AX) %< th4 = |- (\x. (\x2. t x2)x) = (\x2. t x2) >% in (SYM th3) TRANS (ABS "x:^(type_of x1)" (th1 TRANS (SYM th2))) TRANS th4;; >% %< Eta-conversion "(\x.t x)" ---> |- (\x.t x) = t (if x not free in t) let ETA_CONV tm = (let x,body = dest_abs tm in let t,() = dest_comb body in let th = SPEC t (INST_TYPE [type_of x,":*"; type_of body, ":**"] ETA_AX) %< th = |- (\x. t x) = t >% in SIMPLE_ALPHA(tm,lhs(concl th)) TRANS th ) ? failwith`ETA_CONV`;; >% let ETA_CONV tm = (let x,body = dest_abs tm in let t,x' = dest_comb body in if (x=x') & not(mem x (frees t)) then fst(mk_thm([],mk_eq(tm,t)), RecordStep(EtaConvStep tm)) else fail ) ? failwith `ETA_CONV`;; %< Extensionality A |- !x. t1 x = t2 x ---------------------- (x not free in t1 or t2) A |- t1 = t2 % Failure if x not free in A avoided [JG 92.04.16] % let EXT th = (let x,() = dest_forall(concl th) in let x' = genvar (type_of x) in let th1 = SPEC x' th %< th1 = |- t1 x' = t2 x' >% in let t1x',t2x' = dest_eq(concl th1) in let th2 = ABS x' th1 %< th2 = |- (\x'. t1 x') = (\x'. t2 x') >% in TRANS (TRANS(SYM(ETA_CONV "\^x'.^t1x'"))th2) (ETA_CONV "\^x'.^t2x'") ) ? failwith `EXT`;; >% let EXT th = (let x,eqn = dest_forall(concl th) in let (t1,x1),(t2,x2) = ((dest_comb # dest_comb) o dest_eq) eqn in if not(mem x (union(frees t1)(frees t2))) & (x=x1) & (x=x2) then fst(mk_thm(hyp th, mk_eq(t1,t2)), RecordStep(ExtStep th)) else failwith `variable is free in function` ) ?\s failwith (`EXT: `^s);; % SELECT introduction A |- P t ----------------- A |- P($@ P) % let SELECT_INTRO th = (let P,t = dest_comb(concl th) in MP (SPEC t (SPEC P (INST_TYPE[type_of t,":*"]SELECT_AX))) th ) ? failwith `SELECT_INTRO`;; % SELECT elimination (cases) A1 |- P($@ P) , A2, "P v" |- t ------------------------------------------ (v occurs nowhere) A1 u A2 |- t % let SELECT_ELIM th1 (v,th2) = (let P, SP = dest_comb(concl th1) in let th3 = DISCH "^P ^v" th2 %< th3 = |- P v ==> t >% in MP (SPEC SP (GEN v th3)) th1 ) ? failwith `SELECT_ELIM`;; %< Existential introduction A |- t[t'] -------------- A |- ?x.t[x] The parameters are: EXISTS("?x.t[x]", "t'") (|- t[t']) let EXISTS (fm,tm) th = (let x,t = dest_exists fm in let th1 = BETA_CONV "(\^x.^t)^tm" %< th1 = |- (\x. t x)t' = t t' >% in let th2 = EQ_MP (SYM th1) th %< th2 = |- (\x. t x)t' >% in let th3 = SELECT_INTRO th2 %< th3 = |- (\x. t x)(@x. t x) >% in let th4 = AP_THM(INST_TYPE[(type_of x),":*"]EXISTS_DEF)"\^x.^t" %< th4 = |- (?x. t x) = (\P. P($@ P))(\x. t x) >% in let th5 = TRANS th4 (BETA_CONV(snd(dest_eq(concl th4)))) %< th5 = |- (?x. t x) = (\x. t x)(@x. t x) >% in EQ_MP (SYM th5) th3 ) ? failwith `EXISTS`;; >% let EXISTS (w,t) th = (let x,body = dest_exists w in if aconv (subst [t,x] body) (concl th) then fst(mk_thm(hyp th, w), RecordStep(ExistsStep((w,t),th))) else fail) ? failwith `EXISTS`;; %< Existential elimination A1 |- ?x.t[x] , A2, "t[v]" |- t' ------------------------------------ (variable v occurs nowhere) A1 u A2 |- t' let CHOOSE (v,th1) th2 = (let x,body = dest_exists(concl th1) and t' = concl th2 and v1 = genvar ":bool" in let th3 = AP_THM (INST_TYPE[type_of v,":*"]EXISTS_DEF) "\^x.^body" %< th3 = |- (?x. t x) = (\P. P($@ P))(\x. t x) >% in let th4 = EQ_MP th3 th1 %< th4 = |- (\P. P($@ P))(\x. t x) >% in let th5 = EQ_MP (BETA_CONV(concl th4)) th4 %< th5 = |- (\x. t x)(@x. t x) >% in let th6 = BETA_CONV "(\^x.^body)^v" %< th6 = |- (\x. t x)v = t v >% in let Pa = snd(dest_eq(concl th6)) in let th7 = UNDISCH(SUBST [SYM th6,v1] "^v1==>^t'" (DISCH Pa th2)) %< th7 = |- t' >% in SELECT_ELIM th5 (v,th7) ) ? failwith `CHOOSE`;; WW 12 Jan 94 let CHOOSE (a,xth) bth = (let x,body = dest_exists (concl xth) in let bhyp = disch(subst [a,x]body, hyp bth) in if not(is_var a) or exists (free_in a) ((concl xth . hyp xth) @ (concl bth . bhyp)) then fail else fst(mk_thm(union (hyp xth) bhyp , concl bth), RecordStep(ChooseStep((a,xth),bth))) ) ? failwith `CHOOSE`;; >% let CHOOSE (a,xth) bth = (let x,body = dest_exists (concl xth) in let s = subst [a,x]body and bhyp = hyp bth in if not(mem s bhyp) then failwith `theorems not in the correct form` else let bhyp' = disch(s, bhyp) in if not(is_var a) or exists (free_in a) ((concl xth) . (concl bth . bhyp')) then failwith `variable not free` else fst(mk_thm(union (hyp xth) bhyp' , concl bth), RecordStep(ChooseStep((a,xth),bth))) ) ?\s failwith (`CHOOSE: `^s);; % SELECT introduction A |- ?x. t[x] ----------------- A |- t[@x.t[x]] % %----------------------------------------------------------------------------% % More efficient version added [JRH 93.06.29] -- old code: % % % % let SELECT_RULE th = % % (let x,t = dest_exists(concl th) % % in % % let v = genvar(type_of x) % % in % % let P = mk_abs(x,t) % % in % % let th1 = SPEC v (SPEC P (INST_TYPE[type_of x,":*"]SELECT_AX)) % % in % % let th2,th3 = ((BETA_CONV # BETA_CONV) o dest_imp o concl) th1 % % in % % let th4 = EQ_MP th3 (MP th1 ((EQ_MP(SYM th2)(ASSUME (rhs(concl th2)))))) % % in % % CHOOSE(v, th)th4 % % ) ? failwith `SELECT_RULE`;; % %----------------------------------------------------------------------------% let SELECT_RULE = let ty = ":*" in let th1 = BETA_CONV "(\P:*->bool. P($@ P)) P" in let th2 = GEN "P:*->bool" ($TRANS (AP_THM EXISTS_DEF "P:*->bool") th1) in (\th. let rct = rand(concl th) in let ith = SPEC rct (INST_TYPE[type_of(bndvar rct),ty] th2) in let fth = EQ_MP ith th in EQ_MP (BETA_CONV(concl fth)) fth) ? failwith `SELECT_RULE`;; %< A1 |- t1 ==> t2 A2 |- t2 ==> t1 ----------------------------------------- A1 u A2 |- t1 = t2 let IMP_ANTISYM_RULE th1 th2 = (let t1,t2 = dest_imp(concl th1) in MP (MP (SPEC t2 (SPEC t1 IMP_ANTISYM_AX)) th1) th2 ) ? failwith `IMP_ANTISYM_RULE`;; >% % Modified: TFM 88.10.08 to use "union A1 A1" instead of A1 @ A2 % let IMP_ANTISYM_RULE th1 th2 = (let A1,(t1 ,t2) = ((I # dest_imp) o dest_thm) th1 and A2,(t2',t1') = ((I # dest_imp) o dest_thm) th2 in if aconv t1 t1' & aconv t2 t2' then fst(mk_thm(union A1 A2, mk_eq(t1,t2)), RecordStep(ImpAntisymRuleStep(th1,th2))) else fail ) ? failwith`IMP_ANTISYM_RULE`;; % A |- (!x. t1 = t2) --------------------------- A |- (?x.t1) = (?x.t2) let MK_EXISTS bodyth = (let x, sth = SPEC_VAR bodyth in let a,b = dest_eq (concl sth) in let abimp,baimp = EQ_IMP_RULE sth in let HALF (p,q) pqimp = (let xp = mk_exists(x,p) and xq = mk_exists(x,q) in DISCH xp (CHOOSE (x, ASSUME xp) (EXISTS (xq,x) (MP pqimp (ASSUME p))))) in IMP_ANTISYM_RULE (HALF (a,b) abimp) (HALF (b,a) baimp) ) ? failwith `MK_EXISTS`;; % let MK_EXISTS bodyth = (let x, body = dest_forall (concl bodyth) in let a,b = dest_eq body in fst(mk_thm (hyp bodyth, mk_eq (mk_exists(x,a), mk_exists(x,b))), RecordStep(MkExistsStep bodyth)) ) ? failwith `MK_EXISTS`;; % A |- t1 = t2 ------------------------------------------- (xi not free in A) A |- (?x1 ... xn. t1) = (?x1 ... xn. t2) % let LIST_MK_EXISTS l th = itlist (\x th. MK_EXISTS(GEN x th)) l th;; % ! abstraction A |- t1 = t2 ----------------------- A |- (!x.t1) = (!x.t2) % % Optimized: [TFM 90.06.27] % let FORALL_EQ = let bool_ty = mk_type(`bool`,[]) in let pred_ty ty = mk_type(`fun`,[ty;bool_ty]) in \x. let all = AP_TERM (mk_const(`!`,pred_ty(pred_ty(type_of x)))) in \th. all (ABS x th) ? failwith `FORALL_EQ`;; % ? abstraction A |- t1 = t2 ----------------------- A |- (?x.t1) = (?x.t2) Optimized: [TFM 92.05.11] let EXISTS_EQ x th = (let t1,t2 = dest_eq(concl th) in AP_TERM "$?:(^(type_of x)->bool)->bool" (ABS x th) ) ? failwith `EXISTS_EQ`;; % let EXISTS_EQ = let bool_ty = mk_type(`bool`,[]) in let pred_ty ty = mk_type(`fun`,[ty;bool_ty]) in \x. let ex = AP_TERM (mk_const(`?`,pred_ty(pred_ty(type_of x)))) in \th. ex (ABS x th) ? failwith `EXISTS_EQ`;; % @ abstraction A |- t1 = t2 ----------------------- A |- (@x.t1) = (@x.t2) [Optimised by JG 92.04.24] % let SELECT_EQ = let bool_ty = mk_type(`bool`,[]) in (\x th. let ty = type_of x in AP_TERM (mk_const (`@`, mk_type (`fun`, [mk_type (`fun`, [ty; bool_ty]); ty]))) (ABS x th) ) ? failwith `SELECT_EQ`;; % A1 |- t1 == u1 ... An |- tn = un A |- t[ti] ------------------------------------------------------- A1 u ... An u A |- t[ui] let GSUBS substfn ths th = let ls = map (lhs o concl) ths in let vars = map (genvar o type_of) ls in let w = substfn (combine(vars,ls)) (concl th) in SUBST (combine(ths,vars)) w th;; % % --------------------------------------------------------------------- % % GSUBS made local: [TFM 90.07.02] % % --------------------------------------------------------------------- % let (SUBS,SUBS_OCCS) = let GSUBS substfn ths th = let instl = map (\th. let (x,y) = dest_eq (concl th) in (y,x)) ths and hyps = hyp_union (th . ths) in mk_thm (hyps, substfn instl (concl th)) in ((\ths th. (fst((GSUBS subst ths th), RecordStep(SubsStep(ths,th))) ? failwith `SUBS`)), (\nlths th. (let nll, ths = split nlths in fst((GSUBS (subst_occs nll) ths th), RecordStep(SubsOccsStep(nlths,th))) ? failwith `SUBS_OCCS`)));; % A |- ti == ui -------------------- A |- t[ti] = t[ui] let SUBST_CONV thvars template tm = SUBST thvars "^tm = ^template" (REFL tm) ? failwith `SUBST_CONV`;; % let SUBST_CONV thvars template tm = (let ths,vars = split thvars in let ls, rs = split (map (dest_eq o concl) ths) in if aconv (subst (combine(ls,vars)) template) tm then fst(mk_thm(hyp_union ths, mk_eq(tm,subst(combine(rs,vars))template)), RecordStep(SubstConvStep(thvars,template,tm))) else fail ) ? failwith `SUBST_CONV`;; % Beta-conversion to the rhs of an equation A |- t1 = (\x.t2)t3 -------------------- A |- t1 = t2[t3/x] % let RIGHT_BETA th = TRANS th (BETA_CONV(snd(dest_eq(concl th)))) ? failwith `RIGHT_BETA`;; % "(\x1 ... xn.t)t1 ... tn" --> |- (\x1 ... xn.t)t1 ... tn = t[t1/x1] ... [tn/xn] % letrec LIST_BETA_CONV tm = (let rat,rnd = dest_comb tm in RIGHT_BETA(AP_THM(LIST_BETA_CONV rat)rnd) ) ? REFL tm;; let RIGHT_LIST_BETA th = TRANS th (LIST_BETA_CONV(snd(dest_eq(concl th))));; % |- !t1 t2. t1 ==> t2 ==> t1 /\ t2 % let AND_INTRO_THM = let t,t1,t2 = "t:bool","t1:bool","t2:bool" in let t12 = "^t1 ==> ^t2 ==> ^t" in let th1 = GEN t (DISCH t12 (MP (MP (ASSUME t12) (ASSUME t1)) (ASSUME t2))) in let th2 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM AND_DEF t1)) t2) in GEN t1 (GEN t2 (DISCH t1 (DISCH t2 (EQ_MP (SYM th2) th1))));; % Conjunction introduction rule A1 |- t1 , A2 |- t2 ----------------------- A1 u A2 |- t1 /\ t2 let CONJ th1 th2 = MP (MP (SPEC (concl th2) (SPEC (concl th1) AND_INTRO_THM)) th1) th2;; % let CONJ th1 th2 = fst(mk_thm(union(hyp th1) (hyp th2), mk_conj(concl th1, concl th2)), RecordStep(ConjStep(th1,th2)));; % |- !t1 t2. t1 /\ t2 ==> t1 % let AND1_THM = let t1,t2 = "t1:bool","t2:bool" in let th1 = ASSUME "^t1 /\ ^t2" in let th2 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM AND_DEF t1)) t2) in let th3 = SPEC t1 (EQ_MP th2 th1) in let th4 = DISCH t1 (DISCH t2 (ADD_ASSUM t2 (ASSUME t1))) in GEN t1 (GEN t2 (DISCH "^t1 /\ ^t2" (MP th3 th4)));; % Left conjunct extraction A |- t1 /\ t2 ------------- A |- t1 let CONJUNCT1 th = (let t1,t2 = dest_conj(concl th) in MP (SPEC t2 (SPEC t1 AND1_THM)) th ) ? failwith `CONJUNCT1`;; % let CONJUNCT1 th = fst(mk_thm(hyp th, fst(dest_conj(concl th))), RecordStep(Conjunct1Step th)) ? failwith `CONJUNCT1`;; % |- !t1 t2. t1 /\ t2 ==> t2 % let AND2_THM = let t1,t2 = "t1:bool","t2:bool" in let th1 = ASSUME "^t1 /\ ^t2" in let th2 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM AND_DEF t1)) t2) in let th3 = SPEC t2 (EQ_MP th2 th1) in let th4 = DISCH t1 (DISCH t2 (ADD_ASSUM t1 (ASSUME t2))) in GEN t1 (GEN t2 (DISCH "^t1 /\ ^t2" (MP th3 th4)));; % Right conjunct extraction A |- t1 /\ t2 ------------- A |- t2 let CONJUNCT2 th = (let t1,t2 = dest_conj(concl th) in MP (SPEC t2 (SPEC t1 AND2_THM)) th ) ? failwith `CONJUNCT2`;; % let CONJUNCT2 th = fst(mk_thm(hyp th, snd(dest_conj(concl th))), RecordStep(Conjunct2Step th)) ? failwith `CONJUNCT2`;; % |- !t1 t2. (t1 /\ t2) = (t2 /\ t1) % let CONJ_SYM = let t1,t2 = "t1:bool","t2:bool" in let th1 = ASSUME "^t1 /\ ^t2" and th2 = ASSUME "^t2 /\ ^t1" in GEN t1 (GEN t2 (IMP_ANTISYM_RULE (DISCH "^t1 /\ ^t2" (CONJ(CONJUNCT2 th1)(CONJUNCT1 th1))) (DISCH "^t2 /\ ^t1" (CONJ(CONJUNCT2 th2)(CONJUNCT1 th2)))));; % |- !t1 t2 t3. t1 /\ (t2 /\ t3) = (t1 /\ t2) /\ t3 % let CONJ_ASSOC = let t1,t2,t3 = "t1:bool","t2:bool","t3:bool" in let th1 = ASSUME "^t1 /\ (^t2 /\ ^t3)" and th2 = ASSUME "(^t1 /\ ^t2) /\ ^t3" in let th3 = DISCH "^t1 /\ (^t2 /\ ^t3)" (CONJ (CONJ(CONJUNCT1 th1)(CONJUNCT1(CONJUNCT2 th1))) (CONJUNCT2(CONJUNCT2 th1))) and th4 = DISCH "(^t1 /\ ^t2) /\ ^t3" (CONJ (CONJUNCT1(CONJUNCT1 th2)) (CONJ(CONJUNCT2(CONJUNCT1 th2))(CONJUNCT2 th2))) in GEN t1 (GEN t2 (GEN t3 (IMP_ANTISYM_RULE th3 th4)));; % |- t1 = t2 if t1 and t2 are equivalent using idempotence, symetry and associativity of /\. I have not (yet) coded a genuine derivation - it would be straightforward, but tedious. let CONJUNCTS_CONV(t1,t2) = if set_equal(conjuncts t1)(conjuncts t2) then mk_thm([],mk_eq(t1,t2)) else failwith `CONJUNCTS_CONV`;; Genuine derivation added [RJB 15th August 1991]: % let CONJUNCTS_CONV (t1,t2) = letrec CONJUNCTS th = (CONJUNCTS (CONJUNCT1 th) @ CONJUNCTS (CONJUNCT2 th)) ? [th] in letrec build_conj thl t = (let l,r = dest_conj t in CONJ (build_conj thl l) (build_conj thl r) ) ? find (\th. (concl th) = t) thl in (IMP_ANTISYM_RULE (DISCH t1 (build_conj (CONJUNCTS (ASSUME t1)) t2)) (DISCH t2 (build_conj (CONJUNCTS (ASSUME t2)) t1)) ) ? failwith `CONJUNCTS_CONV`;; % |- (t1 /\ ... /\ tn) = (t1' /\ ... /\ tn') where {t1,...,tn}={t1',...,tn'} The genuine derived rule below only works if its argument lists are the same length. letrec CONJ_SET_CONV l1 l2 = (if l1 = l2 then REFL(list_mk_conj l1) if hd l1 = hd l2 then AP_TERM "$/\ ^(hd l1)" (CONJ_SET_CONV(tl l1)(tl l2)) else (let th1 = SYM(FRONT_CONJ_CONV l2 (hd l1)) in let l2' = conjuncts(lhs(concl th1)) in let th2 = AP_TERM "$/\ ^(hd l1)" (CONJ_SET_CONV(tl l1)(tl l2')) in th2 TRANS th1) ) ? failwith`CONJ_SET_CONV`;; Unsafe version: let CONJ_SET_CONV l1 l2 = (if set_equal l1 l2 then mk_thm([],mk_eq(list_mk_conj l1, list_mk_conj l2)) else fail ) ? failwith `CONJ_SET_CONV`;; New implementation uses CONJUNCTS_CONV [RJB 15th August 1991]: % let CONJ_SET_CONV l1 l2 = CONJUNCTS_CONV (list_mk_conj l1, list_mk_conj l2) ? failwith `CONJ_SET_CONV`;; % |- (t1 /\ ... /\ t /\ ... /\ tn) = (t /\ t1 /\ ... /\ tn) Old implementation: letrec FRONT_CONJ_CONV tml t = (if t = hd tml then REFL(list_mk_conj tml) if null(tl(tl tml)) & t = hd(tl tml) then SPECL tml CONJ_SYM else (let th1 = AP_TERM "$/\ ^(hd tml)" (FRONT_CONJ_CONV (tl tml) t) in let t1,(t2,t3) = ((I # dest_conj) o dest_conj)(rhs(concl th1)) in let th2 = AP_THM(AP_TERM "$/\"(SPECL[t1;t2]CONJ_SYM))t3 in th1 TRANS (SPECL[t1;t2;t3]CONJ_ASSOC) TRANS th2 TRANS (SYM(SPECL[t2;t1;t3]CONJ_ASSOC))) ) ? failwith `FRONT_CONJ_CONV`;; New implementation using CONJ_SET_CONV: % let FRONT_CONJ_CONV tml t = letrec remove x l = if ((hd l) = x) then tl l else (hd l).(remove x (tl l)) in (CONJ_SET_CONV tml (t.(remove t tml))) ? failwith `FRONT_CONJ_CONV`;; % A,t |- t1 = t2 ----------------------------- A |- (t /\ t1) = (t /\ t2) % let CONJ_DISCH t th = (let t1,t2 = dest_eq(concl th) and th1 = DISCH t th in let th2 = ASSUME "^t /\ ^t1" and th3 = ASSUME "^t /\ ^t2" in let th4 = DISCH "^t /\ ^t1" (CONJ (CONJUNCT1 th2) (EQ_MP(MP th1 (CONJUNCT1 th2))(CONJUNCT2 th2))) and th5 = DISCH "^t /\ ^t2" (CONJ (CONJUNCT1 th3) (EQ_MP(SYM(MP th1 (CONJUNCT1 th3)))(CONJUNCT2 th3))) in IMP_ANTISYM_RULE th4 th5) ? failwith `CONJ_DISCH`;; % A,t1,...,tn |- t = u -------------------------------------------------------- A |- (t1 /\ ... /\ tn /\ t) = (t1 /\ ... /\ tn /\ u) % letrec CONJ_DISCHL l th = if null l then th else CONJ_DISCH (hd l) (CONJ_DISCHL (tl l) th);; % |- !t1 t2. t1 ==> t1 \/ t2 % let OR_INTRO_THM1 = let t,t1,t2 = "t:bool","t1:bool","t2:bool" in let th1 = ADD_ASSUM "^t2 ==> ^t" (MP (ASSUME "^t1 ==> ^t") (ASSUME t1)) in let th2 = GEN t (DISCH "^t1 ==> ^t" (DISCH "^t2 ==> ^t" th1)) in let th3 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM OR_DEF t1)) t2) in GEN t1 (GEN t2 (DISCH t1 (EQ_MP (SYM th3) th2)));; % Left disjunction introduction A |- t1 --------------- A |- t1 \/ t2 let DISJ1 th t2 = MP (SPEC t2 (SPEC (concl th) OR_INTRO_THM1)) th ? failwith `DISJ1`;; % let DISJ1 th w = fst(mk_thm(hyp th, mk_disj(concl th, w)), RecordStep(Disj1Step(th,w))) ? failwith `DISJ1`;; % |- !t1 t2. t2 ==> t1 \/ t2 % let OR_INTRO_THM2 = let t,t1,t2 = "t:bool","t1:bool","t2:bool" in let th1 = ADD_ASSUM "^t1 ==> ^t" (MP (ASSUME "^t2 ==> ^t") (ASSUME t2)) in let th2 = GEN t (DISCH "^t1 ==> ^t" (DISCH "^t2 ==> ^t" th1)) in let th3 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM OR_DEF t1)) t2) in GEN t1 (GEN t2 (DISCH t2 (EQ_MP (SYM th3) th2)));; % Right disjunction introduction A |- t2 --------------- A |- t1 \/ t2 let DISJ2 t1 th = MP (SPEC (concl th) (SPEC t1 OR_INTRO_THM2)) th ? failwith `DISJ2`;; % let DISJ2 w th = fst(mk_thm(hyp th, mk_disj(w, concl th)), RecordStep(Disj2Step(w,th))) ? failwith `DISJ2`;; % |- !t t1 t2. (t1 \/ t2) ==> (t1 ==> t) ==> (t2 ==> t) ==> t % let OR_ELIM_THM = let t,t1,t2 = "t:bool","t1:bool","t2:bool" in let th1 = ASSUME "^t1 \/ ^t2" and th2 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM OR_DEF t1)) t2) in let th3 = SPEC t (EQ_MP th2 th1) in let th4 = MP (MP th3 (ASSUME "^t1 ==> ^t")) (ASSUME "^t2 ==> ^t") in let th4 = DISCH "^t1 ==> ^t" (DISCH "^t2 ==> ^t" th4) in GEN t (GEN t1 (GEN t2 (DISCH "^t1 \/ ^t2" th4)));; % Disjunction elimination A |- t1 \/ t2 , A1,t1 |- t , A2,t2 |- t ----------------------------------------------- A u A1 u A2 |- t let DISJ_CASES th1 th2 th3 = (let t1,t2 = dest_disj(concl th1) and t = concl th2 in let th4 = SPEC t2 (SPEC t1 (SPEC t OR_ELIM_THM)) in MP (MP (MP th4 th1) (DISCH t1 th2)) (DISCH t2 th3) ) ? failwith `DISJ_CASES`;; % let DISJ_CASES dth ath bth = if is_disj (concl dth) & aconv (concl ath) (concl bth) then let lw,rw = dest_disj (concl dth) in fst(mk_thm (union (hyp dth) (union (disch(lw, hyp ath)) (disch(rw, hyp bth))), concl ath), RecordStep(DisjCasesStep(dth,ath,bth))) else failwith `DISJ_CASES`;; % --------------------------------------------------------------------- % % |- !t1 t2. (t1 <=> t2) ==> (t1=t2) DELETED [TFM 91.01.20] % % % % let IFF_EQ_THM1 = % % let t1,t2 = "t1:bool","t2:bool" % % in % % let th1 = ASSUME "$<=> ^t1 ^t2" % % and th2 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM IFF_DEF t1)) t2) % % and th3 = SPEC t2 (SPEC t1 IMP_ANTISYM_AX) % % in % % let th4 = EQ_MP th2 th1 % % in % % let th5 = MP (MP th3 (CONJUNCT1 th4)) (CONJUNCT2 th4) % % in % % GEN t1 (GEN t2 (DISCH "$<=> ^t1 ^t2" th5));; % % % % % % |- !t1 t2. (t1=t2) ==> (t1<=>t2) DELETED [TFM 91.01.20] % % % % let IFF_EQ_THM2 = % % let t1,t2 = "t1:bool","t2:bool" % % in % % let th1 = DISCH t1 (EQ_MP (ASSUME "$= ^t1 ^t2") (ASSUME t1)) % % and th2 = DISCH t2 (EQ_MP (SYM(ASSUME "$= ^t1 ^t2")) (ASSUME t2)) % % and th3 = RIGHT_BETA(AP_THM (RIGHT_BETA(AP_THM IFF_DEF t1)) t2) % % in % % GEN t1 (GEN t2 (DISCH "$= ^t1 ^t2" % % (EQ_MP (SYM th3) (CONJ th1 th2))));; % % % % |- !t1 t2. (t1 <=> t2) = (t1=t2) DELETED [TFM 91.01.20] % % % % let IFF_EQ = % % let t1,t2 = "t1:bool","t2:bool" % % in % % let th1 = SPEC "$= ^t1 ^t2" (SPEC "$<=> ^t1 ^t2" IMP_ANTISYM_AX) % % in % % let th2 = MP th1 (SPEC t2 (SPEC t1 IFF_EQ_THM1)) % % in % % GEN t1 (GEN t2 (MP th2 (SPEC t2 (SPEC t1 IFF_EQ_THM2))));; % % % % IFF to EQ DELETED [TFM 91.01.20] % % % % A |- t1 <=> t2 % % ---------------- % % A |- t1 = t2 % % % % let IFF_EQ_RULE th = % % (let t1,t2 = dest_iff(concl th) % % in % % EQ_MP (SPEC t2 (SPEC t1 IFF_EQ)) th % % ) ? failwith`IFF_EQ_RULE`;; % % --------------------------------------------------------------------- % % |- !t. F ==> t % let FALSITY = let t = "t:bool" in GEN t (DISCH "F" (SPEC t (EQ_MP F_DEF (ASSUME "F"))));; % |- !t.(t ==> F) ==> ~t % let IMP_F = let t = "t:bool" in let th1 = RIGHT_BETA(AP_THM NOT_DEF t) in GEN t (DISCH "^t ==> F" (EQ_MP (SYM th1) (ASSUME "^t ==> F")));; % NOT introduction A |- t ==> F ------------ A |- ~t let NOT_INTRO th = (let t,() = dest_imp(concl th) in MP (SPEC t IMP_F) th ) ? failwith `NOT_INTRO`;; % let NOT_INTRO th = (let t,tf = dest_imp(concl th) in if tf=falsity then fst(mk_thm(hyp th,"~^t"), RecordStep(NotIntroStep th)) else fail ) ? failwith `NOT_INTRO`;; % A,t1 |- t2 A,t |- F -------------- -------- A |- t1 ==> t2 A |- ~t % let NEG_DISCH t th = (if concl th = falsity then NOT_INTRO(DISCH t th) else DISCH t th) ? failwith`NEG_DISCH`;; % |- !t. ~t ==>(t ==> F) % let F_IMP = let t = "t:bool" in let th1 = RIGHT_BETA(AP_THM NOT_DEF t) in GEN t (DISCH "~ ^t" (EQ_MP th1 (ASSUME "~ t")));; % ADDED by WW 24 Jan 1994. Implementing the old MP rule % let NOT_MP = \thi th. (MP thi th) ? (let t = dest_neg (concl thi) in MP(MP (SPEC t F_IMP) thi) th) ? failwith `NOT_MP`;; % Undischarging A |- t1==> t2 ------------- A, t1 |- t2 % let UNDISCH th = NOT_MP th (ASSUME(fst(dest_neg_imp(concl th)))) ? failwith `UNDISCH`;; % Negation elimination A |- ~ t -------------- A |- t ==> F let NOT_ELIM th = (let (),t = dest_comb(concl th) in MP (SPEC t F_IMP) th ) ? failwith `NOT_ELIM`;; % let NOT_ELIM th = (let not_tm,t = dest_comb(concl th) in if fst(dest_const not_tm) = `~` then fst(mk_thm(hyp th, mk_imp(t,falsity)),RecordStep(NotElimStep th)) else fail ) ? failwith `NOT_ELIM`;; % A |- ~(t1 = t2) ----------------- A |- ~(t2 = t1) OLD_CODE: using special behavior of MP. CHANGED by WW 24 Jan 94 let NOT_EQ_SYM th = (let t = (mk_eq o (\(x,y).(y,x)) o dest_eq o dest_neg o concl) th in MP (SPEC t IMP_F) (DISCH t (MP th (SYM(ASSUME t))))) ? failwith `NOT_EQ_SYM`;; % let NOT_EQ_SYM th = (let t = (mk_eq o (\(x,y).(y,x)) o dest_eq o dest_neg o concl) th in MP (SPEC t IMP_F) (DISCH t (MP (NOT_ELIM th) (SYM(ASSUME t))))) ? failwith `NOT_EQ_SYM`;; % --------------------------------------------------------------------- % % AND_CLAUSES: proof rewritten to make clauses 1-5 local % % % % |- !t. (T /\ t) = t /\ % % (t /\ T) = t /\ % % (F /\ t) = F /\ % % (t /\ F) = F /\ % % (t /\ t) = t TFM 90.04.18 % % --------------------------------------------------------------------- % let AND_CLAUSES = let t = "t:bool" in let cl1 = % (T /\ t) = t % let th1 = DISCH "T /\ ^t" (CONJUNCT2(ASSUME "T /\ ^t")) and th2 = DISCH t (CONJ TRUTH (ASSUME t)) in (IMP_ANTISYM_RULE th1 th2) and cl2 = % (t /\ T) = t % let th1 = DISCH "^t /\ T" (CONJUNCT1(ASSUME "^t /\ T")) and th2 = DISCH t (CONJ (ASSUME t) TRUTH) in (IMP_ANTISYM_RULE th1 th2) and cl3 = % (F /\ t) = F % let th1 = IMP_TRANS (SPEC t (SPEC "F" AND1_THM)) (SPEC "F" FALSITY) and th2 = SPEC "F /\ ^t" FALSITY in (IMP_ANTISYM_RULE th1 th2) and cl4 = % (t /\ F) = F % let th1 = IMP_TRANS (SPEC "F" (SPEC t AND2_THM)) (SPEC "F" FALSITY) and th2 = SPEC "^t /\ F" FALSITY in (IMP_ANTISYM_RULE th1 th2) and cl5 = % (t /\ t) = t % let th1 = DISCH "^t /\ ^t" (CONJUNCT1(ASSUME "^t /\ ^t")) and th2 = DISCH t (CONJ(ASSUME t)(ASSUME t)) in (IMP_ANTISYM_RULE th1 th2) in GEN t (end_itlist CONJ [cl1;cl2;cl3;cl4;cl5]);; % --------------------------------------------------------------------- % % OR_CLAUSES: proof rewritten to make clauses 1-5 local % % % % |- !t. (T \/ t) = T /\ % % (t \/ T) = T /\ % % (F \/ t) = t /\ % % (t \/ F) = t /\ % % (t \/ t) = t TFM 90.04.20 % % --------------------------------------------------------------------- % let OR_CLAUSES = let t = "t:bool" in let cl1 = % (T \/ t) = T % let th1 = DISCH "T \/ ^t" TRUTH and th2 = DISCH "T" (DISJ1 TRUTH t) in (IMP_ANTISYM_RULE th1 th2) and cl2 = % (t \/ T) = T % let th1 = DISCH "^t \/ T" TRUTH and th2 = DISCH "T" (DISJ2 t TRUTH) in (IMP_ANTISYM_RULE th1 th2) and cl3 = % (F \/ t) = t % let th1 = DISCH "F \/ ^t" (DISJ_CASES (ASSUME "F \/ ^t") (UNDISCH (SPEC t FALSITY)) (ASSUME t)) and th2 = SPEC t (SPEC "F" OR_INTRO_THM2) in (IMP_ANTISYM_RULE th1 th2) and cl4 = % (t \/ F) = t % let th1 = DISCH "^t \/ F" (DISJ_CASES (ASSUME "^t \/ F") (ASSUME t) (UNDISCH (SPEC t FALSITY))) and th2 = SPEC "F" (SPEC t OR_INTRO_THM1) in (IMP_ANTISYM_RULE th1 th2) and cl5 = % (t \/ t) = t % let th1 = DISCH "^t \/ ^t" (DISJ_CASES(ASSUME"^t\/^t")(ASSUME t)(ASSUME t)) and th2 = DISCH t (DISJ1(ASSUME t)t) in (IMP_ANTISYM_RULE th1 th2) in GEN t (end_itlist CONJ [cl1;cl2;cl3;cl4;cl5]);; % --------------------------------------------------------------------- % % IMP_CLAUSES: proof rewritten to make clauses 1-5 local % % % % |- !t. (T ==> t) = t /\ % % (t ==> T) = T /\ % % (F ==> t) = T /\ % % (t ==> t) = T /\ % % (t ==> F) = ~t TFM 90.04.20 % % --------------------------------------------------------------------- % let IMP_CLAUSES = let t = "t:bool" in let cl1 = % (T ==> t) = t % let th1 = DISCH "T ==> ^t" (MP (ASSUME "T ==> ^t") TRUTH) and th2 = DISCH t (DISCH "T" (ADD_ASSUM "T" (ASSUME t))) and th3 = SPEC t (SPEC "T ==> ^t" IMP_ANTISYM_AX) in (MP (MP th3 th1) th2) and cl2 = % (F ==> t) = T % (EQT_INTRO(SPEC t FALSITY)) and cl3 = % (t ==> T) = T % (EQT_INTRO(DISCH t (ADD_ASSUM t TRUTH))) and cl4 = % (t ==> t) = T % (EQT_INTRO(DISCH t (ASSUME t))) and cl5 = % (t ==> F) = ~t % let th1 = SPEC t IMP_F and th2 = SPEC t F_IMP in (IMP_ANTISYM_RULE th1 th2) in GEN t (end_itlist CONJ [cl1;cl3;cl2;cl4;cl5]);; % Contradiction rule A |- F ------ A |- t let CONTR tm th = MP (SPEC tm FALSITY) th ? failwith `CONTR`;; % let CONTR w fth = if concl fth = falsity then fst(mk_thm(hyp fth, w), RecordStep(ContrStep(w,fth))) else failwith `CONTR`;; % --------------------------------------------------------------------- % % EQF_INTRO: inference rule for introducing equality with "F". % % % % ~tm % % ----------- EQF_INTRO % % tm = F % % % % [TFM 90.05.08] % % --------------------------------------------------------------------- % let EQF_INTRO = let F = "F" and Fth = ASSUME "F" in \th. (let body = dest_neg(concl th) in IMP_ANTISYM_RULE (NOT_ELIM th) (DISCH F (CONTR body Fth))) ? failwith `EQF_INTRO: argument theorem not a negation`;; % --------------------------------------------------------------------- % % EQF_ELIM: inference rule for eliminating equality with "F". % % % % |- tm = F % % ----------- EQF_ELIM % % |- ~ tm % % % % [TFM 90.08.23] % % --------------------------------------------------------------------- % let EQF_ELIM = let check = assert ((curry $= `F`) o fst o dest_const) in \th. (let body,_ = (I # check) (dest_eq(concl th)) in NOT_INTRO(DISCH body (EQ_MP th (ASSUME body)))) ? failwith `EQF_ELIM: argument theorem not of the form |- tm = F`;; % --------------------------------------------------------------------- % % EXCLUDED_MIDDLE: |- !t. t \/ ~t % % --------------------------------------------------------------------- % let EXCLUDED_MIDDLE = let t = "t:bool" in let th1 = RIGHT_BETA(AP_THM NOT_DEF t) in let th2 = DISJ1 (EQT_ELIM(ASSUME "^t = T")) "~^t" and th3 = DISJ2 t (EQ_MP(SYM th1)(DISCH t(EQ_MP(ASSUME "^t = F")(ASSUME t)))) in GEN t (DISJ_CASES (SPEC t BOOL_CASES_AX) th2 th3);; % Classical contradiction rule A,"~t" |- F -------------- A |- t let CCONTR t th = (let th1 = RIGHT_BETA(AP_THM NOT_DEF t) and v = genvar ":bool" in let th2 = EQT_ELIM(ASSUME "^t = T") in let th3 = SUBST [th1,v] "^v ==> F" (DISCH "~ ^t" th) in let th4 = SUBST [ASSUME "^t = F",v] "(^v ==> F)==>F" th3 in let th5 = MP th4 (EQT_ELIM (el 3 (CONJUNCTS (SPEC "F" IMP_CLAUSES)))) in let th6 = EQ_MP (SYM(ASSUME "^t = F")) th5 in DISJ_CASES (SPEC t BOOL_CASES_AX) th2 th6 ) ? failwith `CCONTR`;; % let CCONTR w fth = if concl fth = falsity then fst(mk_thm(disch(mk_neg w, hyp fth), w), RecordStep(CcontrStep(w,fth))) else failwith `CCONTR`;; % Instantiate variables in a theorem % % var changed to v, for version 1.12 [TFM 90.06.06] % let INST inst_list th = if null inst_list then th else (let asl,w = dest_thm th and vars = map (assert is_var o snd) inst_list in if exists (\v. exists (free_in v) asl) vars then fail else fst(mk_thm(asl, subst inst_list w), RecordStep(InstStep(inst_list,th))) ) ? failwith `INST`;; % New version that may be added later; code supplied by Elsa Gunter. letrec COUNT_UNDISCH n thm = if n = 0 then thm else COUNT_UNDISCH (n -1) (UNDISCH thm);; let INST inst_list th = let num_hyp = length (hyp th) and gen_list = map (GEN o snd) inst_list and spec_list = map (SPEC o fst) inst_list in COUNT_UNDISCH num_hyp (itlist B (itlist B (DISCH_ALL th) gen_list) spec_list);; let INST inst_list th = if null inst_list then th else let asl,w = dest_thm th in mk_thm((map (subst inst_list) asl), subst inst_list w);; % % --------------------------------------------------------------------- % % Make a theorem that assumes falsity A legitimate way for the user to % % make a theorem of (almost) any form, for testing of derived inference % % rules. Most rules won't notice the extra assumption, strong though % % it is. % % % % MJCG 17/1/89 for HOL88. mk_fthm not used; see comment in tacticals.ml % % % % let mk_fthm (asl,w) = mk_thm(falsity . asl, w);; % % % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % IFF introduction DELETED [TFM 91.01.20] % % % % A |- (t1 ==> t2) /\ (t2 ==> t1) % % -------------------------------------- % % A |- t1 <=> t2 % % % % % % let CONJ_IFF th = % % (let lw, rw = dest_conj (concl th) in % % let la,lc = dest_imp lw % % and ra,rc = dest_imp rw in % % if aconv la rc & aconv lc ra % % then mk_thm (hyp th, mk_iff(la,lc)) % % else fail) % % ? failwith `CONJ_IFF`;; % % % % IFF elimination % % % % A |- t1 <=> t2 % % ----------------------------------- % % A |- (t1 ==> t2) /\ (t2 ==> t1) % % % % % % let IFF_CONJ th = % % (let lw,rw = dest_iff (concl th) in % % mk_thm(hyp th, mk_conj(mk_imp(lw,rw), mk_imp(rw,lw)))) % % ? failwith `IFF_CONJ`;; % % --------------------------------------------------------------------- % % |- !t. ~t ==> (t=F) % let NOT_F = let t = "t:bool" in let th1 = MP (SPEC t F_IMP) (ASSUME "~ ^t") and th2 = SPEC t FALSITY and th3 = SPEC "F" (SPEC t IMP_ANTISYM_AX) in GEN t (DISCH "~ ^t" (MP (MP th3 th1) th2));; % |- !t. ~(t /\ ~t) % let NOT_AND = let th = ASSUME "t /\ ~t" in NOT_INTRO(DISCH "t /\ ~t" (NOT_MP(CONJUNCT2 th)(CONJUNCT1 th)));; % --------------------------------------------------------------------- % % EXPAND_TY_DEF : code deleted (TFM 90.04.10) % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % OR_IMP_THM = |- !t1 t2. (t1 = t2 \/ t1) = (t2 ==> t1) [TFM 90.06.28] % % --------------------------------------------------------------------- % let OR_IMP_THM = let t1 = "t1:bool" and t2 = "t2:bool" in let asm1 = ASSUME "^t1 = (^t2 \/ ^t1)" and asm2 = EQT_INTRO(ASSUME t2) in let th1 = SUBST [asm2,t2] (concl asm1) asm1 in let th2 = TRANS th1 (CONJUNCT1 (SPEC t1 OR_CLAUSES)) in let imp1 = DISCH (concl asm1) (DISCH t2 (EQT_ELIM th2)) in let asm3 = ASSUME "^t2 ==> ^t1" and asm4 = ASSUME "^t2 \/ ^t1" in let th3 = DISJ_CASES asm4 (MP asm3 (ASSUME t2)) (ASSUME t1) in let th4 = DISCH (concl asm4) th3 and th5 = DISCH t1 (DISJ2 t2 (ASSUME t1)) in let imp2 = DISCH "^t2 ==> ^t1" (IMP_ANTISYM_RULE th5 th4) in GEN t1 (GEN t2 (IMP_ANTISYM_RULE imp1 imp2));; % --------------------------------------------------------------------- % % NOT_IMP = |- !t1 t2. ~(t1 ==> t2) = t1 /\ ~t2 [TFM 90.07.09] % % --------------------------------------------------------------------- % let NOT_IMP = let t1 = "t1:bool" and t2 = "t2:bool" in let asm1 = ASSUME "~ (^t1 ==> ^t2)" in let thm1 = SUBST [EQF_INTRO (ASSUME (mk_neg t1)),t1] (concl asm1) asm1 in let thm2 = CCONTR t1 (NOT_MP thm1 (DISCH "F" (CONTR t2 (ASSUME "F")))) in let thm3 = SUBST [EQT_INTRO (ASSUME t2),t2] (concl asm1) asm1 in let thm4 = NOT_INTRO(DISCH t2(NOT_MP thm3(DISCH t1(ADD_ASSUM t1 TRUTH))))in let imp1 = DISCH (concl asm1) (CONJ thm2 thm4) in let conj = ASSUME "^t1 /\ ~ ^t2" in let asm2,asm3 = (CONJUNCT1 conj, CONJUNCT2 conj) in let asm4 = ASSUME "^t1 ==> ^t2" in let thm5 = MP (SUBST [EQF_INTRO asm3,t2] (concl asm4) asm4) asm2 in let imp2 = DISCH "^t1 /\ ~ ^t2" (NOT_INTRO(DISCH "^t1 ==> ^t2" thm5)) in GEN t1 (GEN t2 (IMP_ANTISYM_RULE imp1 imp2));; % --------------------------------------------------------------------- % % DISJ_ASSOC: |- !t1 t2 t3. t1 \/ t2 \/ t3 = (t1 \/ t2) \/ t3 % % --------------------------------------------------------------------- % let DISJ_ASSOC = let t1 = "t1:bool" and t2 = "t2:bool" and t3 = "t3:bool" in let at1 = DISJ1 (DISJ1 (ASSUME t1) t2) t3 and at2 = DISJ1 (DISJ2 t1 (ASSUME t2)) t3 and at3 = DISJ2 (mk_disj(t1,t2)) (ASSUME t3) in let thm = DISJ_CASES (ASSUME (mk_disj(t2,t3))) at2 at3 in let thm1 = DISJ_CASES (ASSUME (mk_disj(t1,mk_disj(t2,t3)))) at1 thm in let at1 = DISJ1 (ASSUME t1) (mk_disj(t2,t3)) and at2 = DISJ2 t1 (DISJ1 (ASSUME t2) t3) and at3 = DISJ2 t1 (DISJ2 t2 (ASSUME t3)) in let thm = DISJ_CASES (ASSUME (mk_disj(t1,t2))) at1 at2 in let thm2 = DISJ_CASES (ASSUME (mk_disj(mk_disj(t1,t2),t3))) thm at3 in let imp1 = DISCH (mk_disj(t1,mk_disj(t2,t3))) thm1 and imp2 = DISCH (mk_disj(mk_disj(t1,t2),t3)) thm2 in GENL [t1;t2;t3] (IMP_ANTISYM_RULE imp1 imp2);; % --------------------------------------------------------------------- % % DISJ_SYM: |- !t1 t2. t1 \/ t2 = t2 \/ t1 % % --------------------------------------------------------------------- % let DISJ_SYM = let t1 = "t1:bool" and t2 = "t2:bool" in let th1 = DISJ1 (ASSUME t1) t2 and th2 = DISJ2 t1 (ASSUME t2) in let thm1 = DISJ_CASES (ASSUME(mk_disj(t2,t1))) th2 th1 in let th1 = DISJ1 (ASSUME t2) t1 and th2 = DISJ2 t2 (ASSUME t1) in let thm2 = DISJ_CASES (ASSUME(mk_disj(t1,t2))) th2 th1 in let imp1 = DISCH (mk_disj(t2,t1)) thm1 and imp2 = DISCH (mk_disj(t1,t2)) thm2 in GENL [t1;t2] (IMP_ANTISYM_RULE imp2 imp1);; % --------------------------------------------------------------------- % % DE_MORGAN_THM: % % |- !t1 t2.(~(t1 /\ t2) = ~t1 \/ ~t2) /\ (~(t1 \/ t2) = ~t1 /\ ~t2) % % --------------------------------------------------------------------- % let DE_MORGAN_THM = let t1 = "t1:bool" and t2 = "t2:bool" in let thm1 = let asm1 = ASSUME "~(^t1 /\ ^t2)" in let cnj = NOT_MP asm1 (CONJ (ASSUME t1) (ASSUME t2)) in let imp1 = let case1 = DISJ2 "~^t1" (NOT_INTRO(DISCH t2 cnj)) in let case2 = DISJ1 (ASSUME "~ ^t1") "~ ^t2" in DISJ_CASES (SPEC t1 EXCLUDED_MIDDLE) case1 case2 in let th1 = NOT_MP (ASSUME "~^t1") (CONJUNCT1 (ASSUME "^t1 /\ ^t2")) and th2 = NOT_MP (ASSUME "~^t2") (CONJUNCT2 (ASSUME "^t1 /\ ^t2")) in let imp2 = let fth = DISJ_CASES (ASSUME "~^t1 \/ ~^t2") th1 th2 in DISCH "~^t1 \/ ~^t2" (NOT_INTRO(DISCH "^t1 /\ ^t2" fth)) in IMP_ANTISYM_RULE (DISCH "~(^t1 /\ ^t2)" imp1) imp2 in let thm2 = let asm1 = ASSUME "~(^t1 \/ ^t2)" in let imp1 = let th1 = NOT_INTRO(DISCH t1 (NOT_MP asm1 (DISJ1 (ASSUME t1) t2))) in let th2 = NOT_INTRO(DISCH t2 (NOT_MP asm1 (DISJ2 t1 (ASSUME t2)))) in DISCH "~(^t1 \/ ^t2)" (CONJ th1 th2) in let imp2 = let asm = ASSUME "^t1 \/ ^t2" in let a1 = CONJUNCT1(ASSUME "~^t1 /\ ~^t2") and a2 = CONJUNCT2(ASSUME "~^t1 /\ ~^t2") in let fth = DISJ_CASES asm (UNDISCH a1) (UNDISCH a2) in DISCH "~^t1 /\ ~^t2" (NOT_INTRO(DISCH "^t1 \/ ^t2" fth)) in IMP_ANTISYM_RULE imp1 imp2 in GEN t1 (GEN t2 (CONJ thm1 thm2));; % --------------------------------------------------------------------- % % ISPEC: specialization, with type instantation if necessary. % % % % A |- !x:ty.tm % % ----------------------- ISPEC "t:ty'" % % A |- tm[t/x] % % % % (where t is free for x in tm, and ty' is an instance of ty) % % --------------------------------------------------------------------- % let ISPEC t th = let x,tm = dest_forall(concl th) ? failwith `ISPEC: input theorem not universally quantified` in let _,inst = match x t ? failwith `ISPEC: can't type-instantiate input theorem` in (SPEC t (INST_TYPE inst th) ? failwith `ISPEC: type variable free in assumptions`);; % --------------------------------------------------------------------- % % ISPECL: iterated specialization, with type instantation if necessary. % % % % A |- !x1...xn.tm % % --------------------------------- ISPECL ["t1",...,"tn"] % % A |- tm[t1/x1,...,tn/xn] % % % % (where ti is free for xi in tm) % % --------------------------------------------------------------------- % let ISPECL = let tup = end_itlist (curry mk_pair) in letrec strip (ts:term list) = if (null ts) then \tm.[] else let fn = strip (tl ts) in \tm. let x,b = dest_forall tm in (x.fn b) in \ts. if (null ts) then \th.th else if (null (tl ts)) then ISPEC (hd ts) else let stripfn = strip ts and tst = tup ts in \th. let xs = stripfn (concl th) ? failwith `ISPECL: list of terms too long for theorem` in let _,inst = match (tup xs) tst ? failwith `ISPECL: can't type-instantiate input theorem` in (SPECL ts (INST_TYPE inst th) ? failwith `ISPECL: type variable free in assumptions`);; % --------------------------------------------------------------------- % % SELECT_REFL = |- !x. (@y. y = x) = x % % --------------------------------------------------------------------- % let SELECT_REFL = let th1 = ISPECL ["\y:*. y = x"; "x:*"] SELECT_AX in let ths = map BETA_CONV ["(\y:*. y = x) x"; "(\y:*. y = x)(@y. y = x)"] in let th2 = SUBST[(el 1 ths,"u:bool"); (el 2 ths,"v:bool")] "u ==> v" th1 in GEN "x:*" (MP th2 (REFL "x:*"));; %----------------------------------------------------------------------------% % SELECT_UNIQUE = |- !P x. (!y. P y = (y = x)) ==> ($@ P = x) % %----------------------------------------------------------------------------% let SELECT_UNIQUE = let mksym tm = DISCH tm (SYM(ASSUME tm)) in let th0 = IMP_ANTISYM_RULE (mksym "y:* = x") (mksym "x:* = y") in let th1 = SPEC "y:*" (ASSUME "!y:*. P y = (y = x)") in let th2 = EXT(GEN "y:*" (TRANS th1 th0)) in let th3 = AP_TERM "$@:(*->bool)->*" th2 in let th4 = TRANS (BETA_CONV "(\y:*. y = x) y") th0 in let th5 = AP_TERM "$@:(*->bool)->*" (EXT(GEN "y:*" th4)) in let th6 = TRANS (TRANS th3 (SYM th5)) (SPEC "x:*" SELECT_REFL) in GENL ["P:*->bool"; "x:*"] (DISCH "!y:*. P y = (y = x)" th6);; hol88-2.02.19940316/theories/0000750000212700021270000000000005541570507013555 5ustar cammcammhol88-2.02.19940316/theories/mk_BASIC-HOL.ml0000640000212700021270000001127305071125202016026 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_BASIC-HOL.ml % % % % DESCRIPTION: Proves a simple theorem that is useful for defining % % new logical types. Stores this theorem in BASIC-HOL. % % % % AUTHOR: T. F. Melham 87.02.26 % % % % USES FILES: basic-hol lisp files, ind.th, genfns.ml, hol-syn.ml % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% load_theory `ind`;; % Load the hol parser/pretty printer. % loadf (concat ml_dir_pathname `hol-in-out`);; % Load the required theorem-proving support. % loadf (concat ml_dir_pathname `hol-rule`);; loadf (concat ml_dir_pathname `hol-drule`);; loadf (concat ml_dir_pathname `hol-thyfn`);; new_theory `BASIC-HOL`;; % new_parent `ind`;; Redundant (MJCG 22 Sept 1989) % % close the theory % close_theory();; % The following theorem is used to prove generally useful lemmas for % % newly defined logical types. Given a type axiom of the form asserted % % by "new_type_definition": % % % % |- ?rep. TYPE_DEFINITION P rep % % % % we wish to show that there exist abstraction and representation % % functions ABS and REP, such that: % % % % 1: (!a. ABS(REP a) = a) --- I.e. ABS is the left inverse of REP. % % % % 2: (!r. P r = (REP(ABS r) = r)) --- I.e. REP is the left inverse of % % ABS for the set of things in P. % % Load the definition of TYPE_DEFINITION. % let TYPE_DEFINITION = definition `bool` `TYPE_DEFINITION`;; % Now prove the theorem % let ABS_REP_THM = let th1 = ASSUME "?rep:**->*. TYPE_DEFINITION P rep" and th2 = MK_EXISTS (SPEC "P:*->bool" TYPE_DEFINITION) in let def = EQ_MP th2 th1 in let asm = ASSUME (snd(dest_exists(concl def))) in let (asm1,asm2) = (CONJUNCT1 asm, CONJUNCT2 asm) in let rep_eq = let th1 = DISCH "a:**=a'"(AP_TERM "rep:**->*" (ASSUME "a:**=a'")) in IMP_ANTISYM_RULE (SPECL ["a:**";"a':**"] asm1) th1 in let ABS = "\r:*. @a:**. r = rep a" in let absd = RIGHT_BETA (AP_THM (REFL ABS) "rep (a:**):*") in let lem = SYM(SELECT_RULE(EXISTS ("?a':**.a=a'","a:**") (REFL "a:**"))) in let TH1 = GEN "a:**" (TRANS(TRANS absd (SELECT_EQ "a':**" rep_eq)) lem) in let t1 = SELECT_RULE(EQ_MP (SPEC "r:*" asm2)(ASSUME "(P:*->bool) r")) in let absd2 = RIGHT_BETA (AP_THM (REFL ABS) "r:*") in let imp1 = DISCH "(P:*->bool) r" (SYM (SUBS [SYM absd2] t1)) in let t2 = EXISTS ("?a:**. r:* = rep a", "^ABS r") (SYM(ASSUME "rep(^ABS (r:*):**) = r")) in let imp2 = DISCH "rep(^ABS (r:*):**) = r" (EQ_MP (SYM (SPEC "r:*" asm2)) t2) in let TH2 = GEN "r:*" (IMP_ANTISYM_RULE imp1 imp2) in let CTH = CONJ TH1 TH2 in let ath = subst ["abs:*->**",ABS] (concl CTH) in let eth1 = EXISTS ("?abs:*->**. ^ath", ABS) CTH in let eth2 = EXISTS ("?rep:**->*. ^(concl eth1)", "rep:**->*") eth1 in let result = DISCH (concl th1) (CHOOSE ("rep:**->*",def) eth2) in GEN "P:*->bool" result;; % And save it. % save_thm(`ABS_REP_THM`, ABS_REP_THM);; quit();; hol88-2.02.19940316/theories/mk_PPLAMB.ml0000640000212700021270000000404005071125202015532 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_PPLAMB.ml % % % % DESCRIPTION: Set up stripped down PPLAMBDA theory for HOL.. This % % must be made using hol-lcf so that HOL versions of % % new_predicate etc. are not used. % % % % WRITES FILES: PPLAMB.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% new_theory `PPLAMB`;; paired_new_type(2, `fun`);; close_theory();; quit();; hol88-2.02.19940316/theories/mk_arith.ml0000640000212700021270000001317305511535703015707 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_arith.ml % % % % DESCRIPTION: Creates the theory "arithmetic.th" containing the % % definitions of the usual arithmetic operators + * etc % % % % AUTHOR: T. F. Melham (88.04.02) % % % % PARENTS: prim_rec.th fun.th % % WRITES FILES: arithmetic.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: adding fun.th as parent by WW (2 Jan 94) % %=============================================================================% new_theory `arithmetic`;; map new_parent [`prim_rec`; `fun`];; % --------------------------------------------------------------------- % % Load the code for primitive recursive definitions on arbitrary types. % % % % Note that prim_rec_ml.o must be recompiled if basic-hol has been % % rebuilt. The uncompiled version is therefore loaded here. % % % % TFM 88.04.02 % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `prim_rec.ml`);; % fetch the prim rec definition axiom from prim_rec.th % let num_Axiom = theorem `prim_rec` `num_Axiom`;; let ADD = new_recursive_definition true num_Axiom `ADD` "($+ 0 n = n) /\ ($+ (SUC m) n = SUC($+ m n))";; let SUB = new_recursive_definition true num_Axiom `SUB` "($- 0 m = 0) /\ ($- (SUC m) n = ((m < n) => 0 | SUC($- m n)))";; let MULT = new_recursive_definition true num_Axiom `MULT` "($* 0 n = 0) /\ ($* (SUC m) n = ($* m n) + n)";; let EXP = new_recursive_definition true num_Axiom `EXP` "(EXP m 0 = 1) /\ (EXP m (SUC n) = m * (EXP m n))";; % --------------------------------------------------------------------- % % Deleted TFM 88.04.02 % % let SLASH = new_infix_definition(`/`, "$/ m n = @x. n*x = m");; % % --------------------------------------------------------------------- % let GREATER = new_infix_definition(`GREATER`, "$> m n = (n < m)");; let LESS_OR_EQ = new_infix_definition(`LESS_OR_EQ`, "$<= m n = (m < n) \/ (m = n)");; let GREATER_OR_EQ = new_infix_definition(`GREATER_OR_EQ`, "$>= m n = (m > n) \/ (m = n)");; %----------------------------------------------------------------------------% % Definitions of factorial, even and odd [JRH 92.07.14] % %----------------------------------------------------------------------------% let FACT = new_recursive_definition false num_Axiom `FACT` "(FACT 0 = 1) /\ (FACT (SUC n) = (SUC n) * FACT(n))";; let EVEN = new_recursive_definition false num_Axiom `EVEN` "(EVEN 0 = T) /\ (EVEN (SUC n) = ~(EVEN n))";; let ODD = new_recursive_definition false num_Axiom `ODD` "(ODD 0 = F) /\ (ODD (SUC n) = ~(ODD n))";; % --------------------------------------------------------------------- % % These definitions of MOD and DIV are replaced by constant specifications % % in the file mk_arith_thms.ml % % % % let MOD = % % new_infix_definition % % (`MOD`, "MOD k n = @r. ?q. (k = (q * n) + r) /\ r < n");; % % % % let DIV = % % new_infix_definition % % (`DIV`, "DIV k n = @q. (k = (q * n) + (k MOD n))");; % % % % [TFM 90.05.26] % % --------------------------------------------------------------------- % close_theory();; quit();; hol88-2.02.19940316/theories/mk_combin.ml0000640000212700021270000001000205071125203016022 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_combin.ml % % % % DESCRIPTION: Creates the theory "combin.th" containing some basic % % combinator definitions and theorems about them. % % % % AUTHOR: T. F. Melham (87.02.26) % % % % PARENTS: BASIC-HOL.th % % WRITES FILES: combin.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % REVISION HISTORY: (none) % %=============================================================================% % Create the new theory. % new_theory `combin`;; % Definition of function composition. % let o_DEF = new_infix_definition (`o_DEF`, "$o (f:** -> ***) g = \x:*.f(g(x))");; % Definition of K. % let K_DEF = new_definition(`K_DEF`, "K = \x:*.\y:**.x");; % Definition of S. % let S_DEF = new_definition (`S_DEF`, "S = \f:*->**->***.\g:*->**.\x:*. (f x)(g x)");; % Definition of the Identity function. % % MJCG for HOL88: Type of K changed to ":*->*->*" to prevent unbound free type variable % let I_DEF = new_definition(`I_DEF`, "(I:*->*) = S K (K:*->*->*)");; % Close the theory. % close_theory ();; % Theorem about application of composed functions. % let o_THM = prove_thm(`o_THM`, "!f:**->***. !g:*->**. !x:*.(f o g) x = f(g(x))", PURE_REWRITE_TAC [o_DEF] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; % This theorem states that function composition is associative. % let o_ASSOC = prove_thm(`o_ASSOC`, "!f:***->****. !g:**->***. !h:*->**.f o (g o h) = (f o g) o h", REPEAT GEN_TAC THEN REWRITE_TAC [o_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REFL_TAC);; % Theorem about application of K. % let K_THM = prove_thm(`K_THM`, "!x:*.!y:**. K x y = x", PURE_REWRITE_TAC [K_DEF] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; % Theorem about application of S. % let S_THM = prove_thm(`S_THM`, "!f:*->**->***.!g:*->**.!x:*. S f g x = (f x)(g x)", PURE_REWRITE_TAC [S_DEF] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; % Theorem about application of I. % let I_THM = prove_thm(`I_THM`, "!x:*. I x = x", REWRITE_TAC [I_DEF;S_THM;K_THM] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN GEN_TAC THEN REFL_TAC);; % I is the identity for function composition. % let I_o_ID = prove_thm(`I_o_ID`, "!f:*->**. (I o f = f) /\ (f o I = f)", REPEAT STRIP_TAC THEN CONV_TAC (DEPTH_CONV FUN_EQ_CONV) THEN REWRITE_TAC [o_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REWRITE_TAC [I_THM]);; quit();; hol88-2.02.19940316/theories/mk_ind.ml0000640000212700021270000000415305071125203015337 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_ind.ml % % % % DESCRIPTION: Sets up the type individuals and the Axiom of Infinity% % % % PARENTS: bool.th % % WRITES FILES: ind.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % Load into hol-lcf % new_theory `ind`;; new_parent `bool`;; paired_new_type(0, `ind`);; loadt (concat ml_dir_pathname `hol-in-out`);; new_axiom(`INFINITY_AX`, "?f:ind->ind. ONE_ONE f /\ ~(ONTO f)");; close_theory();; quit();; hol88-2.02.19940316/theories/mk_list_thm2.ml0000640000212700021270000030612405541570464016514 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_list_thm2.ml % % % % DESCRIPTION: Extends the theory list.th with more theorems % % loaded by mk_list_thms.ml % % % % AUTHORS: W. Wong (2 Jan 94) % % % % WRITES FILES: list.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: W. Wong 1994 % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Define some useful functions % % --------------------------------------------------------------------- % begin_section `Q_PERM`;; let chk_var vl v = (is_var v & (mem v vl)) ;; let FORALL_PERM_RULE = \tms thm. let vs = (fst o strip_forall) (concl thm) in if (forall (chk_var vs) tms) then let vs' = subtract vs tms in (GENL (tms @ vs')(SPEC_ALL thm)) else failwith `not all variables are quantified` ?\s failwith (`FORALL_PERM_RULE: `^s);; let FORALL_PERM_CONV = let forall_perm_rule = \tms thm. GENL tms (SPEC_ALL thm) in \tms tm. let (vs,body) = strip_forall tm in if (forall (chk_var vs) tms) then let vs' = tms @ (subtract vs tms) in let th1 = DISCH_ALL (forall_perm_rule vs' (ASSUME tm)) in let th2 = DISCH_ALL (forall_perm_rule vs (ASSUME(list_mk_forall(vs',body)))) in (IMP_ANTISYM_RULE th1 th2) else failwith `not all variables are quantified` ?\s failwith (`FORALL_PERM_CONV: `^s);; let FORALL_PERM_TAC = \tms (asm,gl). CONV_TAC (FORALL_PERM_CONV tms) (asm,gl);; (FORALL_PERM_RULE,FORALL_PERM_CONV,FORALL_PERM_TAC);; end_section `Q_PERM`;; let (FORALL_PERM_RULE,FORALL_PERM_CONV,FORALL_PERM_TAC) = it;; %-==============================================================-% %- Theorems about lists -% %-==============================================================-% let NULL_EQ_NIL = prove_thm (`NULL_EQ_NIL`, "!l:(*)list . NULL l = (l = [])", GEN_TAC THEN STRUCT_CASES_TAC (SPEC_ALL list_CASES) THEN REWRITE_TAC [NULL;NOT_CONS_NIL]);; let LENGTH_EQ = prove_thm (`LENGTH_EQ`, "! (x:* list) y. (x = y) ==> (LENGTH x = LENGTH y)", REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC []);; let LENGTH_NOT_NULL = prove_thm(`LENGTH_NOT_NULL`, "!(l:(*)list). (0 < LENGTH l) = (~(NULL l))", LIST_INDUCT_TAC THENL[ REWRITE_TAC [LENGTH;NULL;NOT_LESS_0]; REWRITE_TAC [LENGTH;NULL;LESS_0]]);; let REVERSE_SNOC = prove_thm(`REVERSE_SNOC`, "!(x:*) l. REVERSE (SNOC x l) = CONS x (REVERSE l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;REVERSE]);; let REVERSE_REVERSE = prove_thm (`REVERSE_REVERSE`, "!l:(*)list. REVERSE (REVERSE l) = l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;REVERSE_SNOC]);; let forall_REVERSE = TAC_PROOF(([], "!P. (!l:(*)list. P(REVERSE l)) = (!l. P l)"), GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (ACCEPT_TAC o (REWRITE_RULE[REVERSE_REVERSE] o (SPEC "REVERSE l:(*)list"))));; let f_REVERSE_lemma = TAC_PROOF (([], "!f1 f2. ((\x. (f1:(*)list->**) (REVERSE x)) = (\x. f2 (REVERSE x))) = (f1 = f2)"), REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL[ POP_ASSUM (\x.ACCEPT_TAC (EXT (REWRITE_RULE[REVERSE_REVERSE] (GEN "x:(*)list" (BETA_RULE (AP_THM x "REVERSE (x:(*)list)")))))); ASM_REWRITE_TAC[]]);; let SNOC_Axiom = prove_thm(`SNOC_Axiom`, "!(e:**) (f:** -> (* -> ((*)list -> **))). ?! fn. (fn[] = e) /\ (!x l. fn(SNOC x l) = f(fn l)x l)", let lemma = CONV_RULE (EXISTS_UNIQUE_CONV) (REWRITE_RULE[REVERSE_REVERSE] (BETA_RULE (SPECL ["e:**";"(\ft h t. f ft h (REVERSE t)):** -> (* -> ((*)list -> **))"] (PURE_ONCE_REWRITE_RULE [SYM (CONJUNCT1 REVERSE); PURE_ONCE_REWRITE_RULE[SYM (SPEC_ALL REVERSE_SNOC)] (BETA_RULE (SPEC "\l:(*)list.fn(CONS x l) = (f:** -> (* -> ((*)list -> **)))(fn l)x l" (CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) forall_REVERSE)))] list_Axiom)))) in REPEAT GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN STRIP_ASSUME_TAC lemma THEN CONJ_TAC THENL[ EXISTS_TAC "(fn:(*)list->**) o REVERSE" THEN REWRITE_TAC[o_DEF] THEN BETA_TAC THEN ASM_REWRITE_TAC[]; REPEAT GEN_TAC THEN POP_ASSUM (ACCEPT_TAC o SPEC_ALL o REWRITE_RULE[REVERSE_REVERSE;f_REVERSE_lemma] o BETA_RULE o REWRITE_RULE[o_DEF] o SPECL ["(fn' o REVERSE):(*)list->**";"(fn'' o REVERSE):(*)list->**"]) ]);; let SNOC_INDUCT = save_thm(`SNOC_INDUCT`, prove_induction_thm SNOC_Axiom);; let SNOC_CASES = save_thm(`SNOC_CASES`,prove_cases_thm SNOC_INDUCT);; let LENGTH_SNOC = prove_thm(`LENGTH_SNOC`, "!(x:*) l. LENGTH (SNOC x l) = SUC (LENGTH l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH;SNOC]);; let NOT_NULL_SNOC = PROVE( "!(x:*) l. ~NULL(SNOC x l)", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SNOC;NULL]);; % NOT_NIL_SNOC = |- !x l. ~([] = SNOC x l) % let NOT_NIL_SNOC = save_thm(`NOT_NIL_SNOC`, prove_constructors_distinct SNOC_Axiom);; % NOT_SNOC_NIL = |- !x l. ~(SNOC x l = []) % let NOT_SNOC_NIL = save_thm(`NOT_SNOC_NIL`, GSYM NOT_NIL_SNOC);; let SNOC_11 = save_thm(`SNOC_11`,prove_constructors_one_one SNOC_Axiom);; let SNOC_EQ_LENGTH_EQ = prove_thm (`SNOC_EQ_LENGTH_EQ`, "!x1 (l1:(*)list) x2 l2. ((SNOC x1 l1) = (SNOC x2 l2)) ==> (LENGTH l1 = LENGTH l2)", REPEAT STRIP_TAC THEN RULE_ASSUM_TAC (AP_TERM "LENGTH:(*)list -> num") THEN RULE_ASSUM_TAC(REWRITE_RULE [LENGTH_SNOC;LENGTH;EQ_MONO_ADD_EQ;ADD1]) THEN FIRST_ASSUM ACCEPT_TAC);; let SNOC_REVERSE_CONS = save_thm (`SNOC_REVERSE_CONS`, % "!(x:*) l. (SNOC x l) = REVERSE (CONS x (REVERSE l))", % GEN_ALL (REWRITE_RULE [REVERSE_REVERSE] (AP_TERM "REVERSE:(*)list -> (*)list" (SPEC_ALL REVERSE_SNOC))));; let SNOC_APPEND = prove_thm(`SNOC_APPEND`, "!x (l:(*) list). SNOC x l = APPEND l [x]", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [SNOC;APPEND]);; let MAP_SNOC = prove_thm(`MAP_SNOC`, "!(f:*->**) x (l:* list). MAP f(SNOC x l) = SNOC(f x)(MAP f l)", (REWRITE_TAC [SNOC_APPEND;MAP_APPEND;MAP]));; let FOLDR_SNOC = prove_thm(`FOLDR_SNOC`, "!(f:*->**->**) e x l. FOLDR f e (SNOC x l) = FOLDR f (f x e) l", REPEAT (FILTER_GEN_TAC "l:* list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SNOC;FOLDR] THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[]);; let FOLDL_SNOC = prove_thm(`FOLDL_SNOC`, "!(f:**->*->**) e x l. FOLDL f e (SNOC x l) = f (FOLDL f e l) x", let lem = PROVE( "!l (f:**->*->**) e x. FOLDL f e (SNOC x l) = f (FOLDL f e l) x", LIST_INDUCT_TAC THEN REWRITE_TAC[SNOC;FOLDL] THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[]) in MATCH_ACCEPT_TAC lem);; let SNOC_INDUCT_TAC = INDUCT_THEN SNOC_INDUCT ASSUME_TAC;; let FOLDR_FOLDL = prove_thm(`FOLDR_FOLDL`, "!(f:*->*->*) e. MONOID f e ==> !l. FOLDR f e l = FOLDL f e l", REPEAT GEN_TAC THEN REWRITE_TAC[MONOID_DEF;ASSOC_DEF;LEFT_ID_DEF;RIGHT_ID_DEF] THEN STRIP_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FOLDL; FOLDR] THEN FIRST_ASSUM SUBST1_TAC THEN GEN_TAC THEN SPEC_TAC ("l:* list","l:* list") THEN SNOC_INDUCT_TAC THENL[ ASM_REWRITE_TAC[FOLDL]; PURE_ONCE_REWRITE_TAC[FOLDL_SNOC] THEN GEN_TAC THEN ASM_REWRITE_TAC[]]);; let LENGTH_FOLDR = prove_thm(`LENGTH_FOLDR`, "!l:* list. LENGTH l = FOLDR (\x l'. SUC l') 0 l", LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;FOLDR] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]);; let LENGTH_FOLDL = prove_thm(`LENGTH_FOLDL`, "!l:* list. LENGTH l = FOLDL (\l' x. SUC l') 0 l", SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH_SNOC;FOLDL_SNOC] THENL[ REWRITE_TAC[LENGTH;FOLDL]; CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]]);; let MAP_FOLDR = prove_thm(`MAP_FOLDR`, "!(f:*->**) l. MAP f l = FOLDR (\x l'. CONS (f x) l') [] l", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP;FOLDR] THEN GEN_TAC THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]);; let MAP_FOLDL = prove_thm(`MAP_FOLDL`, "!(f:*->**) l. MAP f l = FOLDL (\l' x. SNOC (f x) l') [] l", GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[MAP_SNOC;FOLDL_SNOC] THENL[ REWRITE_TAC[FOLDL;MAP]; FIRST_ASSUM (SUBST1_TAC o SYM) THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN GEN_TAC THEN REFL_TAC]);; let MAP_o = prove_thm(`MAP_o`, "!f:**->***. !g:*->**. MAP (f o g) = (MAP f) o (MAP g)", REPEAT GEN_TAC THEN CONV_TAC FUN_EQ_CONV THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;o_THM]);; let MAP_MAP_o = prove_thm(`MAP_MAP_o`, "!(f:**->***) (g:*->**) l. MAP f (MAP g l) = MAP (f o g) l", REPEAT GEN_TAC THEN REWRITE_TAC [MAP_o;o_DEF] THEN BETA_TAC THEN REFL_TAC);; let FILTER_FOLDR = prove_thm(`FILTER_FOLDR`, "!P (l:* list). FILTER P l = FOLDR (\x l'. P x => CONS x l' | l') [] l", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER;FOLDR] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]);; let FILTER_SNOC = prove_thm(`FILTER_SNOC`, "!P (x:*) l. FILTER P (SNOC x l) = P x => SNOC x (FILTER P l) | FILTER P l", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER;SNOC] THEN GEN_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[SNOC]);; let FILTER_FOLDL = prove_thm(`FILTER_FOLDL`, "!P (l:* list). FILTER P l = FOLDL (\l' x. P x => SNOC x l' | l') [] l", GEN_TAC THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[FILTER;FOLDL]; REWRITE_TAC[FILTER_SNOC;FOLDL_SNOC] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]]);; let FILTER_COMM = prove_thm(`FILTER_COMM`, "!f1 f2 (l:* list). FILTER f1 (FILTER f2 l) = FILTER f2 (FILTER f1 l)", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER] THEN GEN_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[FILTER]);; let FILTER_IDEM = prove_thm(`FILTER_IDEM`, "!f (l:* list). FILTER f (FILTER f l) = FILTER f l", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FILTER]);; let FILTER_MAP = prove_thm(`FILTER_MAP`, "!f1 (f2:*->**) (l:* list). FILTER f1 (MAP f2 l) = MAP f2 (FILTER (f1 o f2) l)", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER;MAP] THEN GEN_TAC THEN PURE_ONCE_REWRITE_TAC[o_THM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FILTER;MAP]);; %- 18 Nov. 93 -% let LENGTH_SEG = prove_thm(`LENGTH_SEG`, "!n k (l:* list). ((n + k) <= (LENGTH l)) ==> (LENGTH (SEG n k l) = n)", REPEAT INDUCT_TAC THENL[ REWRITE_TAC[SEG;LENGTH]; REWRITE_TAC[SEG;LENGTH]; LIST_INDUCT_TAC THENL[ REWRITE_TAC[LENGTH;ADD_0;LESS_OR_EQ;NOT_SUC;NOT_LESS_0]; REWRITE_TAC[SEG;LENGTH;ADD;LESS_EQ_MONO;INV_SUC_EQ] THEN FIRST_ASSUM (MATCH_ACCEPT_TAC o (SPEC "0"))]; LIST_INDUCT_TAC THENL[ REWRITE_TAC[LENGTH;ADD;LESS_OR_EQ;NOT_SUC;NOT_LESS_0]; REWRITE_TAC[LENGTH;SEG;(GSYM ADD_SUC);LESS_EQ_MONO] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]);; let APPEND_NIL = prove_thm(`APPEND_NIL`, "(!l:(*)list . APPEND l [] = l) /\ (!l:(*)list . APPEND [] l = l)", CONJ_TAC THENL [LIST_INDUCT_TAC;ALL_TAC] THEN ASM_REWRITE_TAC [APPEND]);; let APPEND_SNOC = prove_thm(`APPEND_SNOC`, "!l1 (x:*) l2. APPEND l1 (SNOC x l2) = SNOC x (APPEND l1 l2)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND;SNOC]);; let REVERSE_APPEND = prove_thm (`REVERSE_APPEND`, "!(l1:(*)list) l2. REVERSE (APPEND l1 l2) = (APPEND (REVERSE l2) (REVERSE l1))", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND;APPEND_NIL;REVERSE;APPEND_SNOC]);; let APPEND_FOLDR = prove_thm(`APPEND_FOLDR`, "!(l1:* list) l2. APPEND l1 l2 = FOLDR CONS l2 l1", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND;FOLDR]);; let APPEND_FOLDL = prove_thm(`APPEND_FOLDL`, "!(l1:* list) l2. APPEND l1 l2 = FOLDL (\l' x. SNOC x l') l1 l2", GEN_TAC THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[APPEND_NIL;FOLDL]; ASM_REWRITE_TAC[APPEND_SNOC;FOLDL_SNOC] THEN GEN_TAC THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REFL_TAC]);; let FOLDR_APPEND = prove_thm(`FOLDR_APPEND`, "!(f:*->**->**) e l1 l2. FOLDR f e (APPEND l1 l2) = FOLDR f (FOLDR f e l2) l1", FORALL_PERM_TAC["l2:* list"] THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[APPEND_NIL;FOLDR]; REWRITE_TAC[APPEND_SNOC;FOLDR_SNOC] THEN REPEAT GEN_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let FOLDL_APPEND = prove_thm(`FOLDL_APPEND`, "!(f:*->**->*) e l1 l2. FOLDL f e (APPEND l1 l2) = FOLDL f (FOLDL f e l1) l2", FORALL_PERM_TAC["l1:** list"] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND;FOLDL] THEN REPEAT GEN_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let CONS_APPEND = prove_thm(`CONS_APPEND`, "!(x:*) l. CONS x l = APPEND [x] l", GEN_TAC THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[APPEND_NIL]; ASM_REWRITE_TAC[APPEND_SNOC;(GSYM(CONJUNCT2 SNOC))]]);; let ASSOC_APPEND = prove_thm (`ASSOC_APPEND`, "ASSOC (APPEND:* list -> * list -> * list)", REWRITE_TAC[ASSOC_DEF;APPEND_ASSOC]);; let RIGHT_ID_APPEND_NIL = prove( "RIGHT_ID APPEND ([]:* list)", REWRITE_TAC[RIGHT_ID_DEF;APPEND;APPEND_NIL]);; let LEFT_ID_APPEND_NIL = PROVE( "LEFT_ID APPEND ([]:* list)", REWRITE_TAC[LEFT_ID_DEF;APPEND;APPEND_NIL]);; let MONOID_APPEND_NIL = prove_thm (`MONOID_APPEND_NIL`, "MONOID APPEND ([]:* list)", REWRITE_TAC[MONOID_DEF;APPEND;APPEND_NIL;APPEND_ASSOC; LEFT_ID_DEF;ASSOC_DEF;RIGHT_ID_DEF]);; let APPEND_LENGTH_EQ = prove_thm(`APPEND_LENGTH_EQ`, "!l1 l1'. (LENGTH l1 = LENGTH l1') ==> !l2 l2':* list. (LENGTH l2 = LENGTH l2') ==> ((APPEND l1 l2 = APPEND l1' l2') = ((l1 = l1') /\ (l2 = l2')))", let APPEND_11 = PROVE( "!(x:* list) (y:* list) (z:* list). ((APPEND x y) = (APPEND x z)) = (y = z)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND;CONS_11]) in let EQ_LENGTH_INDUCT_TAC = LIST_INDUCT_TAC THENL[ LIST_INDUCT_TAC THENL[ REPEAT (CONV_TAC FORALL_IMP_CONV) THEN DISCH_THEN (\t.ALL_TAC); REWRITE_TAC[LENGTH;SUC_NOT]]; GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_SUC;INV_SUC_EQ] THEN GEN_TAC THEN REPEAT (CONV_TAC FORALL_IMP_CONV) THEN DISCH_TAC] in EQ_LENGTH_INDUCT_TAC THEN REWRITE_TAC[APPEND] THEN EQ_LENGTH_INDUCT_TAC THEN REWRITE_TAC[APPEND_11;CONS_11;APPEND_NIL] THEN FIRST_ASSUM (\t. ASSUME_TAC (MATCH_MP t (ASSUME"LENGTH (l1:* list) = LENGTH (l1':* list)"))) THEN POP_ASSUM (ASSUME_TAC o (REWRITE_RULE[LENGTH;INV_SUC_EQ]) o (SPECL["CONS h'' l2:* list";"CONS h''' l2':* list"])) THEN POP_ASSUM (\t1. FIRST_ASSUM (\t2. SUBST1_TAC (MP t1 t2))) THEN REWRITE_TAC[CONS_11;CONJ_ASSOC]);; let FILTER_APPEND = prove_thm(`FILTER_APPEND`, "!f l1 (l2:* list). FILTER f (APPEND l1 l2) = APPEND (FILTER f l1) (FILTER f l2)", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER;APPEND] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[APPEND]);; let FLAT_SNOC = prove_thm(`FLAT_SNOC`, "!(x:* list) l. FLAT (SNOC x l) = APPEND (FLAT l) x", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;SNOC;APPEND;APPEND_NIL;APPEND_ASSOC]);; let FLAT_FOLDR = prove_thm(`FLAT_FOLDR`, "!l:* list list. FLAT l = FOLDR APPEND [] l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;FOLDR]);; let FLAT_FOLDL = prove_thm(`FLAT_FOLDL`, "!l:* list list. FLAT l = FOLDL APPEND [] l", SNOC_INDUCT_TAC THENL[ REWRITE_TAC[FLAT;FOLDL]; ASM_REWRITE_TAC[FLAT_SNOC;FOLDL_SNOC]]);; let LENGTH_FLAT = prove_thm(`LENGTH_FLAT`, "!l:* list list. LENGTH(FLAT l) = SUM (MAP LENGTH l)", LIST_INDUCT_TAC THEN REWRITE_TAC[FLAT] THENL[ REWRITE_TAC[LENGTH;MAP;SUM]; ASM_REWRITE_TAC[LENGTH_APPEND;MAP;SUM]]);; let REVERSE_FOLDR = prove_thm(`REVERSE_FOLDR`, "!l:* list. REVERSE l = FOLDR SNOC [] l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;FOLDR]);; let REVERSE_FOLDL = prove_thm(`REVERSE_FOLDL`, "!l:* list. REVERSE l = FOLDL (\l' x. CONS x l') [] l", SNOC_INDUCT_TAC THENL[ REWRITE_TAC[REVERSE;FOLDL]; REWRITE_TAC[REVERSE_SNOC;FOLDL_SNOC] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]]);; let LENGTH_REVERSE = prove_thm(`LENGTH_REVERSE`, "!l:(*)list. LENGTH (REVERSE l) = LENGTH l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;REVERSE;LENGTH_SNOC]);; let REVERSE_EQ_NIL = prove_thm(`REVERSE_EQ_NIL`, "!l:* list. (REVERSE l = []) = (l = [])", LIST_INDUCT_TAC THEN REWRITE_TAC[REVERSE;NOT_CONS_NIL;NOT_SNOC_NIL]);; let ALL_EL_SNOC = prove_thm(`ALL_EL_SNOC`, "!P (x:*) l. ALL_EL P (SNOC x l) = ALL_EL P l /\ P x", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;ALL_EL;CONJ_ASSOC]);; let ALL_EL_CONJ = prove_thm(`ALL_EL_CONJ`, "!P Q l. ALL_EL (\x:*. P x /\ Q x) l = (ALL_EL P l /\ ALL_EL Q l)", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ALL_EL] THEN BETA_TAC THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN FIRST_ASSUM ACCEPT_TAC);; let ALL_EL_MAP = prove_thm(`ALL_EL_MAP`, "!P (f:*->**) l. ALL_EL P (MAP f l) = ALL_EL (P o f) l", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL;MAP] THEN ASM_REWRITE_TAC [o_DEF] THEN BETA_TAC THEN REWRITE_TAC[]);; let ALL_EL_APPEND = prove_thm(`ALL_EL_APPEND`, "!P (l1:(*)list) l2. (ALL_EL P (APPEND l1 l2)) = ((ALL_EL P l1) /\ (ALL_EL P l2))", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND;ALL_EL] THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [CONJ_ASSOC]);; let SOME_EL_SNOC = prove_thm(`SOME_EL_SNOC`, "!P (x:*) l. SOME_EL P (SNOC x l) = P x \/ (SOME_EL P l)", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;SOME_EL] THEN GEN_TAC THEN PURE_ONCE_REWRITE_TAC[DISJ_ASSOC] THEN CONV_TAC ((RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) (REWR_CONV DISJ_SYM)) THEN REFL_TAC);; let NOT_ALL_EL_SOME_EL = prove_thm(`NOT_ALL_EL_SOME_EL`, "!P (l:* list). ~(ALL_EL P l) = SOME_EL ($~ o P) l", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL_EL;SOME_EL] THEN GEN_TAC THEN PURE_ONCE_REWRITE_TAC[DE_MORGAN_THM;o_THM] THEN FIRST_ASSUM SUBST1_TAC THEN REFL_TAC);; let NOT_SOME_EL_ALL_EL = prove_thm(`NOT_SOME_EL_ALL_EL`, "!P (l:* list). ~(SOME_EL P l) = ALL_EL ($~ o P) l", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL_EL;SOME_EL] THEN GEN_TAC THEN PURE_ONCE_REWRITE_TAC[DE_MORGAN_THM;o_THM] THEN FIRST_ASSUM SUBST1_TAC THEN REFL_TAC);; let IS_EL = prove_thm(`IS_EL`, "(!x:*. IS_EL x[] = F) /\ (!(y:*) x l. IS_EL y(CONS x l) = (y = x) \/ IS_EL y l)", REWRITE_TAC[IS_EL_DEF;SOME_EL] THEN REPEAT GEN_TAC THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REFL_TAC);; let IS_EL_SNOC = prove_thm(`IS_EL_SNOC`, "!(y:*) x l. IS_EL y (SNOC x l) = (y = x) \/ IS_EL y l", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;IS_EL] THEN GEN_TAC THEN PURE_ONCE_REWRITE_TAC[DISJ_ASSOC] THEN CONV_TAC ((RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) (REWR_CONV DISJ_SYM)) THEN REFL_TAC);; let SUM_SNOC = prove_thm(`SUM_SNOC`, "!x l. SUM (SNOC x l) = (SUM l) + x", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SUM;SNOC;ADD;ADD_0] THEN GEN_TAC THEN ASM_REWRITE_TAC[ADD_ASSOC]);; let SUM_FOLDR = prove_thm(`SUM_FOLDR`, "!l:num list. SUM l = FOLDR $+ 0 l", LIST_INDUCT_TAC THEN REWRITE_TAC[SUM;FOLDR;ADD] THEN GEN_TAC THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN FIRST_ASSUM SUBST1_TAC THEN REFL_TAC);; let SUM_FOLDL = prove_thm(`SUM_FOLDL`, "!l:num list. SUM l = FOLDL $+ 0 l", SNOC_INDUCT_TAC THENL[ REWRITE_TAC[SUM;FOLDL]; REWRITE_TAC[SUM_SNOC;FOLDL_SNOC] THEN GEN_TAC THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN FIRST_ASSUM SUBST1_TAC THEN REFL_TAC]);; let IS_PREFIX_APPEND = prove_thm(`IS_PREFIX_APPEND`, "!l1 l2:* list. (IS_PREFIX l1 l2 = (?l. l1 = APPEND l2 l))", LIST_INDUCT_TAC THENL[ LIST_INDUCT_TAC THENL[ REWRITE_TAC[IS_PREFIX;APPEND] THEN EXISTS_TAC "[]:* list" THEN REFL_TAC; REWRITE_TAC[IS_PREFIX;APPEND;GSYM NOT_CONS_NIL]]; GEN_TAC THEN LIST_INDUCT_TAC THENL[ REWRITE_TAC[IS_PREFIX;APPEND] THEN EXISTS_TAC "CONS (h:*) l1" THEN REFL_TAC; ASM_REWRITE_TAC[IS_PREFIX;APPEND;CONS_11] THEN GEN_TAC THEN CONV_TAC (RAND_CONV EXISTS_AND_CONV) THEN REFL_TAC]]);; let IS_SUFFIX_APPEND = prove_thm(`IS_SUFFIX_APPEND`, "!l1 l2:* list. (IS_SUFFIX l1 l2 = (?l. l1 = APPEND l l2))", SNOC_INDUCT_TAC THENL[ SNOC_INDUCT_TAC THENL[ REWRITE_TAC[IS_SUFFIX;APPEND_NIL] THEN EXISTS_TAC "[]:* list" THEN REFL_TAC; REWRITE_TAC[IS_SUFFIX;APPEND_SNOC] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[GSYM NULL_EQ_NIL;NOT_NULL_SNOC]]; GEN_TAC THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[IS_SUFFIX;APPEND_NIL] THEN EXISTS_TAC "SNOC (x:*) l1" THEN REFL_TAC; ASM_REWRITE_TAC[IS_SUFFIX;APPEND_SNOC;SNOC_11] THEN GEN_TAC THEN CONV_TAC (RAND_CONV EXISTS_AND_CONV) THEN REFL_TAC]]);; let IS_SUBLIST_APPEND = prove_thm(`IS_SUBLIST_APPEND`, "!l1 l2:* list. IS_SUBLIST l1 l2 = (?l l'. l1 = APPEND l(APPEND l2 l'))", let NOT_NIL_APPEND_CONS2 = PROVE( "!l1 (l2:* list) x. ~([] = (APPEND l1 (CONS x l2)))", LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND] THEN REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC (GSYM NOT_CONS_NIL)) in LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "l2:* list") THEN LIST_INDUCT_TAC THENL[ REWRITE_TAC[IS_SUBLIST;APPEND] THEN MAP_EVERY EXISTS_TAC ["[]:* list"; "[]:* list"] THEN REWRITE_TAC[APPEND]; GEN_TAC THEN REWRITE_TAC[IS_SUBLIST;APPEND;NOT_NIL_APPEND_CONS2]; REWRITE_TAC[IS_SUBLIST;APPEND] THEN MAP_EVERY EXISTS_TAC ["[h]:* list"; "l1:* list"] THEN MATCH_ACCEPT_TAC CONS_APPEND; GEN_TAC THEN REWRITE_TAC[IS_SUBLIST] THEN EQ_TAC THEN ONCE_ASM_REWRITE_TAC[IS_PREFIX_APPEND] THENL[ STRIP_TAC THENL[ MAP_EVERY EXISTS_TAC ["[]:* list"; "l:* list"] THEN ASM_REWRITE_TAC[APPEND]; MAP_EVERY EXISTS_TAC ["(CONS h l):* list"; "l':* list"] THEN ONCE_ASM_REWRITE_TAC[APPEND] THEN REFL_TAC]; CONV_TAC LEFT_IMP_EXISTS_CONV THEN LIST_INDUCT_TAC THENL[ REWRITE_TAC[APPEND;CONS_11] THEN STRIP_TAC THEN DISJ1_TAC THEN ASM_REWRITE_TAC[IS_PREFIX_APPEND] THEN EXISTS_TAC "l':* list" THEN REFL_TAC; GEN_TAC THEN REWRITE_TAC[APPEND;CONS_11] THEN STRIP_TAC THEN DISJ2_TAC THEN MAP_EVERY EXISTS_TAC ["l:* list"; "l':* list"] THEN FIRST_ASSUM ACCEPT_TAC]]]);; let IS_PREFIX_IS_SUBLIST = prove_thm(`IS_PREFIX_IS_SUBLIST`, "!l1 l2:* list. IS_PREFIX l1 l2 ==> IS_SUBLIST l1 l2", LIST_INDUCT_TAC THEN TRY (FILTER_GEN_TAC "l2:* list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC[IS_PREFIX;IS_SUBLIST] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; let IS_SUFFIX_IS_SUBLIST = prove_thm(`IS_SUFFIX_IS_SUBLIST`, "!l1 l2:* list. IS_SUFFIX l1 l2 ==> IS_SUBLIST l1 l2", REPEAT GEN_TAC THEN REWRITE_TAC[IS_SUFFIX_APPEND;IS_SUBLIST_APPEND] THEN DISCH_THEN (CHOOSE_THEN SUBST1_TAC) THEN MAP_EVERY EXISTS_TAC ["l:* list"; "[]:* list"] THEN REWRITE_TAC[APPEND_NIL]);; let IS_PREFIX_REVERSE = prove_thm(`IS_PREFIX_REVERSE`, "!l1 l2:* list. IS_PREFIX (REVERSE l1) (REVERSE l2) = IS_SUFFIX l1 l2", let NOT_NIL_APPEND_SNOC2 = PROVE( "!l1 (l2:* list) x. ~([] = (APPEND l1 (SNOC x l2)))", LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND_SNOC] THEN REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC NOT_NIL_SNOC) in SNOC_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "l2:* list") THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[IS_SUFFIX_APPEND;REVERSE;IS_PREFIX] THEN EXISTS_TAC "[]:* list" THEN REWRITE_TAC[APPEND]; GEN_TAC THEN REWRITE_TAC[IS_SUFFIX_APPEND;REVERSE;REVERSE_SNOC;IS_PREFIX] THEN CONV_TAC NOT_EXISTS_CONV THEN GEN_TAC THEN REWRITE_TAC[APPEND;NOT_NIL_APPEND_SNOC2]; REWRITE_TAC[IS_SUFFIX_APPEND;REVERSE;APPEND_NIL;IS_PREFIX] THEN EXISTS_TAC "SNOC (x:*) l1" THEN REFL_TAC; GEN_TAC THEN REWRITE_TAC[IS_SUFFIX_APPEND;REVERSE_SNOC;IS_PREFIX] THEN PURE_ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[IS_SUFFIX_APPEND;APPEND_SNOC;SNOC_11] THEN CONV_TAC (ONCE_DEPTH_CONV EXISTS_AND_CONV) THEN REFL_TAC]);; let IS_SUFFIX_REVERSE = save_thm(`IS_SUFFIX_REVERSE`, % "!l1 l2:* list. IS_SUFFIX (REVERSE l1) (REVERSE l2) = IS_PREFIX l1 l2"% GEN_ALL(SYM (REWRITE_RULE[REVERSE_REVERSE] (SPECL["REVERSE(l1:* list)"; "REVERSE(l2:* list)"] IS_PREFIX_REVERSE))));; let IS_SUBLIST_REVERSE = prove_thm(`IS_SUBLIST_REVERSE`, "!l1 l2:* list. IS_SUBLIST (REVERSE l1) (REVERSE l2) = IS_SUBLIST l1 l2", REPEAT GEN_TAC THEN REWRITE_TAC[IS_SUBLIST_APPEND] THEN EQ_TAC THEN STRIP_TAC THENL[ MAP_EVERY EXISTS_TAC ["REVERSE(l':* list)"; "REVERSE(l:* list)"] THEN FIRST_ASSUM (SUBST1_TAC o (REWRITE_RULE[REVERSE_REVERSE;REVERSE_APPEND]) o (AP_TERM "REVERSE:* list -> * list")) THEN REWRITE_TAC[APPEND_ASSOC]; FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[REVERSE_APPEND;APPEND_ASSOC] THEN MAP_EVERY EXISTS_TAC ["REVERSE(l':* list)"; "REVERSE(l:* list)"] THEN REFL_TAC]);; let PREFIX_FOLDR = prove_thm(`PREFIX_FOLDR`, "!P (l:* list). PREFIX P l = FOLDR (\x l'. P x => CONS x l' | []) [] l", GEN_TAC THEN REWRITE_TAC[PREFIX_DEF] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FOLDR;SPLITP] THEN GEN_TAC THEN REWRITE_TAC[o_THM] THEN BETA_TAC THEN ASM_CASES_TAC "(P:*->bool) h" THEN ASM_REWRITE_TAC[]);; let PREFIX = prove_thm(`PREFIX`, "(!P:*->bool. PREFIX P [] = []) /\ (!P (x:*) l. PREFIX P (CONS x l) = P x => CONS x (PREFIX P l) |[])", REWRITE_TAC[PREFIX_FOLDR;FOLDR] THEN REPEAT GEN_TAC THEN BETA_TAC THEN REFL_TAC);; let IS_PREFIX_PREFIX = prove_thm(`IS_PREFIX_PREFIX`, "!P (l:* list). IS_PREFIX l (PREFIX P l)", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[IS_PREFIX;PREFIX] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IS_PREFIX]);; let LENGTH_SCANL = prove_thm(`LENGTH_SCANL`, "!(f:**->*->**) e l. LENGTH(SCANL f e l) = SUC (LENGTH l)", FORALL_PERM_TAC ["l:* list"] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SCANL;LENGTH] THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[]);; let LENGTH_SCANR = prove_thm(`LENGTH_SCANR`, "!(f:*->**->**) e l. LENGTH(SCANR f e l) = SUC (LENGTH l)", FORALL_PERM_TAC ["l:* list"] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SCANR] THEN CONV_TAC (ONCE_DEPTH_CONV let_CONV) THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[LENGTH]);; let COMM_MONOID_FOLDL = prove_thm(`COMM_MONOID_FOLDL`, "!f:*->*->*. COMM f ==> !e'. MONOID f e' ==> (!e l. FOLDL f e l = f e (FOLDL f e' l))", REWRITE_TAC[MONOID_DEF;ASSOC_DEF;LEFT_ID_DEF;COMM_DEF] THEN REPEAT STRIP_TAC THEN SPEC_TAC ("e:*","e:*") THEN SPEC_TAC ("l:* list","l:* list") THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[FOLDL] THENL[ GEN_TAC THEN PURE_ONCE_ASM_REWRITE_TAC[] THEN FIRST_ASSUM (MATCH_ACCEPT_TAC o GSYM); REPEAT GEN_TAC THEN POP_ASSUM (\t.PURE_ONCE_REWRITE_TAC[t]) THEN POP_ASSUM (\t.PURE_ONCE_REWRITE_TAC[t]) THEN FIRST_ASSUM (MATCH_ACCEPT_TAC o GSYM)] );; let COMM_MONOID_FOLDR = prove_thm(`COMM_MONOID_FOLDR`, "!f:*->*->*. COMM f ==> !e'. (MONOID f e') ==> (!e l. FOLDR f e l = f e (FOLDR f e' l))", REWRITE_TAC[MONOID_DEF;ASSOC_DEF;LEFT_ID_DEF;COMM_DEF] THEN GEN_TAC THEN DISCH_THEN (\th_sym. GEN_TAC THEN DISCH_THEN (\th_assoc_etc. let th_assoc = CONJUNCT1 th_assoc_etc in let th_ident = CONJUNCT2(CONJUNCT2 th_assoc_etc) in GEN_TAC THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[FOLDR] THENL[ PURE_ONCE_REWRITE_TAC[th_sym] THEN MATCH_ACCEPT_TAC (GSYM th_ident); REPEAT GEN_TAC THEN PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_ONCE_REWRITE_TAC[th_ident] THEN PURE_ONCE_REWRITE_TAC[th_assoc] THEN AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC (GSYM th_sym)])) );; let FCOMM_FOLDR_APPEND = prove_thm(`FCOMM_FOLDR_APPEND`, "!(g:*->*->*) (f:**->*->*). FCOMM g f ==> (!e. LEFT_ID g e ==> (!l1 l2. FOLDR f e (APPEND l1 l2) = g (FOLDR f e l1) (FOLDR f e l2)))", REWRITE_TAC[FCOMM_DEF;LEFT_ID_DEF] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND;FOLDR]);; let FCOMM_FOLDL_APPEND = prove_thm(`FCOMM_FOLDL_APPEND`, "!(f:*->**->*) (g:*->*->*). FCOMM f g ==> (!e. RIGHT_ID g e ==> (!l1 l2. FOLDL f e (APPEND l1 l2) = g (FOLDL f e l1) (FOLDL f e l2)))", REWRITE_TAC[FCOMM_DEF;RIGHT_ID_DEF] THEN REPEAT GEN_TAC THEN DISCH_THEN (ASSUME_TAC o GSYM) THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND_NIL;APPEND_SNOC;FOLDL_SNOC;FOLDL]);; let MONOID_FOLDR_APPEND_FOLDR = PROVE( "!(f:*->*->*) e. MONOID f e ==> (!l1 l2. FOLDR f e (APPEND l1 l2) = f (FOLDR f e l1) (FOLDR f e l2))", REWRITE_TAC[MONOID_DEF;GSYM FCOMM_ASSOC] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC FCOMM_FOLDR_APPEND THEN ASM_REWRITE_TAC[]);; let MONOID_FOLDL_APPEND_FOLDL = PROVE( "!(f:*->*->*) e. MONOID f e ==> (!l1 l2. FOLDL f e (APPEND l1 l2) = f (FOLDL f e l1) (FOLDL f e l2))", REWRITE_TAC[MONOID_DEF;GSYM FCOMM_ASSOC] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC FCOMM_FOLDL_APPEND THEN ASM_REWRITE_TAC[]);; let FOLDL_SINGLE = prove_thm(`FOLDL_SINGLE`, "!(f:*->**->*) e x. FOLDL f e [x] = f e x", REWRITE_TAC[FOLDL]);; let FOLDR_SINGLE = prove_thm(`FOLDR_SINGLE`, "!(f:*->**->**) e x. FOLDR f e [x] = f x e", REWRITE_TAC[FOLDR]);; let FOLDR_CONS_NIL = prove_thm(`FOLDR_CONS_NIL`, "!(l:* list). FOLDR CONS [] l = l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDR]);; let FOLDL_SNOC_NIL = prove_thm(`FOLDL_SNOC_NIL`, "!(l:* list). FOLDL (\xs x. SNOC x xs) [] l = l", SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDL;FOLDL_SNOC] THEN BETA_TAC THEN REWRITE_TAC[]);; let FOLDR_FOLDL_REVERSE = prove_thm(`FOLDR_FOLDL_REVERSE`, "!(f:*->**->**) e l. FOLDR f e l = FOLDL (\x y. f y x) e (REVERSE l)", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDR;FOLDL;REVERSE;FOLDL_SNOC] THEN BETA_TAC THEN REWRITE_TAC[]);; let FOLDL_FOLDR_REVERSE = prove_thm(`FOLDL_FOLDR_REVERSE`, "!(f:*->**->*) e l. FOLDL f e l = FOLDR (\x y. f y x) e (REVERSE l)", GEN_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;FOLDR;FOLDL;REVERSE_SNOC;FOLDR_SNOC] THEN BETA_TAC THEN ASM_REWRITE_TAC[FOLDL_SNOC]);; let FOLDR_REVERSE = prove_thm(`FOLDR_REVERSE`, "!(f:*->**->**) e l. FOLDR f e (REVERSE l) = FOLDL (\x y. f y x) e l", REWRITE_TAC[FOLDR_FOLDL_REVERSE;REVERSE_REVERSE]);; let FOLDL_REVERSE = prove_thm(`FOLDL_REVERSE`, "!(f:*->**->*) e l. FOLDL f e (REVERSE l) = FOLDR (\x y. f y x) e l", REWRITE_TAC[FOLDL_FOLDR_REVERSE;REVERSE_REVERSE]);; let FOLDR_MAP = prove_thm(`FOLDR_MAP`, "!(f:*->*->*) e (g:** ->*) l. FOLDR f e (MAP g l) = FOLDR (\x y. f (g x) y) e l", GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDL;MAP;FOLDR] THEN BETA_TAC THEN REWRITE_TAC[]);; let FOLDL_MAP = prove_thm(`FOLDL_MAP`, "!(f:*->*->*) e (g:** ->*) l. FOLDL f e (MAP g l) = FOLDL (\x y. f x (g y)) e l", GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP;FOLDL;FOLDL_SNOC;MAP_SNOC;FOLDR] THEN BETA_TAC THEN REWRITE_TAC[]);; let ALL_EL_FOLDR = prove_thm(`ALL_EL_FOLDR`, "!(P:*->bool) l. ALL_EL P l = FOLDR (\x l'. P x /\ l') T l", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL_EL;FOLDR;MAP] THEN BETA_TAC THEN REWRITE_TAC[]);; let ALL_EL_FOLDL = prove_thm(`ALL_EL_FOLDL`, "!(P:*->bool) l. ALL_EL P l = FOLDL (\l' x. l' /\ P x) T l", GEN_TAC THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[ALL_EL;FOLDL;MAP]; ASM_REWRITE_TAC[ALL_EL_SNOC;FOLDL_SNOC;MAP_SNOC]] THEN BETA_TAC THEN REWRITE_TAC[]);; let SOME_EL_FOLDR = prove_thm(`SOME_EL_FOLDR`, "!P (l:* list). SOME_EL P l = FOLDR (\x l'. P x \/ l') F l", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SOME_EL;MAP;FOLDR] THEN BETA_TAC THEN REWRITE_TAC[]);; let SOME_EL_FOLDL = prove_thm(`SOME_EL_FOLDL`, "!P (l:* list). SOME_EL P l = FOLDL (\l' x. l' \/ P x) F l", GEN_TAC THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[SOME_EL;MAP;FOLDL]; REWRITE_TAC[SOME_EL_SNOC;MAP_SNOC;FOLDL_SNOC] THEN BETA_TAC THEN GEN_TAC THEN FIRST_ASSUM SUBST1_TAC THEN MATCH_ACCEPT_TAC DISJ_SYM] );; let ALL_EL_FOLDR_MAP = prove_thm(`ALL_EL_FOLDR_MAP`, "!(P:*->bool) l. ALL_EL P l = FOLDR $/\ T (MAP P l)", REWRITE_TAC[ALL_EL_FOLDR;FOLDR_MAP]);; let ALL_EL_FOLDL_MAP = prove_thm(`ALL_EL_FOLDL_MAP`, "!(P:*->bool) l. ALL_EL P l = FOLDL $/\ T (MAP P l)", REWRITE_TAC[ALL_EL_FOLDL;FOLDL_MAP]);; let SOME_EL_FOLDR_MAP = prove_thm(`SOME_EL_FOLDR_MAP`, "!(P:*->bool) l. SOME_EL P l = FOLDR $\/ F (MAP P l)", REWRITE_TAC[SOME_EL_FOLDR;FOLDR_MAP]);; let SOME_EL_FOLDL_MAP = prove_thm(`SOME_EL_FOLDL_MAP`, "!(P:*->bool) l. SOME_EL P l = FOLDL $\/ F (MAP P l)", REWRITE_TAC[SOME_EL_FOLDL;FOLDL_MAP]);; let FOLDR_FILTER = prove_thm(`FOLDR_FILTER`, "!(f:*->*->*) e (P:* -> bool) l. FOLDR f e (FILTER P l) = FOLDR (\x y. P x => f x y | y) e l", GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDL; FILTER; FOLDR] THEN BETA_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FOLDR]);; let FOLDL_FILTER = prove_thm(`FOLDL_FILTER`, "!(f:*->*->*) e (P:* -> bool) l. FOLDL f e (FILTER P l) = FOLDL (\x y. P y => f x y | x) e l", GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDL;FOLDR_SNOC;FOLDL_SNOC;FILTER;FOLDR;FILTER_SNOC] THEN BETA_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FOLDL_SNOC]);; let ASSOC_FOLDR_FLAT = prove_thm(`ASSOC_FOLDR_FLAT`, "!(f:*->*->*). ASSOC f ==> (! e. LEFT_ID f e ==> (!l. FOLDR f e (FLAT l) = FOLDR f e (MAP (FOLDR f e) l)))", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;MAP;FOLDR] THEN IMP_RES_TAC (GSYM FCOMM_ASSOC) THEN IMP_RES_TAC FCOMM_FOLDR_APPEND THEN ASM_REWRITE_TAC[]);; let ASSOC_FOLDL_FLAT = prove_thm(`ASSOC_FOLDL_FLAT`, "!(f:*->*->*). ASSOC f ==> (! e. RIGHT_ID f e ==> (!l. FOLDL f e (FLAT l) = FOLDL f e (MAP (FOLDL f e) l)))", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT_SNOC;MAP_SNOC;MAP;FLAT;FOLDL_SNOC] THEN IMP_RES_TAC (GSYM FCOMM_ASSOC) THEN IMP_RES_TAC FCOMM_FOLDL_APPEND THEN ASM_REWRITE_TAC[]);; let MAP_FLAT = prove_thm(`MAP_FLAT`, "!(f:*->**) l. MAP f (FLAT l) = FLAT (MAP (MAP f) l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;MAP;MAP_APPEND]);; let FILTER_FLAT = prove_thm(`FILTER_FLAT`, "!(P:*->bool) l. FILTER P (FLAT l) = FLAT (MAP (FILTER P) l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;MAP;FILTER;FILTER_APPEND]);; let SOME_EL_MAP = prove_thm(`SOME_EL_MAP`, "!P (f:*->**) l. SOME_EL P (MAP f l) = SOME_EL (P o f) l", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THENL[ REWRITE_TAC [SOME_EL;MAP]; REWRITE_TAC [SOME_EL;MAP] THEN ASM_REWRITE_TAC [o_DEF] THEN BETA_TAC THEN REWRITE_TAC[]]);; let SOME_EL_APPEND = prove_thm(`SOME_EL_APPEND`, "!P (l1:(*)list) l2. (SOME_EL P (APPEND l1 l2)) = ((SOME_EL P l1) \/ (SOME_EL P l2))", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND;SOME_EL] THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [DISJ_ASSOC]);; let SOME_EL_DISJ = prove_thm(`SOME_EL_DISJ`, "!P Q (l:* list). SOME_EL (\x. P x \/ Q x) l = SOME_EL P l \/ SOME_EL Q l", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SOME_EL] THEN GEN_TAC THEN BETA_TAC THEN POP_ASSUM SUBST1_TAC THEN CONV_TAC (AC_CONV (DISJ_ASSOC,DISJ_SYM)));; let IS_EL_APPEND = prove_thm(`IS_EL_APPEND`, "!(l1:(*)list) l2 x. (IS_EL x (APPEND l1 l2)) = ((IS_EL x l1) \/ (IS_EL x l2))", REWRITE_TAC[IS_EL_DEF;SOME_EL_APPEND]);; let IS_EL_FOLDR = prove_thm(`IS_EL_FOLDR`, "!(y:*) l. IS_EL y l = FOLDR (\x l'. (y = x) \/ l') F l", REWRITE_TAC[IS_EL_DEF; SOME_EL_FOLDR;FOLDR_MAP] THEN BETA_TAC THEN REWRITE_TAC[]);; let IS_EL_FOLDL = prove_thm(`IS_EL_FOLDL`, "!(y:*) l. IS_EL y l = FOLDL (\l' x. l' \/ (y = x)) F l", REWRITE_TAC[IS_EL_DEF;SOME_EL_FOLDL;FOLDL_MAP] THEN BETA_TAC THEN REWRITE_TAC[]);; let NULL_FOLDR = prove_thm(`NULL_FOLDR`, "!(l:* list). NULL l = FOLDR (\x l'. F) T l", LIST_INDUCT_TAC THEN REWRITE_TAC[NULL_DEF;FOLDR]);; let NULL_FOLDL = prove_thm(`NULL_FOLDL`, "!(l:* list). NULL l = FOLDL (\x l'. F) T l", SNOC_INDUCT_TAC THEN REWRITE_TAC[NULL_DEF;FOLDL_SNOC;NULL_EQ_NIL;FOLDL; GSYM (prove_constructors_distinct SNOC_Axiom)]);; let MAP_REVERSE = prove_thm(`MAP_REVERSE`, "!(f:* -> **) l. MAP f (REVERSE l) = REVERSE (MAP f l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;MAP;MAP_SNOC]);; let FILTER_REVERSE = prove_thm(`FILTER_REVERSE`, "!(P:* -> bool) l. FILTER P (REVERSE l) = REVERSE (FILTER P l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;FILTER;FILTER_SNOC] THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REVERSE]);; let LAST = save_thm(`LAST`, % "!(x:*) l. LAST (SNOC x l) = x", % let lem = PROVE( "!x (l:* list). (SEG 1 (PRE(LENGTH (SNOC x l))) (SNOC x l)) = [x]", GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH_SNOC] THEN PURE_ONCE_REWRITE_TAC[PRE] THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN REWRITE_TAC[SNOC;SEG] THEN FIRST_ASSUM ACCEPT_TAC) in GEN_ALL(REWRITE_RULE[lem;HD](SPEC "SNOC (x:*) l" LAST_DEF)));; let BUTLAST = save_thm(`BUTLAST`, % "!x l. BUTLAST (SNOC x l) = l", % let lem = PROVE( "!x:*. !l. SEG (PRE(LENGTH (SNOC x l))) 0 (SNOC x l) = l", GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH_SNOC] THEN PURE_ONCE_REWRITE_TAC[PRE] THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN ASM_REWRITE_TAC[SNOC;SEG]) in GEN_ALL(REWRITE_RULE[lem](SPEC "SNOC (x:*) l" BUTLAST_DEF)));; let SEG_LENGTH_ID = prove_thm(`SEG_LENGTH_ID`, "!l:* list. SEG (LENGTH l) 0 l = l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;SEG]);; let SEG_SUC_CONS = prove_thm(`SEG_SUC_CONS`, "!m n l (x:*). (SEG m (SUC n) (CONS x l) = SEG m n l)", INDUCT_TAC THEN REWRITE_TAC[SEG]);; let SEG_0_SNOC = prove_thm(`SEG_0_SNOC`, "!m l (x:*). (m <= (LENGTH l)) ==> (SEG m 0 (SNOC x l) = SEG m 0 l)", INDUCT_TAC THENL[ REWRITE_TAC[SEG]; LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH] THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_SUC;NOT_LESS_0]; REWRITE_TAC[SNOC;SEG;LESS_EQ_MONO] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]]);; let BUTLASTN_SEG = prove_thm(`BUTLASTN_SEG`, "!n (l:* list). (n <= (LENGTH l)) ==> (BUTLASTN n l = SEG (LENGTH l - n) 0 l)", INDUCT_TAC THEN REWRITE_TAC[BUTLASTN;SUB_0;SEG_LENGTH_ID] THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;BUTLASTN] THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LESS_EQ_MONO;SUB_MONO_EQ] THEN REPEAT STRIP_TAC THEN RES_THEN SUBST1_TAC THEN MATCH_MP_TAC (GSYM SEG_0_SNOC) THEN MATCH_ACCEPT_TAC SUB_LESS_EQ]);; let LASTN_CONS = prove_thm(`LASTN_CONS`, "!n (l:* list). (n <= (LENGTH l)) ==> (!x. LASTN n (CONS x l) = LASTN n l)", INDUCT_TAC THEN REWRITE_TAC[LASTN] THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[LENGTH;LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LENGTH_SNOC;(GSYM(CONJUNCT2 SNOC));LESS_EQ_MONO] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[LASTN]]);; let LENGTH_LASTN = prove_thm(`LENGTH_LASTN`, "!n (l:(*)list). (n <= LENGTH l) ==> (LENGTH (LASTN n l) = n)", INDUCT_TAC THEN REWRITE_TAC[LASTN;LENGTH] THEN SNOC_INDUCT_TAC THENL[ REWRITE_TAC[LENGTH;LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LENGTH_SNOC;LASTN;LESS_EQ_MONO] THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN REFL_TAC]);; let LASTN_LENGTH_ID = prove_thm(`LASTN_LENGTH_ID`, "!l:* list. LASTN (LENGTH l) l = l", SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;LASTN] THEN GEN_TAC THEN POP_ASSUM SUBST1_TAC THEN REFL_TAC);; let LASTN_LASTN = prove_thm(`LASTN_LASTN`, "!l:* list.!n m. (m <= LENGTH l) ==> (n <= m) ==> (LASTN n (LASTN m l) = LASTN n l)", SNOC_INDUCT_TAC THENL[ REWRITE_TAC[LENGTH;LESS_OR_EQ;NOT_LESS_0] THEN REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_LESS_0;LASTN]; GEN_TAC THEN REPEAT INDUCT_TAC THEN REWRITE_TAC[LENGTH_SNOC;LASTN;LESS_EQ_MONO;ZERO_LESS_EQ] THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REPEAT DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]]);; let NOT_SUC_LESS_EQ_0 = PROVE("!n. ~(SUC n <= 0)", REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0;NOT_SUC]);; let FIRSTN_LENGTH_ID = prove_thm(`FIRSTN_LENGTH_ID`, "!l:* list. FIRSTN (LENGTH l) l = l", LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;FIRSTN] THEN GEN_TAC THEN POP_ASSUM SUBST1_TAC THEN REFL_TAC);; let FIRSTN_SNOC = prove_thm(`FIRSTN_SNOC`, "!n (l:* list). (n <= (LENGTH l)) ==> (!x. FIRSTN n (SNOC x l) = FIRSTN n l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FIRSTN;LENGTH] THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LESS_EQ_MONO;SNOC;FIRSTN] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]);; let BUTLASTN_LENGTH_NIL = prove_thm(`BUTLASTN_LENGTH_NIL`, "!l:* list. BUTLASTN (LENGTH l) l = []", SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;LENGTH_SNOC;BUTLASTN]);; let BUTLASTN_SUC_BUTLAST = prove_thm(`BUTLASTN_SUC_BUTLAST`, "!n (l:(*)list). (n < (LENGTH l)) ==> (BUTLASTN (SUC n) l = BUTLASTN n (BUTLAST l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0;BUTLASTN;BUTLAST]);; let BUTLASTN_BUTLAST = prove_thm(`BUTLASTN_BUTLAST`, "!n (l:(*)list). (n < (LENGTH l)) ==> (BUTLASTN n (BUTLAST l) = BUTLAST (BUTLASTN n l))", INDUCT_TAC THEN REWRITE_TAC[BUTLASTN] THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;NOT_LESS_0; LESS_MONO_EQ;BUTLASTN;BUTLAST] THEN DISCH_TAC THEN IMP_RES_THEN SUBST1_TAC BUTLASTN_SUC_BUTLAST THEN RES_TAC);; let LENGTH_BUTLASTN = prove_thm(`LENGTH_BUTLASTN`, "!n (l:(*)list). (n <= LENGTH l) ==> (LENGTH (BUTLASTN n l) = LENGTH l - n)", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[BUTLASTN;SUB_0] THENL[ REWRITE_TAC[LENGTH;LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO;SUB_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let ADD_SUC_lem = let l = CONJUNCTS ADD_CLAUSES in GEN_ALL (TRANS (el 4 l) (SYM (el 3 l))) ;; let BUTLASTN_BUTLASTN = prove_thm(`BUTLASTN_BUTLASTN`, "!m n (l:* list). ((n + m) <= LENGTH l) ==> (BUTLASTN n (BUTLASTN m l) = BUTLASTN (n + m) l)", REPEAT INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;ADD;ADD_0;BUTLASTN] THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO;ADD_SUC_lem] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let APPEND_BUTLASTN_LASTN = prove_thm (`APPEND_BUTLASTN_LASTN`, "!n (l:(*)list) . (n <= LENGTH l) ==> (APPEND (BUTLASTN n l) (LASTN n l) = l)", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[BUTLASTN;LASTN;APPEND;APPEND_NIL] THENL[ REWRITE_TAC[LENGTH;LESS_OR_EQ;NOT_LESS_0;NOT_SUC]; REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO;APPEND_SNOC] THEN GEN_TAC THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN REFL_TAC]);; let APPEND_FIRSTN_LASTN = prove_thm(`APPEND_FIRSTN_LASTN`, "!m n (l:* list). ((m + n) = (LENGTH l)) ==> (APPEND (FIRSTN n l) (LASTN m l) = l)", let ADD_EQ_LESS_EQ = PROVE("!m n p. ((n + m) = p) ==> (m <= p)", REPEAT GEN_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN PURE_ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LESS_EQ_ADD) in REPEAT INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;ADD;ADD_0;FIRSTN;LASTN; APPEND;APPEND_NIL;SUC_NOT;NOT_SUC] THENL[ GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC (SYM(SPEC_ALL LENGTH_SNOC)) THEN MATCH_ACCEPT_TAC FIRSTN_LENGTH_ID; PURE_ONCE_REWRITE_TAC[INV_SUC_EQ] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LASTN_LENGTH_ID]; PURE_ONCE_REWRITE_TAC[INV_SUC_EQ;ADD_SUC_lem;APPEND_SNOC] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC ADD_EQ_LESS_EQ THEN IMP_RES_TAC FIRSTN_SNOC THEN RES_TAC THEN ASM_REWRITE_TAC[]]);; let BUTLASTN_APPEND2 = prove_thm (`BUTLASTN_APPEND2`, "!n l1 (l2:* list). (n <= LENGTH l2) ==> (BUTLASTN n (APPEND l1 l2) = APPEND l1 (BUTLASTN n l2))", INDUCT_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTLASTN;NOT_SUC_LESS_EQ_0;APPEND_SNOC] THEN ASM_REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO]);; %----------------------------------------------------------------------------% % "!(l1:* list) (l2:* list). BUTLASTN(LENGTH l2)(APPEND l1 l2) = l1" % %----------------------------------------------------------------------------% let BUTLASTN_LENGTH_APPEND = save_thm(`BUTLASTN_LENGTH_APPEND`, GEN_ALL (REWRITE_RULE[LESS_EQ_REFL;BUTLASTN_LENGTH_NIL;APPEND_NIL] (SPECL["LENGTH (l2:* list)";"l1:* list";"l2:* list"] BUTLASTN_APPEND2)));; let LASTN_LENGTH_APPEND = prove_thm(`LASTN_LENGTH_APPEND`, "!l1 (l2:* list). LASTN (LENGTH l2) (APPEND l1 l2) = l2", GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;APPEND;APPEND_SNOC;LASTN] THEN ASM_REWRITE_TAC[BUTLAST;LAST;SNOC_APPEND]);; let BUTLASTN_CONS = prove_thm(`BUTLASTN_CONS`, "!n l. (n <= (LENGTH l)) ==> (!x:*. BUTLASTN n(CONS x l) = CONS x(BUTLASTN n l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_SUC_LESS_EQ_0;BUTLASTN;GSYM(CONJUNCT2 SNOC)] THEN ASM_REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO]);; % |- !l x. BUTLASTN(LENGTH l)(CONS x l) = [x] % let BUTLASTN_LENGTH_CONS = save_thm(`BUTLASTN_LENGTH_CONS`, let thm1 = SPECL ["LENGTH (l:* list)";"l:* list"] BUTLASTN_CONS in GEN_ALL(REWRITE_RULE[LESS_EQ_REFL;BUTLASTN_LENGTH_NIL] thm1));; let LAST_LASTN_LAST = prove_thm(`LAST_LASTN_LAST`, "!n (l:(*)list). (n <= LENGTH l) ==> (0 < n) ==> (LAST(LASTN n l) = LAST l)", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LASTN;LAST]);; let BUTLASTN_LASTN_NIL = prove_thm(`BUTLASTN_LASTN_NIL`, "!n. !l:* list. n <= (LENGTH l) ==> (BUTLASTN n (LASTN n l) = [])", REPEAT STRIP_TAC THEN IMP_RES_THEN (\t. SUBST_OCCS_TAC [[1],(SYM t)]) LENGTH_LASTN THEN MATCH_ACCEPT_TAC BUTLASTN_LENGTH_NIL);; let LASTN_BUTLASTN = prove_thm(`LASTN_BUTLASTN`, "!n m. !l:* list. ((n + m) <= LENGTH l) ==> (LASTN n (BUTLASTN m l) = BUTLASTN m (LASTN (n + m) l))", let ADD_SUC_SYM = GEN_ALL (SYM (TRANS (SPEC_ALL(CONJUNCT2 ADD)) (SPEC_ALL ADD_SUC))) in REPEAT INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_SUC_LESS_EQ_0;ADD;ADD_0;LASTN;BUTLASTN] THEN REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO] THENL[ DISCH_TAC THEN CONV_TAC SYM_CONV THEN IMP_RES_TAC BUTLASTN_LASTN_NIL; PURE_ONCE_REWRITE_TAC[ADD_SUC_SYM] THEN DISCH_TAC THEN RES_TAC]);; let BUTLASTN_LASTN = prove_thm(`BUTLASTN_LASTN`, "!m n. !l:* list. ((m <= n) /\ (n <= LENGTH l)) ==> (BUTLASTN m (LASTN n l) = LASTN (n - m) (BUTLASTN m l))", REPEAT INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0;NOT_SUC_LESS_EQ_0;SUB_0;BUTLASTN;LASTN] THEN ASM_REWRITE_TAC[LENGTH_SNOC;LESS_EQ_MONO;SUB_MONO_EQ]);; let LASTN_1 = prove_thm(`LASTN_1`, "!l:* list. ~(l = []) ==> (LASTN 1 l = [LAST l])", SNOC_INDUCT_TAC THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC[LASTN;APPEND_NIL;SNOC;LAST]);; let BUTLASTN_1 = prove_thm(`BUTLASTN_1`, "!l:* list. ~(l = []) ==> (BUTLASTN 1 l = BUTLAST l)", SNOC_INDUCT_TAC THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC[BUTLAST;BUTLASTN]);; let BUTLASTN_APPEND1 = prove_thm(`BUTLASTN_APPEND1`, "!l2 n. (LENGTH l2 <= n) ==> (!l1:* list. BUTLASTN n (APPEND l1 l2) = BUTLASTN (n - (LENGTH l2)) l1)", SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;APPEND;APPEND_SNOC;APPEND_NIL;SUB_0] THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;LESS_EQ_MONO;BUTLASTN;SUB_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let LASTN_APPEND2 = prove_thm(`LASTN_APPEND2`, "!n (l2:* list). n <= (LENGTH l2) ==> (!l1. LASTN n (APPEND l1 l2) = LASTN n l2)", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;LASTN;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LESS_EQ_MONO;LASTN;APPEND_SNOC] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LASTN_APPEND1 = prove_thm(`LASTN_APPEND1`, "!(l2:* list) n. (LENGTH l2) <= n ==> (!l1. LASTN n (APPEND l1 l2) = APPEND (LASTN (n - (LENGTH l2)) l1) l2)", SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC; APPEND;APPEND_SNOC;APPEND_NIL;LASTN;SUB_0] THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;LASTN;LESS_EQ_MONO;SUB_MONO_EQ] THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LASTN_MAP = prove_thm(`LASTN_MAP`, "!n l. (n <= LENGTH l) ==> (!(f:*->**). LASTN n (MAP f l) = MAP f (LASTN n l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LASTN;MAP;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LENGTH_SNOC;LASTN;MAP_SNOC;LESS_EQ_MONO] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let BUTLASTN_MAP = prove_thm(`BUTLASTN_MAP`, "!n l. (n <= LENGTH l) ==> (!(f:*->**). BUTLASTN n (MAP f l) = MAP f (BUTLASTN n l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTLASTN;MAP;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LENGTH_SNOC;BUTLASTN;MAP_SNOC;LESS_EQ_MONO] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let ALL_EL_LASTN = prove_thm(`ALL_EL_LASTN`, "!P (l:* list). ALL_EL P l ==> (!m. m <= (LENGTH l) ==> ALL_EL P (LASTN m l))", GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[ALL_EL;LENGTH] THEN GEN_TAC THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ALL_EL;LASTN]; REWRITE_TAC[ALL_EL_SNOC;LENGTH_SNOC] THEN STRIP_TAC THEN INDUCT_TAC THENL[ REWRITE_TAC[ALL_EL;LASTN]; REWRITE_TAC[ALL_EL_SNOC;LASTN;LESS_EQ_MONO] THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]]);; let ALL_EL_BUTLASTN = prove_thm(`ALL_EL_BUTLASTN`, "!P (l:* list). ALL_EL P l ==> (!m. m <= (LENGTH l) ==> ALL_EL P (BUTLASTN m l))", GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[ALL_EL;LENGTH] THEN GEN_TAC THENL[ REWRITE_TAC[LESS_OR_EQ;NOT_LESS_0] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ALL_EL;BUTLASTN]; REWRITE_TAC[ALL_EL_SNOC;LENGTH_SNOC] THEN STRIP_TAC THEN INDUCT_TAC THENL[ DISCH_TAC THEN ASM_REWRITE_TAC[ALL_EL_SNOC;BUTLASTN]; REWRITE_TAC[ALL_EL_SNOC;BUTLASTN;LESS_EQ_MONO] THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]]);; let LENGTH_FIRSTN = prove_thm (`LENGTH_FIRSTN`, "!n (l:(*)list). (n <= LENGTH l) ==> (LENGTH (FIRSTN n l) = n)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;FIRSTN;NOT_SUC_LESS_EQ_0;LESS_EQ_MONO] THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN REFL_TAC);; let FIRSTN_FIRSTN = prove_thm(`FIRSTN_FIRSTN`, "!m (l:* list). (m <= LENGTH l) ==> !n. (n <= m) ==> (FIRSTN n (FIRSTN m l) = FIRSTN n l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;FIRSTN] THENL[ GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;FIRSTN]; REWRITE_TAC[NOT_SUC_LESS_EQ_0]; GEN_TAC THEN REWRITE_TAC[LESS_EQ_MONO] THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FIRSTN] THEN REWRITE_TAC[LESS_EQ_MONO] THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]);; let LENGTH_BUTFIRSTN = prove_thm(`LENGTH_BUTFIRSTN`, "!n (l:* list). (n <= (LENGTH l)) ==> (LENGTH (BUTFIRSTN n l) = LENGTH l - n)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTFIRSTN;SUB_0;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LESS_EQ_MONO;SUB_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let BUTFIRSTN_LENGTH_NIL = prove_thm(`BUTFIRSTN_LENGTH_NIL`, "!l:* list. BUTFIRSTN (LENGTH l) l = []", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;BUTFIRSTN]);; let BUTFIRSTN_APPEND1 = prove_thm(`BUTFIRSTN_APPEND1`, "!n (l1:* list). (n <= LENGTH l1) ==> !l2. BUTFIRSTN n (APPEND l1 l2) = APPEND (BUTFIRSTN n l1) l2", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTFIRSTN;NOT_SUC_LESS_EQ_0;LESS_EQ_MONO] THEN GEN_TAC THEN ASM_REWRITE_TAC[APPEND;BUTFIRSTN]);; let BUTFIRSTN_APPEND2 = prove_thm(`BUTFIRSTN_APPEND2`, "!(l1:* list) n. ((LENGTH l1) <= n) ==> !l2. BUTFIRSTN n (APPEND l1 l2) = BUTFIRSTN (n - (LENGTH l1)) l2", LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTFIRSTN;APPEND;SUB_0] THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC [NOT_SUC_LESS_EQ_0;LESS_EQ_MONO;BUTFIRSTN;SUB_MONO_EQ]);; let BUTFIRSTN_BUTFIRSTN = prove_thm(`BUTFIRSTN_BUTFIRSTN`, "!n m (l:* list). ((n + m) <= LENGTH l) ==> (BUTFIRSTN n(BUTFIRSTN m l) = BUTFIRSTN (n + m) l)", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTFIRSTN;NOT_SUC_LESS_EQ_0;NOT_LESS_0;ADD;ADD_0] THEN REWRITE_TAC[ADD_SUC_lem;LESS_EQ_MONO] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let APPEND_FIRSTN_BUTFIRSTN = prove_thm(`APPEND_FIRSTN_BUTFIRSTN`, "!n (l:* list). (n <= LENGTH l) ==> (APPEND (FIRSTN n l) (BUTFIRSTN n l) = l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;FIRSTN;BUTFIRSTN;APPEND;NOT_SUC_LESS_EQ_0] THEN PURE_ONCE_REWRITE_TAC[LESS_EQ_MONO] THEN GEN_TAC THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LASTN_SEG = prove_thm(`LASTN_SEG`, "!n (l:* list). (n <= (LENGTH l)) ==> (LASTN n l = SEG n (LENGTH l - n) l)", let SUB_SUC = PROVE("!k m. (m < k) ==> (k - m = SUC (k - SUC m))", REPEAT GEN_TAC THEN SUBST_TAC[SYM(SPECL["k:num";"m:num"]SUB_MONO_EQ)] THEN DISCH_THEN \thm . let thm' = MATCH_MP LESS_SUC_NOT thm in ACCEPT_TAC (REWRITE_RULE [thm'] (SPECL ["k:num";"SUC m"] (CONJUNCT2 SUB)))) in INDUCT_TAC THEN REWRITE_TAC[LASTN;SUB_0;SEG] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LASTN;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LESS_EQ_MONO;SUB_MONO_EQ] THEN GEN_TAC THEN DISCH_TAC THEN IMP_RES_TAC LESS_OR_EQ THENL[ IMP_RES_THEN SUBST1_TAC SUB_SUC THEN PURE_ONCE_REWRITE_TAC[SEG] THEN IMP_RES_TAC LESS_EQ THEN RES_THEN (SUBST1_TAC o SYM) THEN MATCH_MP_TAC LASTN_CONS THEN FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[SUB_EQUAL_0] THEN SUBST1_TAC(SYM(SPECL["h:*";"l:* list"](CONJUNCT2 LENGTH))) THEN REWRITE_TAC[SEG_LENGTH_ID;LASTN_LENGTH_ID]]);; let FIRSTN_SEG = prove_thm(`FIRSTN_SEG`, "!n (l:* list). (n <= (LENGTH l)) ==> (FIRSTN n l = SEG n 0 l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;FIRSTN;SEG;NOT_SUC_LESS_EQ_0;LESS_EQ_MONO] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let BUTFIRSTN_SEG = prove_thm(`BUTFIRSTN_SEG`, "!n (l:* list). (n <= (LENGTH l)) ==> (BUTFIRSTN n l = SEG (LENGTH l - n) n l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTFIRSTN;SEG;NOT_SUC_LESS_EQ_0; LESS_EQ_MONO;SUB_0;SEG_LENGTH_ID] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[SUB_MONO_EQ;SEG_SUC_CONS]);; let APPEND_BUTLAST_LAST = prove_thm(`APPEND_BUTLAST_LAST`, "!l:* list. ~(l = []) ==> (APPEND (BUTLAST l) [(LAST l)] = l)", SNOC_INDUCT_TAC THEN REWRITE_TAC[NOT_SNOC_NIL;BUTLAST;LAST;SNOC_APPEND]);; let BUTFIRSTN_SNOC = prove_thm(`BUTFIRSTN_SNOC`, "!n (l:* list). (n <= LENGTH l) ==> (!x. BUTFIRSTN n (SNOC x l) = SNOC x (BUTFIRSTN n l))", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;BUTFIRSTN;SNOC;NOT_SUC_LESS_EQ_0;LESS_EQ_MONO] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let APPEND_BUTLASTN_BUTFIRSTN = prove_thm(`APPEND_BUTLASTN_BUTFIRSTN`, "!m n (l:* list). ((m + n) = (LENGTH l)) ==> (APPEND (BUTLASTN m l) (BUTFIRSTN n l) = l)", let ADD_EQ_LESS_EQ = PROVE("!m n p. ((m+n)=p) ==> (m<=p)", REPEAT STRIP_TAC THEN POP_ASSUM(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[LESS_EQ_ADD]) in REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;APPEND;ADD;ADD_0;NOT_SUC;SUC_NOT;SNOC; NOT_SUC_LESS_EQ_0;LESS_EQ_MONO;INV_SUC_EQ] THENL[ REWRITE_TAC[BUTLASTN;BUTFIRSTN;APPEND]; GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC (SYM(SPECL["h:*";"l:* list"](CONJUNCT2 LENGTH))) THEN REWRITE_TAC[BUTFIRSTN_LENGTH_NIL;BUTLASTN;APPEND_NIL]; GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC (SYM(SPECL["h:*";"l:* list"](CONJUNCT2 LENGTH))) THEN REWRITE_TAC[BUTLASTN_LENGTH_NIL;BUTFIRSTN;APPEND]; GEN_TAC THEN DISCH_TAC THEN PURE_ONCE_REWRITE_TAC[BUTFIRSTN] THEN RULE_ASSUM_TAC (REWRITE_RULE[ADD_SUC_lem]) THEN IMP_RES_TAC ADD_EQ_LESS_EQ THEN IMP_RES_TAC BUTLASTN_CONS THEN ASM_REWRITE_TAC[APPEND;CONS_11] THEN RES_TAC]);; let SEG_SEG = prove_thm(`SEG_SEG`, "!n1 m1 n2 m2 (l:* list). (((n1 + m1) <= (LENGTH l)) /\ ((n2 + m2) <= n1)) ==> (SEG n2 m2 (SEG n1 m1 l) = SEG n2 (m1 + m2) l)", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;SEG;NOT_LESS_0;NOT_SUC_LESS_EQ_0;ADD;ADD_0] THENL[ GEN_TAC THEN REWRITE_TAC[LESS_EQ_MONO;CONS_11] THEN STRIP_TAC THEN SUBST_OCCS_TAC[[3],(SYM(SPEC"0"ADD_0))] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_0]; REWRITE_TAC[LESS_EQ_MONO;ADD_SUC_lem] THEN STRIP_TAC THEN SUBST_OCCS_TAC[[2],SYM(SPEC"m2:num"(CONJUNCT1 ADD))] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_0]; REWRITE_TAC[LESS_EQ_MONO;ADD_SUC_lem] THEN STRIP_TAC THEN SUBST_OCCS_TAC[[2],SYM(SPEC"m1:num"ADD_0)] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LESS_EQ_MONO;ADD_0]; PURE_ONCE_REWRITE_TAC[LESS_EQ_MONO] THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL[ PURE_ONCE_REWRITE_TAC[GSYM ADD_SUC_lem] THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC[ADD;LESS_EQ_MONO]]]);; let SEG_APPEND1 = prove_thm(`SEG_APPEND1`, "!n m (l1:* list). ((n + m) <= LENGTH l1) ==> (!l2. SEG n m (APPEND l1 l2) = SEG n m l1)", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;SEG;NOT_LESS_0;NOT_SUC_LESS_EQ_0;ADD;ADD_0] THEN GEN_TAC THEN REWRITE_TAC[LESS_EQ_MONO;APPEND;SEG;CONS_11] THENL[ DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_0]; PURE_ONCE_REWRITE_TAC[ADD_SUC_lem] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let SEG_APPEND2 = prove_thm(`SEG_APPEND2`, "!l1:* list. !m n l2. (LENGTH l1 <= m) /\ (n <= LENGTH l2) ==> (SEG n m (APPEND l1 l2) = SEG n (m - (LENGTH l1)) l2)", LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "m:num") THEN REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;SEG;NOT_LESS_0;NOT_SUC_LESS_EQ_0;ADD;ADD_0] THEN REPEAT GEN_TAC THEN REWRITE_TAC[SUB_0;APPEND;SEG] THEN REWRITE_TAC[LESS_EQ_MONO;SUB_MONO_EQ] THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LENGTH;LESS_EQ_MONO]);; let SEG_FIRSTN_BUTFIRSTN = prove_thm(`SEG_FIRSTN_BUTFISTN`, "!n m (l:* list). ((n + m) <= (LENGTH l)) ==> (SEG n m l = FIRSTN n (BUTFIRSTN m l))", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_SUC_LESS_EQ_0;ADD;ADD_0; SEG;FIRSTN;BUTFIRSTN;LESS_EQ_MONO;CONS_11] THENL[ MATCH_ACCEPT_TAC (GSYM FIRSTN_SEG); PURE_ONCE_REWRITE_TAC[ADD_SUC_lem] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let SEG_APPEND = prove_thm(`SEG_APPEND`, "!m (l1:* list) n l2. (m < LENGTH l1) /\ ((LENGTH l1) <= (n + m)) /\ ((n + m) <= ((LENGTH l1) + (LENGTH l2))) ==> (SEG n m (APPEND l1 l2) = APPEND (SEG ((LENGTH l1) - m) m l1) (SEG ((n + m)-(LENGTH l1)) 0 l2))", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "n:num") THEN INDUCT_TAC THEN LIST_INDUCT_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[LENGTH;SEG;NOT_LESS_0;NOT_SUC_LESS_EQ_0;ADD;ADD_0;SUB_0] THEN REWRITE_TAC [LESS_EQ_MONO;SUB_0;SUB_MONO_EQ;APPEND;SEG;NOT_SUC_LESS_EQ_0;CONS_11] THEN RULE_ASSUM_TAC (REWRITE_RULE[ADD_0;SUB_0]) THENL[ DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC) THEN POP_ASSUM (SUBST1_TAC o (MATCH_MP LESS_EQUAL_ANTISYM)) THEN REWRITE_TAC[SEG;APPEND_NIL;SUB_EQUAL_0]; STRIP_TAC THEN DISJ_CASES_TAC (SPEC "LENGTH (l1:* list)"LESS_0_CASES) THENL[ POP_ASSUM (ASSUME_TAC o SYM) THEN IMP_RES_TAC LENGTH_NIL THEN ASM_REWRITE_TAC[APPEND;SEG;SUB_0]; FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LENGTH]]; DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC) THEN POP_ASSUM (SUBST1_TAC o (MATCH_MP LESS_EQUAL_ANTISYM)) THEN REWRITE_TAC[SEG;APPEND_NIL;SUB_EQUAL_0]; REWRITE_TAC[LESS_MONO_EQ;GSYM NOT_LESS] THEN STRIP_TAC THEN RES_TAC; DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC) THEN POP_ASSUM (SUBST1_TAC o (MATCH_MP LESS_EQUAL_ANTISYM)) THEN REWRITE_TAC[SEG;APPEND_NIL;SUB_EQUAL_0] THEN REWRITE_TAC[ADD_SUC_lem;ADD_SUB;SEG]; REWRITE_TAC[LESS_MONO_EQ;SEG_SUC_CONS] THEN STRIP_TAC THEN PURE_ONCE_REWRITE_TAC[ADD_SUC_lem] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GSYM ADD_SUC_lem;LENGTH]]);; let SEG_LENGTH_SNOC = prove_thm(`SEG_LENGTH_SNOC`, "!(l:* list) x. SEG 1 (LENGTH l) (SNOC x l) = [x]", CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;SNOC;SEG]);; let SEG_SNOC = prove_thm(`SEG_SNOC`, "!n m (l:* list). ((n + m) <= LENGTH l) ==> !x. SEG n m (SNOC x l) = SEG n m l", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_SUC_LESS_EQ_0;ADD;ADD_0;SNOC;SEG] THENL[ REWRITE_TAC[CONS_11;LESS_EQ_MONO] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ADD_0]; REWRITE_TAC[LESS_EQ_MONO;ADD_SUC_lem] THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; let ELL_SEG = prove_thm(`ELL_SEG`, "!n (l:* list). (n < LENGTH l) ==> (ELL n l = HD(SEG 1 (PRE(LENGTH l - n)) l))", let SUC_PRE = PROVE("!n . (0 < n) ==> ((SUC (PRE n)) = n)", REPEAT STRIP_TAC THEN (ACCEPT_TAC (REWRITE_RULE[] (MATCH_MP (SPECL["PRE n";"n:num"] PRE_SUC_EQ) (ASSUME "0 < n") )))) in INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;LENGTH_SNOC;NOT_LESS_0] THENL[ REWRITE_TAC[PRE;SUB_0;ELL;LAST;SEG_LENGTH_SNOC;HD]; REWRITE_TAC[LESS_MONO_EQ;ELL;BUTLAST;SUB_MONO_EQ] THEN REPEAT STRIP_TAC THEN RES_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN AP_TERM_TAC THEN MATCH_MP_TAC SEG_SNOC THEN PURE_ONCE_REWRITE_TAC[ADD_SYM] THEN PURE_ONCE_REWRITE_TAC[GSYM ADD1] THEN IMP_RES_TAC SUB_LESS_0 THEN IMP_RES_THEN SUBST1_TAC SUC_PRE THEN MATCH_ACCEPT_TAC SUB_LESS_EQ]);; %---------------------------------------------------------------------- % % 31 Jan 94 % %---------------------------------------------------------------------- % let REWRITE1_TAC = \t.REWRITE_TAC[t];; let SNOC_FOLDR = prove_thm (`SNOC_FOLDR`, "!(x:*) l. SNOC x l = FOLDR CONS [x] l ", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FOLDR;SNOC]);; let IS_EL_FOLDR_MAP = prove_thm(`IS_EL_FOLDR_MAP`, "!(x:*) l. IS_EL x l = FOLDR $\/ F (MAP ($= x) l)", REWRITE_TAC[IS_EL_FOLDR;FOLDR_MAP]);; let IS_EL_FOLDL_MAP = prove_thm(`IS_EL_FOLDL_MAP`, "!(x:*) l. IS_EL x l = FOLDL $\/ F (MAP ($= x) l)", REWRITE_TAC[IS_EL_FOLDL;FOLDL_MAP]);; let FILTER_FILTER = prove_thm(`FILTER_FILTER`, "!P Q (l:* list). FILTER P (FILTER Q l) = FILTER (\x. P x /\ Q x) l", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER] THEN BETA_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FILTER]);; let FCOMM_FOLDR_FLAT = prove_thm(`FCOMM_FOLDR_FLAT`, "!(g:*->*->*) (f:**->*->*). FCOMM g f ==> (! e. LEFT_ID g e ==> (!l. FOLDR f e (FLAT l) = FOLDR g e (MAP (FOLDR f e) l)))", GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;MAP;FOLDR] THEN IMP_RES_TAC FCOMM_FOLDR_APPEND THEN ASM_REWRITE_TAC[]);; let FCOMM_FOLDL_FLAT = prove_thm(`FCOMM_FOLDL_FLAT`, "!(f:*->**->*) (g:*->*->*). FCOMM f g ==> (! e. RIGHT_ID g e ==> (!l. FOLDL f e (FLAT l) = FOLDL g e (MAP (FOLDL f e) l)))", GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT_SNOC;MAP_SNOC;MAP;FLAT;FOLDL_SNOC;FOLDL] THEN IMP_RES_TAC FCOMM_FOLDL_APPEND THEN ASM_REWRITE_TAC[]);; let FOLDR1 = PROVE( "!(f:*->*->*). (!a b c. f a (f b c) = f b (f a c)) ==> (!e l. (FOLDR f (f h e) l = f h (FOLDR f e l)))", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[REVERSE; FOLDR] THEN ONCE_REWRITE_TAC [ASSUME "!a b c. (f:*->*->*) a (f b c) = f b (f a c)"] THEN REWRITE_TAC[ASSUME"FOLDR (f:*->*->*)(f h e) l = f h (FOLDR f e l)"]);; let FOLDL1 = PROVE( "!(f:*->*->*). (!a b c. f (f a b) c = f (f a c) b) ==> (!e l. (FOLDL f (f e h) l = f (FOLDL f e l) h))", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[REVERSE; FOLDL; FOLDL_SNOC] THEN ONCE_REWRITE_TAC [ASSUME "!a b c. (f:*->*->*) (f a b) c = f (f a c) b"] THEN REWRITE_TAC[ASSUME"FOLDL(f:*->*->*)(f e h) l = f (FOLDL f e l) h"]);; let FOLDR_REVERSE2 = PROVE( "!(f:*->*->*). (!a b c. f a (f b c) = f b (f a c)) ==> (!e l. FOLDR f e (REVERSE l) = FOLDR f e l)", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE; FOLDR; FOLDR_SNOC] THEN IMP_RES_TAC FOLDR1 THEN ASM_REWRITE_TAC[]);; let FOLDR_MAP_REVERSE = prove_thm(`FOLDR_MAP_REVERSE`, "!(f:*->*->*). (!a b c. f a (f b c) = f b (f a c)) ==> (!e (g:**->*) l. FOLDR f e (MAP g (REVERSE l)) = FOLDR f e (MAP g l))", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE; FOLDR; FOLDR_SNOC;MAP;MAP_SNOC] THEN IMP_RES_TAC FOLDR1 THEN ASM_REWRITE_TAC[]);; let FOLDR_FILTER_REVERSE = prove_thm(`FOLDR_FILTER_REVERSE`, "!(f:*->*->*). (!a b c. f a (f b c) = f b (f a c)) ==> (!e (P:*->bool) l. FOLDR f e (FILTER P (REVERSE l)) = FOLDR f e (FILTER P l))", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE; FOLDR; FOLDR_SNOC;FILTER;FILTER_SNOC] THEN IMP_RES_TAC FOLDR1 THEN GEN_TAC THEN COND_CASES_TAC THENL[ ASM_REWRITE_TAC[ FOLDR; FOLDR_SNOC;FILTER;FILTER_SNOC] THEN ASM_REWRITE_TAC[GSYM FILTER_REVERSE]; ASM_REWRITE_TAC[ FOLDR; FOLDR_SNOC;FILTER;FILTER_SNOC]]);; let FOLDL_REVERSE2 = PROVE( "!(f:*->*->*). (!a b c. f (f a b) c = f (f a c) b) ==> (!e l. FOLDL f e (REVERSE l) = FOLDL f e l)", GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;REVERSE_SNOC; FOLDL; FOLDL_SNOC] THEN IMP_RES_TAC FOLDL1 THEN ASM_REWRITE_TAC[]);; let COMM_ASSOC_LEM1 = PROVE( "!(f:*->*->*). COMM f ==> (ASSOC f ==> (!a b c. f a (f b c) = f b (f a c)))", REWRITE_TAC[ASSOC_DEF] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SUBST1_TAC(SPECL ["a:*";"b:*"] (REWRITE_RULE [COMM_DEF] (ASSUME "COMM (f:*->*->*)"))) THEN REWRITE_TAC[]);; let COMM_ASSOC_LEM2 = PROVE( "!(f:*->*->*). COMM f ==> (ASSOC f ==> (!a b c. f (f a b) c = f (f a c) b))", REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [GSYM (REWRITE_RULE[ASSOC_DEF] (ASSUME "ASSOC (f:*->*->*)"))] THEN SUBST1_TAC(SPECL ["b:*";"c:*"] (REWRITE_RULE [COMM_DEF] (ASSUME "COMM (f:*->*->*)"))) THEN REWRITE_TAC[]);; let COMM_ASSOC_FOLDR_REVERSE = prove_thm(`COMM_ASSOC_FOLDR_REVERSE`, "!f:*->*->*. COMM f ==> (ASSOC f ==> (!e l. FOLDR f e (REVERSE l) = FOLDR f e l))", REPEAT STRIP_TAC THEN MATCH_MP_TAC FOLDR_REVERSE2 THEN IMP_RES_TAC COMM_ASSOC_LEM1);; let COMM_ASSOC_FOLDL_REVERSE = prove_thm(`COMM_ASSOC_FOLDL_REVERSE`, "!f:*->*->*. COMM f ==> (ASSOC f ==> (!e l. FOLDL f e (REVERSE l) = FOLDL f e l))", REPEAT STRIP_TAC THEN MATCH_MP_TAC FOLDL_REVERSE2 THEN IMP_RES_TAC COMM_ASSOC_LEM2);; %<------------------------------------------------------------>% let ELL_LAST = prove_thm(`ELL_LAST`, "!l:* list. ~(NULL l) ==> (ELL 0 l = LAST l)", SNOC_INDUCT_TAC THENL[ REWRITE_TAC[NULL]; REPEAT STRIP_TAC THEN REWRITE_TAC[ELL]]);; let ELL_0_SNOC = prove_thm(`ELL_0_SNOC`, "!l:* list. !x. (ELL 0 (SNOC x l) = x)", REPEAT GEN_TAC THEN REWRITE_TAC[ELL;LAST]);; let ELL_SNOC = prove_thm(`ELL_SNOC`, "!n. (0 < n) ==> !x (l:* list).ELL n (SNOC x l) = ELL (PRE n) l", INDUCT_TAC THENL[ REWRITE_TAC[NOT_LESS_0]; REWRITE_TAC[ELL;BUTLAST;PRE;LESS_0]]);; % |- !n x (l:* list). (ELL (SUC n) (SNOC x l) = ELL n l) % let ELL_SUC_SNOC = save_thm(`ELL_SUC_SNOC`, GEN_ALL(PURE_ONCE_REWRITE_RULE[PRE] (MP (SPEC "SUC n" ELL_SNOC) (SPEC_ALL LESS_0))));; let ELL_CONS = prove_thm(`ELL_CONS`, "!n (l:* list). n < (LENGTH l) ==> (!x. ELL n (CONS x l) = ELL n l)", let SNOC_lem = GSYM(CONJUNCT2 SNOC) in INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0;LENGTH] THENL[ REPEAT STRIP_TAC THEN REWRITE_TAC[SNOC_lem;ELL_0_SNOC]; GEN_TAC THEN REWRITE_TAC[LENGTH_SNOC;LESS_MONO_EQ; ELL_SUC_SNOC;SNOC_lem] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let ELL_LENGTH_CONS = prove_thm(`ELL_LENGTH_CONS`, "!l:* list. !x. (ELL (LENGTH l) (CONS x l) = x)", let LAST_EL = % "!x:*. LAST [x] = x" % GEN_ALL(REWRITE_RULE[SNOC](SPECL["x:*";"[]:* list"]LAST)) in SNOC_INDUCT_TAC THENL[ REWRITE_TAC[ELL;LENGTH;LAST_EL]; REWRITE_TAC[ELL;LENGTH_SNOC;BUTLAST;(GSYM(CONJUNCT2 SNOC))] THEN POP_ASSUM ACCEPT_TAC]);; let ELL_LENGTH_SNOC = prove_thm(`ELL_LENGTH_SNOC`, "!l:* list. !x. (ELL (LENGTH l) (SNOC x l) = (NULL l => x | HD l))", LIST_INDUCT_TAC THENL[ REWRITE_TAC[ELL_0_SNOC;LENGTH;NULL]; REWRITE_TAC[ELL_SUC_SNOC;LENGTH;HD;NULL;ELL_LENGTH_CONS]]);; let ELL_APPEND2 = prove_thm(`ELL_APPEND2`, "!n l2. n < LENGTH l2 ==> !l1:* list. ELL n (APPEND l1 l2) = ELL n l2", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0] THEN REWRITE_TAC[APPEND_SNOC;ELL_0_SNOC;ELL_SUC_SNOC; LENGTH_SNOC;LESS_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let ELL_APPEND1 = prove_thm(`ELL_APPEND1`, "!l2 n. LENGTH l2 <= n ==> !l1:* list. ELL n (APPEND l1 l2) = ELL (n - LENGTH l2) l1", SNOC_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "n:num") THEN INDUCT_TAC THEN REWRITE_TAC [LENGTH;LENGTH_SNOC;SUB_0;APPEND_NIL;NOT_SUC_LESS_EQ_0] THEN REWRITE_TAC[LESS_EQ_MONO;ELL_SUC_SNOC;SUB_MONO_EQ;APPEND_SNOC] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let ELL_PRE_LENGTH = prove_thm(`ELL_PRE_LENGTH`, "!l:* list. ~(l = []) ==> (ELL (PRE(LENGTH l)) l = HD l)", LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;PRE] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[ELL_LENGTH_CONS;HD]);; let EL_LENGTH_SNOC = prove_thm(`EL_LENGTH_SNOC`, "!l:* list. !x. EL (LENGTH l) (SNOC x l) = x", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EL;SNOC;HD;TL;LENGTH]);; let EL_PRE_LENGTH = prove_thm(`EL_PRE_LENGTH`, "!l:* list. ~(l = []) ==> (EL (PRE(LENGTH l)) l = LAST l)", SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH_SNOC;PRE;LAST;EL_LENGTH_SNOC]);; let EL_SNOC = prove_thm(`EL_SNOC`, "!n (l:* list). n < (LENGTH l) ==> (!x. EL n (SNOC x l) = EL n l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0] THENL[ REWRITE_TAC[SNOC;EL;HD]; REWRITE_TAC[SNOC;EL;TL;LESS_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let LESS_PRE_SUB_LESS = PROVE("!n m. (m < n) ==> (PRE(n - m) < n)", let PRE_K_K = PROVE("!k . (0 (PRE k < k)", INDUCT_THEN INDUCTION MP_TAC THEN REWRITE_TAC [LESS_REFL;LESS_0;PRE;LESS_SUC_REFL]) in REPEAT INDUCT_TAC THENL[ REWRITE_TAC[NOT_LESS_0]; REWRITE_TAC[NOT_LESS_0]; REWRITE_TAC[SUB_0;PRE_K_K]; REWRITE_TAC[LESS_MONO_EQ;SUB_MONO_EQ;LESS_THM] THEN DISCH_TAC THEN DISJ2_TAC THEN RES_TAC]);; let EL_ELL = prove_thm(`EL_ELL`, "!n (l:* list). n < LENGTH l ==> (EL n l = ELL (PRE((LENGTH l) - n)) l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0] THENL[ REWRITE_TAC[PRE;EL;ELL_LENGTH_CONS;HD;SUB_0]; REWRITE_TAC[EL;TL;LESS_MONO_EQ;SUB_MONO_EQ] THEN GEN_TAC THEN DISCH_TAC THEN MAP_EVERY IMP_RES_TAC [LESS_PRE_SUB_LESS;ELL_CONS] THEN RES_TAC THEN ASM_REWRITE_TAC[]]);; let EL_LENGTH_APPEND = prove_thm(`EL_LENGTH_APPEND`, "!(l2:(*)list) (l1:(*)list) . ~(NULL l2)==> ( EL (LENGTH l1) (APPEND l1 l2) = HD l2)", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [LENGTH;APPEND;EL;TL;NULL] THEN REPEAT STRIP_TAC THEN RES_TAC);; let ELL_EL = prove_thm(`ELL_EL`, "!n (l:* list). n < LENGTH l ==> (ELL n l = EL (PRE((LENGTH l) - n)) l)", let lem = PROVE("!n m. n < m ==> ?k. (m - n = SUC k) /\ k < m", REPEAT INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0] THENL[ REWRITE_TAC[SUB_0] THEN DISCH_TAC THEN EXISTS_TAC "m:num" THEN REWRITE_TAC[LESS_SUC_REFL]; ASM_REWRITE_TAC[LESS_MONO_EQ;SUB_MONO_EQ] THEN DISCH_TAC THEN RES_TAC THEN EXISTS_TAC "k:num" THEN IMP_RES_TAC LESS_SUC THEN ASM_REWRITE_TAC[]]) in INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0] THENL[ REWRITE_TAC[SUB_0;ELL_0_SNOC;LENGTH_SNOC;PRE;EL_LENGTH_SNOC]; REWRITE_TAC[LENGTH_SNOC;ELL_SUC_SNOC;SUB_MONO_EQ;LESS_MONO_EQ] THEN REPEAT STRIP_TAC THEN RES_THEN SUBST1_TAC THEN MATCH_MP_TAC (GSYM EL_SNOC) THEN IMP_RES_TAC lem THEN ASM_REWRITE_TAC[PRE]]);; let ELL_MAP = prove_thm(`ELL_MAP`, "!n l (f:*->**). n < (LENGTH l) ==> (ELL n (MAP f l) = f (ELL n l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH;NOT_LESS_0] THENL[ REWRITE_TAC[ELL_0_SNOC;MAP_SNOC]; REWRITE_TAC[LENGTH_SNOC;ELL_SUC_SNOC;MAP_SNOC;LESS_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let LENGTH_BUTLAST = prove_thm(`LENGTH_BUTLAST`, "!l:* list. ~(l = []) ==> (LENGTH(BUTLAST l) = PRE(LENGTH l))", SNOC_INDUCT_TAC THEN REWRITE_TAC[LENGTH_SNOC;BUTLAST;PRE]);; let BUTFIRSTN_LENGTH_APPEND = prove_thm(`BUTFIRSTN_LENGTH_APPEND`, "!l1 l2:* list. BUTFIRSTN(LENGTH l1)(APPEND l1 l2) = l2", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;BUTFIRSTN;APPEND]);; let FIRSTN_APPEND1 = prove_thm(`FIRSTN_APPEND1`, "!n (l1:* list). n <= (LENGTH l1) ==> !l2. FIRSTN n (APPEND l1 l2) = FIRSTN n l1", INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [LENGTH;NOT_SUC_LESS_EQ_0;FIRSTN;APPEND;CONS_11;LESS_EQ_MONO] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let FIRSTN_APPEND2 = prove_thm(`FIRSTN_APPEND2`, "!(l1:* list) n. (LENGTH l1) <= n ==> !l2. FIRSTN n (APPEND l1 l2) = APPEND l1 (FIRSTN (n - (LENGTH l1)) l2)", LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;APPEND;SUB_0] THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0; LESS_EQ_MONO;SUB_MONO_EQ;FIRSTN;CONS_11] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let FIRSTN_LENGTH_APPEND = prove_thm(`FIRSTN_LENGTH_APPEND`, "!(l1:* list) l2. FIRSTN (LENGTH l1) (APPEND l1 l2) = l1", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;FIRSTN;APPEND]);; %<---------------------------------------------------------------------->% let REVERSE_FLAT = prove_thm(`REVERSE_FLAT`, "!l:* list list. REVERSE (FLAT l) = FLAT(REVERSE(MAP REVERSE l))", LIST_INDUCT_TAC THEN REWRITE_TAC[REVERSE;FLAT;MAP] THEN ASM_REWRITE_TAC[REVERSE_APPEND;FLAT_SNOC]);; let MAP_COND = prove( "!(f:*-> **) c l1 l2. (MAP f (c => l1 | l2)) = (c => (MAP f l1) | (MAP f l2))", REPEAT GEN_TAC THEN BOOL_CASES_TAC "c:bool" THEN ASM_REWRITE_TAC[]);; let MAP_FILTER = prove_thm(`MAP_FILTER`, "!(f:* -> *) P l. (!x. P (f x) = P x) ==> (MAP f (FILTER P l) = FILTER P (MAP f l))", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP;FILTER] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MAP_COND;MAP] THEN RES_THEN SUBST1_TAC THEN REFL_TAC);; let FLAT_APPEND = prove_thm(`FLAT_APPEND`, "!l1 l2:* list list. FLAT (APPEND l1 l2) = APPEND (FLAT l1) (FLAT l2)", LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND;FLAT] THEN ASM_REWRITE_TAC[APPEND_ASSOC]);; let FLAT_REVERSE = prove_thm(`FLAT_REVERSE`, "!l:* list list. FLAT (REVERSE l) = REVERSE (FLAT (MAP REVERSE l))", LIST_INDUCT_TAC THEN REWRITE_TAC[FLAT;REVERSE;MAP] THEN ASM_REWRITE_TAC[FLAT_SNOC;REVERSE_APPEND;REVERSE_REVERSE]);; let FLAT_FLAT = prove_thm(`FLAT_FLAT`, "!l:* list list list. FLAT (FLAT l) = FLAT(MAP FLAT l)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FLAT;FLAT_APPEND;MAP]);; let ALL_EL_REVERSE = prove_thm(`ALL_EL_REVERSE`, "!P (l:* list). ALL_EL P (REVERSE l) = ALL_EL P l", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL_EL;REVERSE;ALL_EL_SNOC] THEN GEN_TAC THEN MATCH_ACCEPT_TAC CONJ_SYM);; let SOME_EL_REVERSE = prove_thm(`SOME_EL_REVERSE`, "!P (l:* list). SOME_EL P (REVERSE l) = SOME_EL P l", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SOME_EL;REVERSE;SOME_EL_SNOC] THEN GEN_TAC THEN MATCH_ACCEPT_TAC DISJ_SYM);; let ALL_EL_SEG = prove_thm(`ALL_EL_SEG`, "!P (l:* list). ALL_EL P l ==> !m k. (m + k) <= (LENGTH l) ==> ALL_EL P (SEG m k l)", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL_EL;SEG;LENGTH] THENL[ REPEAT INDUCT_TAC THEN REWRITE_TAC[ADD;ADD_0;NOT_SUC_LESS_EQ_0;SEG;ALL_EL]; GEN_TAC THEN STRIP_TAC THEN REPEAT INDUCT_TAC THEN REWRITE_TAC[ADD;ADD_0;NOT_SUC_LESS_EQ_0;LESS_EQ_MONO;SEG;ALL_EL] THENL[ RES_THEN (ASSUME_TAC o (REWRITE_RULE[ADD_0]) o (SPECL ["m:num";"0"])) THEN DISCH_TAC THEN RES_TAC THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; let lem = SPEC"k:num" (GEN "n:num" (SYM(TRANS (SPEC_ALL(CONJUNCT2 ADD)) (SPEC_ALL ADD_SUC)))) in SUBST1_TAC lem THEN DISCH_TAC THEN RES_TAC]]);; let ALL_EL_FIRSTN = prove_thm(`ALL_EL_FIRSTN`, "!P (l:* list). ALL_EL P l ==> !m. m <= (LENGTH l) ==> ALL_EL P (FIRSTN m l)", REPEAT STRIP_TAC THEN IMP_RES_THEN SUBST1_TAC FIRSTN_SEG THEN IMP_RES_THEN MATCH_MP_TAC ALL_EL_SEG THEN ASM_REWRITE_TAC[ADD_0]);; let ALL_EL_BUTFIRSTN = prove_thm(`ALL_EL_BUTFIRSTN`, "!P (l:* list). ALL_EL P l ==> !m. m <= (LENGTH l) ==> ALL_EL P (BUTFIRSTN m l)", REPEAT STRIP_TAC THEN IMP_RES_THEN SUBST1_TAC BUTFIRSTN_SEG THEN IMP_RES_THEN MATCH_MP_TAC ALL_EL_SEG THEN IMP_RES_THEN SUBST1_TAC SUB_ADD THEN MATCH_ACCEPT_TAC LESS_EQ_REFL);; let SOME_EL_SEG = prove_thm(`SOME_EL_SEG`, "!m k (l:* list). (m + k) <= (LENGTH l) ==> !P. SOME_EL P (SEG m k l) ==> SOME_EL P l", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SOME_EL;SEG;LENGTH;ADD;ADD_0;NOT_SUC_LESS_EQ_0] THEN GEN_TAC THEN REWRITE_TAC[LESS_EQ_MONO] THENL[ FIRST_ASSUM (ASSUME_TAC o (REWRITE_RULE[ADD_0]) o (SPEC"0")) THEN REPEAT STRIP_TAC THENL[ DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISJ2_TAC THEN RES_TAC]; let lem = SPEC"k:num" (GEN "n:num" (SYM(TRANS (SPEC_ALL(CONJUNCT2 ADD)) (SPEC_ALL ADD_SUC)))) in SUBST1_TAC lem THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN RES_TAC]);; let SOME_EL_FIRSTN = prove_thm(`SOME_EL_FIRSTN`, "!m (l:* list). m <= (LENGTH l) ==> !P. SOME_EL P (FIRSTN m l) ==> SOME_EL P l", REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_THEN SUBST1_TAC FIRSTN_SEG THEN MATCH_MP_TAC SOME_EL_SEG THEN ASM_REWRITE_TAC[ADD_0]);; let SOME_EL_BUTFIRSTN = prove_thm(`SOME_EL_BUTFIRSTN`, "!m (l:* list). m <= (LENGTH l) ==> !P. SOME_EL P (BUTFIRSTN m l) ==> SOME_EL P l", REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_THEN SUBST1_TAC BUTFIRSTN_SEG THEN MATCH_MP_TAC SOME_EL_SEG THEN IMP_RES_THEN SUBST1_TAC SUB_ADD THEN MATCH_ACCEPT_TAC LESS_EQ_REFL);; let SOME_EL_LASTN = prove_thm(`SOME_EL_LASTN`, "!m (l:* list). m <= (LENGTH l) ==> !P. SOME_EL P (LASTN m l) ==> SOME_EL P l", REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_THEN SUBST1_TAC LASTN_SEG THEN MATCH_MP_TAC SOME_EL_SEG THEN PURE_ONCE_REWRITE_TAC[ADD_SYM] THEN IMP_RES_THEN SUBST1_TAC SUB_ADD THEN MATCH_ACCEPT_TAC LESS_EQ_REFL);; let SOME_EL_BUTLASTN = prove_thm(`SOME_EL_BUTLASTN`, "!m (l:* list). m <= (LENGTH l) ==> !P. SOME_EL P (BUTLASTN m l) ==> SOME_EL P l", REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_THEN SUBST1_TAC BUTLASTN_SEG THEN MATCH_MP_TAC SOME_EL_SEG THEN PURE_ONCE_REWRITE_TAC[ADD_0] THEN MATCH_ACCEPT_TAC SUB_LESS_EQ);; let IS_EL_REVERSE = prove_thm(`IS_EL_REVERSE`, "!(x:*) l. IS_EL x (REVERSE l) = IS_EL x l", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;IS_EL;IS_EL_SNOC]);; let IS_EL_FILTER = prove_thm(`IS_EL_FILTER`, "!P (x:*). P x ==> !l. IS_EL x (FILTER P l) = IS_EL x l", REPEAT GEN_TAC THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[FILTER;IS_EL] THEN GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IS_EL] THEN EQ_TAC THENL[ DISCH_TAC THEN DISJ2_TAC THEN FIRST_ASSUM ACCEPT_TAC; STRIP_TAC THEN POP_ASSUM SUBST_ALL_TAC THEN RES_TAC]);; let IS_EL_SEG = prove_thm(`IS_EL_SEG`, "!n m (l:* list). ((n + m) <= (LENGTH l)) ==> !x. IS_EL x (SEG n m l) ==> IS_EL x l", REPEAT INDUCT_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ADD;ADD_0;NOT_SUC_LESS_EQ_0;LENGTH;IS_EL; SEG;LESS_EQ_MONO] THEN GEN_TAC THENL[ DISCH_TAC THEN FIRST_ASSUM (IMP_RES_TAC o (REWRITE_RULE[ADD_0]) o (SPEC"0")) THEN GEN_TAC THEN DISCH_THEN (DISJ_CASES_THEN2 (\t. DISJ1_TAC THEN ACCEPT_TAC t) (\t. DISJ2_TAC THEN ASSUME_TAC t THEN RES_TAC)); let lem = (GEN_ALL (SYM(TRANS (SPEC_ALL(CONJUNCT2 ADD)) (SPEC_ALL ADD_SUC)))) in PURE_ONCE_REWRITE_TAC[lem] THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN RES_TAC]);; let IS_EL_SOME_EL = prove_thm(`IS_EL_SOME_EL`, "!(x:*) l. IS_EL x l = SOME_EL ($= x) l", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[IS_EL;SOME_EL]);; let IS_EL_FIRSTN = prove_thm(`IS_EL_FIRSTN`, "!m l. m <= (LENGTH l) ==> !x:*. IS_EL x (FIRSTN m l) ==> IS_EL x l", PURE_ONCE_REWRITE_TAC[IS_EL_SOME_EL] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC SOME_EL_FIRSTN);; let IS_EL_BUTFIRSTN = prove_thm(`IS_EL_BUTFIRSTN`, "!m l. m <= (LENGTH l) ==> !x:*. IS_EL x (BUTFIRSTN m l) ==> IS_EL x l", PURE_ONCE_REWRITE_TAC[IS_EL_SOME_EL] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC SOME_EL_BUTFIRSTN);; let IS_EL_BUTLASTN = prove_thm(`IS_EL_BUTLASTN`, "!m l. m <= (LENGTH l) ==> !x:*. IS_EL x (BUTLASTN m l) ==> IS_EL x l", PURE_ONCE_REWRITE_TAC[IS_EL_SOME_EL] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC SOME_EL_BUTLASTN);; let IS_EL_LASTN = prove_thm(`IS_EL_LASTN`, "!m l. m <= (LENGTH l) ==> !x:*. IS_EL x (LASTN m l) ==> IS_EL x l", PURE_ONCE_REWRITE_TAC[IS_EL_SOME_EL] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC SOME_EL_LASTN);; let ZIP_SNOC = prove_thm(`ZIP_SNOC`, "!l1 l2. (LENGTH l1 = LENGTH l2) ==> !(x1:*) (x2:**). ZIP((SNOC x1 l1), (SNOC x2 l2)) = SNOC (x1,x2) (ZIP(l1,l2))", LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "l2:** list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SNOC;ZIP;LENGTH;NOT_SUC;SUC_NOT] THEN REWRITE_TAC[INV_SUC_EQ;CONS_11] THEN REPEAT STRIP_TAC THEN RES_THEN MATCH_ACCEPT_TAC);; let UNZIP_SNOC = prove_thm(`UNZIP_SNOC`, "!(x:* # **) l. UNZIP(SNOC x l) = SNOC(FST x)(FST(UNZIP l)), SNOC(SND x)(SND(UNZIP l))", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;UNZIP]);; let LENGTH_ZIP = prove_thm(`LENGTH_ZIP`, "!l1:* list. !l2:** list. (LENGTH l1 = LENGTH l2) ==> (LENGTH(ZIP(l1,l2)) = LENGTH l1) /\ (LENGTH(ZIP(l1,l2)) = LENGTH l2)", LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "l2:** list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ZIP;LENGTH;NOT_SUC;SUC_NOT;INV_SUC_EQ] THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LENGTH_UNZIP_FST = prove_thm(`LENGTH_UNZIP_FST`, "!l:(* # **)list. LENGTH (UNZIP_FST l) = LENGTH l", PURE_ONCE_REWRITE_TAC[UNZIP_FST_DEF] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[UNZIP;LENGTH]);; let LENGTH_UNZIP_SND = prove_thm(`LENGTH_UNZIP_SND`, "!l:(* # **)list. LENGTH (UNZIP_SND l) = LENGTH l", PURE_ONCE_REWRITE_TAC[UNZIP_SND_DEF] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[UNZIP;LENGTH]);; let ZIP_UNZIP = prove_thm(`ZIP_UNZIP`, "!l:(* # **)list. ZIP(UNZIP l) = l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[UNZIP;ZIP]);; let UNZIP_ZIP = prove_thm(`UNZIP_ZIP`, "!l1:* list. !l2:** list. (LENGTH l1 = LENGTH l2) ==> (UNZIP(ZIP(l1,l2)) = (l1,l2))", LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "l2:** list") THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[UNZIP;ZIP;LENGTH;NOT_SUC;SUC_NOT;INV_SUC_EQ] THEN REPEAT STRIP_TAC THEN RES_THEN SUBST1_TAC THEN REWRITE_TAC[]);; let SUM_APPEND = prove_thm(`SUM_APPEND`, "!l1 l2. SUM (APPEND l1 l2) = SUM l1 + SUM l2", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SUM;APPEND;ADD;ADD_0;ADD_ASSOC]);; let SUM_REVERSE = prove_thm(`SUM_REVERSE`, "!l. SUM (REVERSE l) = SUM l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SUM;REVERSE;SUM_SNOC] THEN MATCH_ACCEPT_TAC ADD_SYM);; let SUM_FLAT = prove_thm(`SUM_FLAT`, "!l. SUM (FLAT l) = SUM (MAP SUM l)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SUM;FLAT;MAP;SUM_APPEND]);; let EL_APPEND1 = prove_thm(`EL_APPEND1`, "!n l1 (l2:* list). n < (LENGTH l1) ==> (EL n (APPEND l1 l2) = EL n l1)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EL;APPEND;HD;TL;LENGTH;NOT_LESS_0;LESS_MONO_EQ]);; let EL_APPEND2 = prove_thm(`EL_APPEND2`, "!(l1:* list) n. (LENGTH l1) <= n ==> !l2. EL n (APPEND l1 l2) = EL (n - (LENGTH l1)) l2", LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH;APPEND;SUB_0] THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EL;APPEND;HD;TL; LENGTH;NOT_SUC_LESS_EQ_0;SUB_MONO_EQ;LESS_EQ_MONO]);; let EL_MAP = prove_thm(`EL_MAP`, "!n l. n < (LENGTH l) ==> !f:*->**. EL n (MAP f l) = f (EL n l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;EL;MAP;LESS_MONO_EQ;NOT_LESS_0;HD;TL]);; let EL_CONS = prove_thm(`EL_CONS`, "!n. 0 < n ==> !(x:*) l. EL n (CONS x l) = EL (PRE n) l", INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_LESS_0;EL;HD;TL;PRE]);; let EL_SEG = prove_thm(`EL_SEG`, "!n (l:* list). n < (LENGTH l) ==> (EL n l = HD (SEG 1 n l))", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;EL;HD;TL;NOT_LESS_0;LESS_MONO_EQ] THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC[SEG;HD] THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REFL_TAC);; let EL_IS_EL = prove_thm(`EL_IS_EL`, "!n (l:* list). n < (LENGTH l) ==> (IS_EL (EL n l) l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;EL;HD;TL;NOT_LESS_0;LESS_MONO_EQ;IS_EL] THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN RES_TAC);; let TL_SNOC = prove_thm(`TL_SNOC`, "!(x:*) l. TL(SNOC x l) = ((NULL l) => [] | SNOC x (TL l))", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;TL;NULL]);; let SUB_SUC_LESS = PROVE( "!m n. (n < m) ==> (m - (SUC n)) < m", INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0;SUB_MONO_EQ] THEN INDUCT_TAC THENL[ REWRITE_TAC[SUB_0;LESS_SUC_REFL]; REWRITE_TAC[LESS_MONO_EQ] THEN DISCH_TAC THEN RES_TAC THEN IMP_RES_TAC LESS_SUC]);; let EL_REVERSE = prove_thm(`EL_REVERSE`, "!n (l:* list). n < (LENGTH l) ==> (EL n (REVERSE l) = EL (PRE(LENGTH l - n)) l)", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;LENGTH_SNOC; EL;HD;TL;NOT_LESS_0;LESS_MONO_EQ;SUB_0] THENL[ REWRITE_TAC[REVERSE_SNOC;PRE;EL_LENGTH_SNOC;HD]; REWRITE_TAC[REVERSE_SNOC;SUB_MONO_EQ;TL] THEN REPEAT STRIP_TAC THEN RES_THEN SUBST1_TAC THEN MATCH_MP_TAC (GSYM EL_SNOC) THEN REWRITE_TAC(PRE_SUB1 . (map GSYM [SUB_PLUS;ADD1])) THEN IMP_RES_TAC SUB_SUC_LESS]);; let EL_REVERSE_ELL = prove_thm(`EL_REVERSE_ELL`, "!n (l:* list). n < (LENGTH l) ==> (EL n (REVERSE l) = ELL n l)", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;LENGTH_SNOC;REVERSE_SNOC; EL;ELL;HD;TL;LAST;BUTLAST;NOT_LESS_0;LESS_MONO_EQ;SUB_0]);; let ELL_LENGTH_APPEND = prove_thm(`ELL_LENGTH_APPEND`, "!(l1:(*)list) (l2:(*)list). ~(NULL l1)==> (ELL (LENGTH l2) (APPEND l1 l2) = LAST l1)", GEN_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH;LENGTH_SNOC;APPEND_SNOC;APPEND_NIL;ELL;TL;BUTLAST]);; let ELL_IS_EL = prove_thm(`ELL_IS_EL`, "!n (l:* list). n < (LENGTH l) ==> (IS_EL (EL n l) l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;EL;HD;TL;NOT_LESS_0;LESS_MONO_EQ;IS_EL] THEN REPEAT STRIP_TAC THEN DISJ2_TAC THEN RES_TAC);; let ELL_REVERSE = prove_thm(`ELL_REVERSE`, "!n (l:* list). n < (LENGTH l) ==> (ELL n (REVERSE l) = ELL (PRE(LENGTH l - n)) l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;LENGTH_SNOC;REVERSE;SUB_0;ELL;LAST; BUTLAST;NOT_LESS_0;LESS_MONO_EQ;PRE;ELL_LENGTH_CONS;SUB_MONO_EQ] THEN REPEAT STRIP_TAC THEN RES_THEN SUBST1_TAC THEN MATCH_MP_TAC (GSYM ELL_CONS) THEN REWRITE_TAC(PRE_SUB1 . (map GSYM [SUB_PLUS;ADD1])) THEN IMP_RES_TAC SUB_SUC_LESS);; let ELL_REVERSE_EL = prove_thm(`ELL_REVERSE_EL`, "!n (l:* list). n < (LENGTH l) ==> (ELL n (REVERSE l) = EL n l)", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH;LENGTH_SNOC;REVERSE;REVERSE_SNOC; EL;ELL;HD;TL;LAST;BUTLAST;NOT_LESS_0;LESS_MONO_EQ;SUB_0]);; %-------------------------- 30 JAN -------------------------------% let LESS_EQ_SPLIT = let asm_thm = ASSUME "(m + n) <= p" in GEN_ALL(DISCH_ALL (CONJ(MP(SPECL ["n:num";"m+n";"p:num"] LESS_EQ_TRANS) (CONJ (SUBS [SPECL ["n:num";"m:num"] ADD_SYM] (SPECL ["n:num";"m:num"] LESS_EQ_ADD)) asm_thm)) (MP (SPECL ["m:num";"m+n";"p:num"] LESS_EQ_TRANS) (CONJ (SPEC_ALL LESS_EQ_ADD) asm_thm))));; let SUB_GREATER_EQ_ADD = PROVE( "!p n m. (p >= n) ==> (((p - n) >= m) = (p >= (m + n)))", REWRITE_TAC[ SYM (SPEC "n:num" (SPEC "p-n" (SPEC "m:num" (REWRITE_RULE[GSYM GREATER_EQ] LESS_EQ_MONO_ADD_EQ))))] THEN REPEAT STRIP_TAC THEN POP_ASSUM (\th .ASSUME_TAC (MP (SPEC "n:num" (SPEC "p:num" SUB_ADD)) (REWRITE_RULE[SPEC "n:num" (SPEC "p:num" GREATER_EQ)] th))) THEN SUBST_TAC[(SPEC_ALL ADD_SYM)] THEN ASM_REWRITE_TAC[]);; % SUB_LESS_EQ_ADD = |- !p n m. n <= p ==> (m <= (p - n) = (m + n) <= p) % let SUB_LESS_EQ_ADD = (REWRITE_RULE[GREATER_EQ] SUB_GREATER_EQ_ADD);; let FIRSTN_BUTLASTN = prove_thm(`FIRSTN_BUTLASTN`, "!n (l:* list). n <= (LENGTH l) ==> (FIRSTN n l = BUTLASTN ((LENGTH l) - n) l)", INDUCT_TAC THEN REWRITE_TAC[FIRSTN;BUTLASTN_LENGTH_NIL;SUB_0] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;FIRSTN;LENGTH; SUB_0;BUTLASTN;LESS_EQ_MONO;SUB_MONO_EQ] THEN GEN_TAC THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC BUTLASTN_CONS THEN MATCH_ACCEPT_TAC SUB_LESS_EQ);; let BUTLASTN_FIRSTN = prove_thm(`BUTLASTN_FIRSTN`, "!n (l:* list). n <= (LENGTH l) ==> (BUTLASTN n l = FIRSTN ((LENGTH l) - n) l)", INDUCT_TAC THEN REWRITE_TAC[FIRSTN;BUTLASTN_LENGTH_NIL;SUB_0] THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;LENGTH;LENGTH_SNOC; SUB_0;BUTLASTN;FIRSTN;FIRSTN_LENGTH_ID;LESS_EQ_MONO;SUB_MONO_EQ] THEN GEN_TAC THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC FIRSTN_SNOC THEN MATCH_ACCEPT_TAC SUB_LESS_EQ);; let LASTN_BUTFIRSTN = prove_thm(`LASTN_BUTFIRSTN`, "!n (l:* list). n <= (LENGTH l) ==> (LASTN n l = BUTFIRSTN ((LENGTH l) - n) l)", INDUCT_TAC THEN REWRITE_TAC[LASTN;BUTFIRSTN_LENGTH_NIL;SUB_0] THEN SNOC_INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;LASTN;LENGTH; LENGTH_SNOC;SUB_0;LESS_EQ_MONO;SUB_MONO_EQ] THEN GEN_TAC THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC BUTFIRSTN_SNOC THEN MATCH_ACCEPT_TAC SUB_LESS_EQ);; let BUTFIRSTN_LASTN = prove_thm(`BUTFIRSTN_LASTN`, "!n (l:* list). n <= (LENGTH l) ==> (BUTFIRSTN n l = LASTN ((LENGTH l) - n) l)", INDUCT_TAC THEN REWRITE_TAC[LASTN_LENGTH_ID;BUTFIRSTN;SUB_0] THEN LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_SUC_LESS_EQ_0;LASTN;LENGTH; BUTFIRSTN;SUB_0;LESS_EQ_MONO;SUB_MONO_EQ] THEN GEN_TAC THEN DISCH_TAC THEN RES_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC LASTN_CONS THEN MATCH_ACCEPT_TAC SUB_LESS_EQ);; let SUB_ADD_lem = PROVE( "!l n m. (n + m) <= l ==> ((l - (n + m)) + n = l - m)", REPEAT INDUCT_TAC THEN REWRITE_TAC[ADD;ADD_0;SUB_0;NOT_SUC_LESS_EQ_0] THENL[ MATCH_ACCEPT_TAC SUB_ADD; PURE_ONCE_REWRITE_TAC [GSYM(CONJUNCT2 ADD)] THEN SUBST1_TAC (SYM (SPECL["SUC n";"m:num"]ADD_SUC)) THEN REWRITE_TAC[SUB_MONO_EQ;LESS_EQ_MONO] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let SEG_LASTN_BUTLASTN = prove_thm(`SEG_LASTN_BUTLASTN`, "!n m (l:* list). ((n + m) <= (LENGTH l)) ==> (SEG n m l = LASTN n (BUTLASTN ((LENGTH l) - (n + m)) l))", let th2 = SUBS [(REWRITE_RULE[SUB_LESS_EQ] (SPECL["(LENGTH (l:* list)) - m"; "l:* list"]LENGTH_LASTN))] (SPECL["n:num";"LASTN((LENGTH l) - m)(l:* list)"]FIRSTN_BUTLASTN) in let th3 = UNDISCH_ALL (SUBS[UNDISCH_ALL (SPECL["LENGTH(l:* list)";"m:num";"n:num"]SUB_LESS_EQ_ADD)] th2) in let th4 = PURE_ONCE_REWRITE_RULE[ADD_SYM](REWRITE_RULE[ UNDISCH_ALL(SPECL["LENGTH(l:* list)";"n:num";"m:num"]SUB_ADD_lem); SUB_LESS_EQ] (PURE_ONCE_REWRITE_RULE[ADD_SYM](SPECL ["n:num";"(LENGTH (l:* list)) - (n + m)";"l:* list"]LASTN_BUTLASTN)))in REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_THEN SUBST1_TAC SEG_FIRSTN_BUTFIRSTN THEN IMP_RES_TAC LESS_EQ_SPLIT THEN SUBST1_TAC (UNDISCH_ALL(SPECL["m:num";"l:* list"] BUTFIRSTN_LASTN)) THEN SUBST1_TAC th3 THEN REWRITE_TAC[GSYM SUB_PLUS] THEN SUBST_OCCS_TAC[[1],(SPEC_ALL ADD_SYM)] THEN CONV_TAC SYM_CONV THEN ACCEPT_TAC th4);; let BUTFIRSTN_REVERSE = prove_thm(`BUTFIRSTN_REVERSE`, "!n (l:* list). n <= (LENGTH l) ==> (BUTFIRSTN n (REVERSE l) = REVERSE(BUTLASTN n l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC_LESS_EQ_0; LENGTH;LENGTH_SNOC;BUTFIRSTN;BUTLASTN;LESS_EQ_MONO;REVERSE_SNOC]);; let BUTLASTN_REVERSE = prove_thm(`BUTLASTN_REVERSE`, "!n (l:* list). n <= (LENGTH l) ==> (BUTLASTN n (REVERSE l) = REVERSE(BUTFIRSTN n l))", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC_LESS_EQ_0; LENGTH;BUTFIRSTN;BUTLASTN;LESS_EQ_MONO;REVERSE]);; let LASTN_REVERSE = prove_thm(`LASTN_REVERSE`, "!n (l:* list). n <= (LENGTH l) ==> (LASTN n (REVERSE l) = REVERSE(FIRSTN n l))", INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC_LESS_EQ_0; LENGTH;FIRSTN;LASTN;LESS_EQ_MONO;REVERSE;SNOC_11]);; let FIRSTN_REVERSE = prove_thm(`FIRSTN_REVERSE`, "!n (l:* list). n <= (LENGTH l) ==> (FIRSTN n (REVERSE l) = REVERSE(LASTN n l))", INDUCT_TAC THEN SNOC_INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC_LESS_EQ_0;LENGTH;LENGTH_SNOC; FIRSTN;LASTN;LESS_EQ_MONO;REVERSE;REVERSE_SNOC;CONS_11]);; let SEG_REVERSE = prove_thm(`SEG_REVERSE`, "!n m (l:* list). ((n + m) <= (LENGTH l)) ==> (SEG n m (REVERSE l) = REVERSE(SEG n (LENGTH l - (n + m)) l))", let LEN_REV = (SPEC"l:* list" LENGTH_REVERSE) in let SUB_LE_ADD = SPECL["LENGTH(l:* list)";"m:num";"n:num"]SUB_LESS_EQ_ADD in let SEG_lem = REWRITE_RULE[SUB_LESS_EQ](PURE_ONCE_REWRITE_RULE[ADD_SYM] (SUBS[UNDISCH_ALL(SPEC_ALL(SPEC"LENGTH(l:* list)" SUB_ADD_lem))] (PURE_ONCE_REWRITE_RULE[ADD_SYM] (SPECL["n:num";"LENGTH(l:* list) -(n+m)";"l:* list"] SEG_LASTN_BUTLASTN)))) in let lem = PURE_ONCE_REWRITE_RULE[ADD_SUB](PURE_ONCE_REWRITE_RULE[ADD_SYM] (SPEC "LENGTH(l:* list)" (UNDISCH_ALL(SPECL["LENGTH(l:* list)";"m:num"]SUB_SUB)))) in REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM (SUBST1_TAC o (MATCH_MP SEG_FIRSTN_BUTFIRSTN) o (SUBS[SYM LEN_REV])) THEN IMP_RES_TAC LESS_EQ_SPLIT THEN IMP_RES_THEN SUBST1_TAC (SPECL["m:num";"l:* list"]BUTFIRSTN_REVERSE) THEN FIRST_ASSUM (ASSUME_TAC o (MP(SPECL["m:num";"(l:* list)"]LENGTH_BUTLASTN))) THEN FIRST_ASSUM (\t. ASSUME_TAC (SUBS[t] (SPECL["n:num";"BUTLASTN m (l:* list)"]FIRSTN_REVERSE))) THEN FIRST_ASSUM (SUBST_ALL_TAC o (MP SUB_LE_ADD)) THEN RES_THEN SUBST1_TAC THEN AP_TERM_TAC THEN SUBST1_TAC SEG_lem THEN SUBST1_TAC lem THEN REFL_TAC);; %<---------------------------------------------------------------->% let LENGTH_GENLIST = prove_thm(`LENGTH_GENLIST`, "!(f:num->*) n. LENGTH(GENLIST f n) = n", GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[GENLIST;LENGTH;LENGTH_SNOC]);; let LENGTH_REPLICATE = prove_thm(`LENGTH_REPLICATE`, "!n (x:*). LENGTH(REPLICATE n x) = n", INDUCT_TAC THEN ASM_REWRITE_TAC[REPLICATE;LENGTH]);; let IS_EL_REPLICATE = prove_thm(`IS_EL_REPLICATE`, "!n. 0 < n ==> !x:*. IS_EL x (REPLICATE n x)", INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_LESS_0;IS_EL;REPLICATE]);; let ALL_EL_REPLICATE = prove_thm(`ALL_EL_REPLICATE`, "!(x:*) n. ALL_EL ($= x) (REPLICATE n x)", GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_LESS_0;ALL_EL;REPLICATE]);; let AND_EL_FOLDL = save_thm(`AND_EL_FOLDL`, GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV) (REWRITE_RULE[ALL_EL_FOLDL;I_THM](AP_THM AND_EL_DEF "l:bool list"))));; let AND_EL_FOLDR = save_thm(`AND_EL_FOLDR`, GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV) (REWRITE_RULE[ALL_EL_FOLDR;I_THM](AP_THM AND_EL_DEF "l:bool list"))));; let OR_EL_FOLDL = save_thm(`OR_EL_FOLDL`, GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV) (REWRITE_RULE[SOME_EL_FOLDL;I_THM](AP_THM OR_EL_DEF "l:bool list"))));; let OR_EL_FOLDR = save_thm(`OR_EL_FOLDR`, GEN_ALL (CONV_RULE (DEPTH_CONV ETA_CONV) (REWRITE_RULE[SOME_EL_FOLDR;I_THM](AP_THM OR_EL_DEF "l:bool list"))));; let MAP2_ZIP = prove_thm(`MAP2_ZIP`, "!l1 l2. (LENGTH l1 = LENGTH l2) ==> !f:*->**->***. MAP2 f l1 l2 = MAP (UNCURRY f) (ZIP (l1,l2))", let UNCURRY_DEF = definition `bool` `UNCURRY_DEF` in LIST_INDUCT_TAC THEN REPEAT (FILTER_GEN_TAC "l2:** list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP;MAP2;ZIP;LENGTH;NOT_SUC;SUC_NOT] THEN ASM_REWRITE_TAC[CONS_11;UNCURRY_DEF;INV_SUC_EQ]);; %---------------------------------------------------------------------- % % End of mk_list_thm2.ml % %---------------------------------------------------------------------- % hol88-2.02.19940316/theories/mk_ltree.ml0000640000212700021270000006161605511561431015715 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: ltree.ml % % % % DESCRIPTION: Creates the theory "ltree.th" containing the % % definition of a type (*)ltree of labelled trees. % % % % AUTHOR: T. F. Melham (87.07.27) % % % % PARENTS: tree.th, combin.th % % WRITES FILES: ltree.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1988 % % % % REVISION HISTORY: (none) % %=============================================================================% % Create the new theory "ltree.th". % new_theory `ltree`;; % tree.th is a parent. % new_parent `tree`;; % theory of combinators is also a parent. % new_parent `combin`;; % Fetch theorems from tree.th % let node_11 = theorem `tree` `node_11` and tree_Induct = theorem `tree` `tree_Induct` and tree_Axiom = theorem `tree` `tree_Axiom`;; % theorem changed to definition for HOL88 % let SUM = definition `list` `SUM` and LENGTH = definition `list` `LENGTH` and MAP = definition `list` `MAP` and FLAT = definition `list` `FLAT` and APPEND = definition `list` `APPEND` and HD = definition `list` `HD` and TL = definition `list` `TL` and ALL_EL = definition `list` `ALL_EL`;; % Fetch theorems from list.th % let list_Axiom = theorem `list` `list_Axiom` and list_INDUCT = theorem `list` `list_INDUCT` and LENGTH_APPEND = theorem `list` `LENGTH_APPEND` and LENGTH_NIL = theorem `list` `LENGTH_NIL` and LENGTH_CONS = theorem `list` `LENGTH_CONS` ;; % Fetch theorems from combin.th % let o_THM = theorem `combin` `o_THM`;; % Fetch theorems from arithmetic.th % let ADD_CLAUSES = theorem `arithmetic` `ADD_CLAUSES` and ADD_EQ_0 = theorem `arithmetic` `ADD_EQ_0`;; % fetch theorems from prim_rec.th % let num_Axiom = theorem `prim_rec` `num_Axiom` and INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ`;; % fetch theorems from num.th % let INDUCTION = theorem `num` `INDUCTION`;; % --------------------------------------------------------------------- % % Load/define code needed. % % --------------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml % % but it is part of hol rather than basic hol, so it's loaded % % in uncompiled. % % % % TFM 88.04.02 % loadt (concat ml_dir_pathname `ind.ml`);; % Note that prim_rec_ml.o must be recompiled if basic-hol has been. % % So, load prim_rec.ml uncompiled. % % % % TFM 88.04.02 % loadt (concat ml_dir_pathname `prim_rec.ml`);; % --------------------------------------------------------------------- % % tree_INDUCT: thm -> thm % % % % A |- !tl. ALL_EL \t.P[t] tl ==> P[node tl] % % ---------------------------------------------------------- % % A |- !t. P[t] % % % % --------------------------------------------------------------------- % let tree_INDUCT th = (let (tl,body) = dest_forall(concl th) in let (asm,con) = (dest_imp body) in let ALL_EL,[P;tll] = strip_comb asm in let b = genvar bool_ty in let concth = SYM(RIGHT_BETA(REFL "^P(node ^tl)")) and IND = SPEC P tree_Induct and th' = (SPEC tl th) in let th1 = SUBST [concth,b] "^(concl th') = (ALL_EL ^P ^tl ==> ^b)" (REFL (concl th')) in let th2 = GEN tl (EQ_MP th1 th') in CONV_RULE (ONCE_DEPTH_CONV BETA_CONV) (MP IND th2)?failwith `tree_INDUCT`);; % --------------------------------------------------------------------- % % % % tree_INDUCT_TAC % % % % [A] !t.P[t] % % ================================ % % [A,ALL_EL \t.P[t] trl] |- P[node trl] % % % % --------------------------------------------------------------------- % let tree_INDUCT_TAC (A,term) = (let t,body = dest_forall term in let t' = variant ((frees term) @ (freesl A)) t in let body' = subst [t',t] body in let trl = variant ((frees body') @ (freesl A)) "trl:(tree)list" in let asm = "ALL_EL (\^t'.^body') trl" in ([ (asm.A, subst["node ^trl",t']body')], \[thm]. tree_INDUCT (GEN trl (DISCH asm thm))) ) ? failwith `tree_INDUCT_TAC`;; % Create a tactic for list induction. % let LIST_INDUCT_TAC = INDUCT_THEN list_INDUCT ASSUME_TAC;; % Create an induction tactic for :num % let INDUCT_TAC = INDUCT_THEN (theorem `num` `INDUCTION`) ASSUME_TAC;; % Define a function Size on trees that gives the number of nodes in % % a tree. % let Size = new_definition (`Size`, "Size = @fn. (!tl. fn (node tl:tree) = SUC(SUM (MAP fn tl)))");; % Show that Size has the desired prim rec defn. % let Size_thm = TAC_PROOF(([], "!tl. Size (node tl:tree) = SUC(SUM (MAP Size tl))"), REWRITE_TAC [Size] THEN CONV_TAC SELECT_CONV THEN MP_TAC (SPEC "\n. \tl:(tree)list. (SUC(SUM n))" (INST_TYPE [":num",":**"] tree_Axiom)) THEN REWRITE_TAC [EXISTS_UNIQUE_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN DISCH_THEN (STRIP_THM_THEN CHECK_ASSUME_TAC));; % --------------------------------------------------------------------- % % Subset predicate for (*)ltree and introduction of the new type. % % --------------------------------------------------------------------- % let Is_ltree = new_definition (`Is_ltree`, "Is_ltree (t,l) = (Size (t:tree) = LENGTH (l:(*)list))");; % (*)ltree is represented by :(tree # (*)list % let ty = ":(tree # (*)list)";; % Show that a ltree representation exists. % let Exists_ltree_REP = TAC_PROOF(([], "?t:^ty. Is_ltree t"), EXISTS_TAC "node NIL:tree,CONS (@v:*.T) NIL " THEN REWRITE_TAC [Is_ltree;LENGTH;Size_thm;MAP;SUM]);; % Define the new type. % let ltree_TY_DEF = new_type_definition (`ltree`, rator(snd(dest_exists(concl Exists_ltree_REP))), Exists_ltree_REP);; % --------------------------------------------------------------------- % % Define a representation function, REP_tree, from the type tree to % % the representing type, and the inverse abstraction % % function ABS_tree, and prove some trivial lemmas about them. % % --------------------------------------------------------------------- % let ltree_ISO_DEF = define_new_type_bijections `ltree_ISO_DEF` `ABS_ltree` `REP_ltree` ltree_TY_DEF;; let R_11 = prove_rep_fn_one_one ltree_ISO_DEF and R_ONTO = prove_rep_fn_onto ltree_ISO_DEF and A_11 = prove_abs_fn_one_one ltree_ISO_DEF and A_ONTO = prove_abs_fn_onto ltree_ISO_DEF and A_R = CONJUNCT1 ltree_ISO_DEF and R_A = CONJUNCT2 ltree_ISO_DEF;; % Definition of Node. % let Node = new_definition (`Node`, "Node (v:*) (tl:((*)ltree)list) = (ABS_ltree ((node (MAP (FST o REP_ltree) tl)), ((CONS v (FLAT (MAP (SND o REP_ltree) tl))))))");; % A lemma about Rep_ltree(Node v tl) % let REP_Node = TAC_PROOF( ([], "!tl.REP_ltree (Node (v:*) tl) = (node(MAP(FST o REP_ltree)tl), CONS v(FLAT(MAP(SND o REP_ltree)tl)))"), REWRITE_TAC [Node;SYM(SPEC_ALL R_A);Is_ltree] THEN LIST_INDUCT_TAC THENL [REWRITE_TAC [Size_thm;MAP;LENGTH;FLAT;SUM]; POP_ASSUM MP_TAC THEN REWRITE_TAC [Size_thm;MAP;LENGTH;FLAT;SUM;LENGTH_APPEND] THEN REWRITE_TAC [SYM (el 4 (CONJUNCTS ADD_CLAUSES))] THEN DISCH_THEN SUBST1_TAC THEN STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "h:(*)ltree" A_ONTO) THEN MP_TAC (SPEC "r:^ty" R_A) THEN ASM_REWRITE_TAC [o_THM] THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY POP_ASSUM [MP_TAC;K ALL_TAC] THEN ONCE_REWRITE_TAC [SYM(SPEC_ALL PAIR)] THEN REWRITE_TAC [Is_ltree] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; % A lemma about Size and LENGTH of the components of REP_ltree t % let Size_LENGTH_lemma = TAC_PROOF( ([], "!t:(*)ltree. Size (FST (REP_ltree t)) = LENGTH (SND (REP_ltree t))"), GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "t:(*)ltree" A_ONTO) THEN MP_TAC (SPEC_ALL R_A) THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST1_TAC THEN MAP_EVERY POP_ASSUM [MP_TAC;K ALL_TAC] THEN ONCE_REWRITE_TAC [SYM(SPEC_ALL PAIR)] THEN REWRITE_TAC [Is_ltree]);; % Extend the above thm to lists of REP_ltree % let MAP_Size_LENGTH = TAC_PROOF( ([], "!tl:((*)ltree)list. MAP Size (MAP (FST o REP_ltree) tl) = MAP LENGTH (MAP (SND o REP_ltree) tl)"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;Size_thm;LENGTH;Size_LENGTH_lemma;o_THM]);; % --------------------------------------------------------------------- % % In what follows, we define a few list processing functions. These % % are rather special purpose. But they are defined constants here, % % for convenience of use. In a later version of HOL, these could be % % defined by use of the assumption list to introduce "local" % % definitions, so as not to clutter up the built-in theories % % with constants that will be only used locally here. % % --------------------------------------------------------------------- % let AP = new_recursive_definition false list_Axiom `AP` "(!l. AP NIL l = NIL) /\ (!h t l. AP (CONS h t) l = CONS (h (HD l:*):**) (AP t (TL l)))";; let SPLIT = new_recursive_definition false num_Axiom `SPLIT` "(SPLIT 0 l = (NIL,l:(*)list)) /\ (SPLIT (SUC n) l = (CONS (HD l) (FST(SPLIT n (TL l))), SND(SPLIT n (TL l))))";; let PART = new_recursive_definition false list_Axiom `PART` "(PART NIL (l:(*)list) = NIL) /\ (PART (CONS n t) l = (CONS (FST (SPLIT n l)) (PART t (SND (SPLIT n l)))))";; % --------------------------------------------------------------------- % % Some theorems about SPLIT, PART, etc. % % --------------------------------------------------------------------- % let SPLIT_APPEND = TAC_PROOF (([], "!l:(*)list. !l'. SPLIT (LENGTH l) (APPEND l l') = (l,l')"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND;SPLIT;LENGTH;HD;TL]);; let PART_FLAT = TAC_PROOF (([], "!l:((*)list)list. PART (MAP LENGTH l) (FLAT l) = l"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [PART;LENGTH;MAP;FLAT;SPLIT_APPEND]);; let LENGTH_SND_SPLIT = TAC_PROOF (([],"!l:(*)list.!n m.(LENGTH l = n+m) ==> (LENGTH(SND(SPLIT n l)) = m)"), LIST_INDUCT_TAC THENL [ONCE_REWRITE_TAC [INST_TYPE [":num",":*"] EQ_SYM_EQ] THEN REWRITE_TAC [LENGTH;ADD_EQ_0] THEN REPEAT (STRIP_GOAL_THEN (STRIP_THM_THEN SUBST1_TAC)) THEN REWRITE_TAC [SPLIT;LENGTH]; REWRITE_TAC [LENGTH] THEN STRIP_TAC THEN INDUCT_TAC THENL [REWRITE_TAC [ADD_CLAUSES;SPLIT;LENGTH]; REWRITE_TAC [ADD_CLAUSES;INV_SUC_EQ] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [SPLIT;TL]]]);; let LENGTH_FST_SPLIT = TAC_PROOF (([],"!l:(*)list.!n m.(LENGTH l = n+m) ==> (LENGTH(FST(SPLIT n l)) = n)"), LIST_INDUCT_TAC THENL [ONCE_REWRITE_TAC [INST_TYPE [":num",":*"] EQ_SYM_EQ] THEN REWRITE_TAC [LENGTH;ADD_EQ_0] THEN REPEAT (STRIP_GOAL_THEN (STRIP_THM_THEN SUBST1_TAC)) THEN REWRITE_TAC [SPLIT;LENGTH]; REWRITE_TAC [LENGTH] THEN STRIP_TAC THEN INDUCT_TAC THENL [REWRITE_TAC [ADD_CLAUSES;SPLIT;LENGTH]; REWRITE_TAC [ADD_CLAUSES;INV_SUC_EQ] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [SPLIT;HD;TL;LENGTH]]]);; let APPEND_SPLIT = TAC_PROOF (([], "!l:(*)list. !n m. (LENGTH l = n + m) ==> (APPEND (FST(SPLIT n l)) (SND (SPLIT n l)) = l)"), LIST_INDUCT_TAC THENL [ONCE_REWRITE_TAC [INST_TYPE [":num",":*"] EQ_SYM_EQ] THEN REWRITE_TAC [LENGTH;ADD_EQ_0] THEN REPEAT (STRIP_GOAL_THEN (STRIP_THM_THEN SUBST1_TAC)) THEN REWRITE_TAC [SPLIT;APPEND]; REWRITE_TAC [LENGTH] THEN STRIP_TAC THEN INDUCT_TAC THENL [REWRITE_TAC [ADD_CLAUSES;SPLIT;APPEND]; REWRITE_TAC [ADD_CLAUSES;INV_SUC_EQ] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [SPLIT;HD;TL;APPEND]]]);; % Recursive functions on the REPRESENTATION type...(MAJOR THM) % let REP_REC_lemma = TAC_PROOF (([], "!f. ?!fn. !tl. !l:(*)list. fn(node tl,l):** = f (AP (MAP (\t e.fn(t,e)) tl)(PART (MAP Size tl)(TL l))) (HD l:*) (MAP ABS_ltree (AP (MAP $, tl) (PART (MAP Size tl) (TL l))))"), STRIP_TAC THEN MP_TAC (SPEC "\rl:((*)list->**)list. \tl:(tree)list. \l:(*)list. f (AP rl (PART (MAP Size tl) (TL l))) (HD l:*) (MAP ABS_ltree (AP (MAP $, tl) (PART (MAP Size tl) (TL l)))):**" (INST_TYPE [":(*)list->**",":**"] tree_Axiom)) THEN REWRITE_TAC [EXISTS_UNIQUE_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN CONJ_TAC THENL [EXISTS_TAC "\p. fn (FST p:tree) (SND p:(*)list):**" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC [ETA_AX] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC; REPEAT GEN_TAC THEN POP_ASSUM (MP_TAC o SPECL ["\t:tree. \e:(*)list.x(t,e):**"; "\(t:tree) (e:(*)list).y(t,e):**"]) THEN CONV_TAC (REDEPTH_CONV (FUN_EQ_CONV ORELSEC BETA_CONV)) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ONCE_REWRITE_TAC [SYM(SPEC_ALL PAIR)] THEN POP_ASSUM MATCH_ACCEPT_TAC]);; % A little simplifying lemma % let lemma1 = TAC_PROOF( ([], "!tl:((*)ltree)list. (MAP ABS_ltree (AP (MAP $,(MAP(FST o REP_ltree)tl)) (PART (MAP Size(MAP(FST o REP_ltree)tl)) (FLAT(MAP(SND o REP_ltree)tl))))) = tl"), REWRITE_TAC [MAP_Size_LENGTH;PART_FLAT] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [o_THM;MAP;AP;A_R;HD;TL]);; % Another % let lemma2 = TAC_PROOF( ([], "!tl:((*)ltree)list. (AP (MAP(\t e. fn(t,e))(MAP(FST o REP_ltree)tl)) (PART (MAP Size(MAP(FST o REP_ltree)tl)) (FLAT(MAP(SND o REP_ltree)tl)))) = (MAP (fn o REP_ltree) tl:(**)list)"), REWRITE_TAC [MAP_Size_LENGTH;PART_FLAT] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;AP;o_THM;TL;HD] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [PAIR]);; % Another % let lemma3 = TAC_PROOF( ([], "!trl:(tree)list. !l:(*)list. (LENGTH l = SUM(MAP Size trl)) ==> (FLAT (MAP (SND o REP_ltree) (MAP ABS_ltree (AP (MAP $, trl) (PART(MAP Size trl)l)))) = l)"), LIST_INDUCT_TAC THENL [REWRITE_TAC [SUM;MAP;LENGTH_NIL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [PART;AP;MAP;FLAT]; REWRITE_TAC [MAP;SUM;PART] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LENGTH_SND_SPLIT THEN RES_TAC THEN IMP_RES_TAC LENGTH_FST_SPLIT THEN ASM_REWRITE_TAC [AP;MAP;FLAT;HD;TL;o_THM] THEN MP_TAC (SPEC "(h:tree),(FST(SPLIT(Size h)(l:(*)list)))" R_A) THEN REWRITE_TAC [Is_ltree] THEN POP_ASSUM (ASSUME_TAC o SYM) THEN DISCH_THEN (\th1. FIRST_ASSUM (\th. (SUBST1_TAC (EQ_MP th1 th)) ? NO_TAC)) THEN IMP_RES_TAC APPEND_SPLIT THEN REWRITE_TAC [] THEN POP_ASSUM ACCEPT_TAC]);; % Another % let lemma4 = TAC_PROOF( ([], "!trl:(tree)list. !l:(*)list. (LENGTH l = SUM(MAP Size trl)) ==> (node (MAP (FST o REP_ltree) (MAP ABS_ltree (AP (MAP $, trl) (PART(MAP Size trl)l)))) = node trl)"), LIST_INDUCT_TAC THENL [REWRITE_TAC [SUM;MAP;LENGTH_NIL] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [PART;AP;MAP]; REWRITE_TAC [MAP;SUM;PART] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LENGTH_SND_SPLIT THEN RES_TAC THEN IMP_RES_TAC LENGTH_FST_SPLIT THEN ASM_REWRITE_TAC [AP;MAP;FLAT;HD;TL;o_THM] THEN MP_TAC (SPEC "(h:tree),(FST(SPLIT(Size h)(l:(*)list)))" R_A) THEN REWRITE_TAC [Is_ltree] THEN POP_ASSUM (ASSUME_TAC o SYM) THEN DISCH_THEN (\th1. FIRST_ASSUM (\th. (SUBST1_TAC (EQ_MP th1 th)) ? NO_TAC)) THEN POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [node_11] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; % Another % let lemma5 = TAC_PROOF( ([], "!trl l. (Size (node trl) = LENGTH l) ==> (ABS_ltree(node trl,l) = Node (HD l:*) (MAP ABS_ltree (AP (MAP $, trl) (PART (MAP Size trl) (TL l)))))"), ONCE_REWRITE_TAC [INST_TYPE [":num",":*"] EQ_SYM_EQ] THEN REWRITE_TAC [Size_thm;LENGTH_CONS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [HD;TL;Node] THEN IMP_RES_TAC lemma3 THEN POP_ASSUM SUBST1_TAC THEN IMP_RES_TAC lemma4 THEN POP_ASSUM SUBST1_TAC THEN REFL_TAC);; % Another % let lemma6 = TAC_PROOF( ([], "!trl. !l:(*)list. (Size (node trl) = LENGTH l) ==> ALL_EL (\p. Size(FST p) = LENGTH(SND p)) (AP(MAP $, trl)(PART(MAP Size trl)(TL l)))"), ONCE_REWRITE_TAC [INST_TYPE [":num",":*"] EQ_SYM_EQ] THEN REWRITE_TAC [Size_thm;LENGTH_CONS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [HD;TL] THEN POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN MAP_EVERY SPEC_TAC [("l':(*)list","l:(*)list"); ("trl:(tree)list","trl:(tree)list")] THEN LIST_INDUCT_TAC THENL [REWRITE_TAC [MAP;AP;PART;ALL_EL]; REWRITE_TAC [MAP;SUM;PART] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LENGTH_SND_SPLIT THEN RES_TAC THEN ASM_REWRITE_TAC [ALL_EL;AP;HD;TL] THEN CONV_TAC BETA_CONV THEN REWRITE_TAC [] THEN IMP_RES_TAC LENGTH_FST_SPLIT]);; % Another % let lemma7 = TAC_PROOF( ([], "!trl. ALL_EL (\t.!l. (Size t = LENGTH l) ==> (x(ABS_ltree(t,l)) = y(ABS_ltree(t,l)))) trl ==> (!l:((*)list)list. ALL_EL (\p. Size(FST p) = LENGTH(SND p)) (AP(MAP $, trl)l) ==> (MAP x(MAP ABS_ltree(AP(MAP $, trl)l)):(**)list = MAP y(MAP ABS_ltree(AP(MAP $, trl)l))))"), LIST_INDUCT_TAC THENL [REWRITE_TAC [ALL_EL;MAP;AP]; REWRITE_TAC [ALL_EL;MAP;AP] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []]);; % Prove the axiom for (*)ltree % let ltree_Axiom = prove_thm (`ltree_Axiom`, "!f. ?!fn. !v tl. fn(Node (v:*) tl):** = f (MAP fn tl) v tl", GEN_TAC THEN MP_TAC (SPEC_ALL REP_REC_lemma) THEN PURE_REWRITE_TAC [EXISTS_UNIQUE_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN CONJ_TAC THENL [EXISTS_TAC "(fn:^ty->**) o REP_ltree" THEN ASM_REWRITE_TAC [REP_Node;o_THM;TL;HD;lemma1;lemma2]; REPEAT (POP_ASSUM (K ALL_TAC)) THEN REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "l:(*)ltree" A_ONTO) THEN POP_ASSUM MP_TAC THEN POP_ASSUM SUBST1_TAC THEN PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL PAIR)] THEN PURE_REWRITE_TAC [Is_ltree] THEN SPEC_TAC ("SND (r:tree # (*)list)","l:(*)list") THEN SPEC_TAC ("FST (r:tree # (*)list)", "t:tree") THEN tree_INDUCT_TAC THEN REPEAT STRIP_TAC THEN IMP_RES_THEN SUBST1_TAC lemma5 THEN ASM_REWRITE_TAC [] THEN IMP_RES_TAC lemma6 THEN IMP_RES_TAC lemma7 THEN POP_ASSUM SUBST1_TAC THEN REFL_TAC]);; % get uniqueness part of ltree_Axiom % let unique_lemma = GEN_ALL(CONJUNCT2(CONV_RULE EXISTS_UNIQUE_CONV (SPEC_ALL ltree_Axiom)));; % Prove induction thm for (*)ltree % let ltree_Induct = save_thm (`ltree_Induct`, let unique = CONV_RULE (DEPTH_CONV BETA_CONV) unique_lemma in let spec = SPECL ["\b v tl.(ALL_EL (\x.x:bool) b \/ P (Node (v:*) tl))"; "\t:(*)ltree.T";"P:(*)ltree -> bool"] (INST_TYPE [":bool",":**"] (GEN_ALL unique)) in let conv = CONV_RULE(REDEPTH_CONV(BETA_CONV ORELSEC FUN_EQ_CONV))spec in let rew1 = TAC_PROOF(([], "(X = Y \/ X) = (Y ==> X)"), ASM_CASES_TAC "X:bool" THEN ASM_REWRITE_TAC[]) in let rew2 = TAC_PROOF(([], "(!h:*. !t. ALL_EL P t ==> P(Node h t)) = (!t. ALL_EL P t ==> !h. P(Node h t))"), REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC) in let rew3 = TAC_PROOF(([], "!l:(*)list. ALL_EL (\x.x) (MAP (\x.T) l)"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;ALL_EL] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC) in let rew4 = TAC_PROOF(([], "!l:(*)list. ALL_EL (\x.x) (MAP P l) = ALL_EL P l"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;ALL_EL] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC) in GEN_ALL(REWRITE_RULE [rew1;rew3;rew2;rew4] conv));; let exists_lemma = GEN_ALL(CONJUNCT1(CONV_RULE EXISTS_UNIQUE_CONV (SPEC_ALL ltree_Axiom)));; let Node_11 = prove_thm (`Node_11`, "!v1:*. !v2 trl1 trl2. ((Node v1 trl1) = (Node v2 trl2)) = ((v1 = v2) /\ (trl1 = trl2))", MP_TAC (SPEC "\l:(*)list. \v:*. \trl:((*)ltree)list. v" (INST_TYPE [":*",":**"] exists_lemma)) THEN MP_TAC (SPEC "\l:(((*)ltree)list)list. \v:*.\trl:((*)ltree)list. trl" (INST_TYPE [":((*)ltree)list",":**"] (GEN_ALL exists_lemma))) THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [POP_ASSUM (MP_TAC o AP_TERM "fn':(*)ltree->*") THEN ASM_REWRITE_TAC[]; POP_ASSUM (MP_TAC o AP_TERM "fn:(*)ltree->((*)ltree)list") THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]);; % --------------------------------------------------------------------- % % ltree_INDUCT: thm -> thm % % % % A |- !tl. ALL_EL \t.P[t] tl ==> !v. P[Node v tl] % % ---------------------------------------------------------- % % A |- !t. P[t] % % % % --------------------------------------------------------------------- % let ltree_INDUCT th = (let (tl,body) = dest_forall(concl th) in let (asm,v,con) = (I # dest_forall) (dest_imp body) in let ALL_EL,[P;tll] = strip_comb asm in let b = genvar bool_ty in let concth = SYM(RIGHT_BETA(REFL "^P(Node ^v ^tl)")) and IND = SPEC P (INST_TYPE [type_of v,":*"] ltree_Induct) and th' = DISCH asm (SPEC v (UNDISCH(SPEC tl th))) in let th1 = SUBST [concth,b] "^(concl th') = (ALL_EL ^P ^tl ==> ^b)" (REFL (concl th')) in let th2 = GEN tl (DISCH asm (GEN v(UNDISCH (EQ_MP th1 th')))) in CONV_RULE (ONCE_DEPTH_CONV BETA_CONV) (MP IND th2)?failwith `ltree_INDUCT`);; % --------------------------------------------------------------------- % % % % ltree_INDUCT_TAC % % % % [A] !t.P[t] % % ================================ % % [A,ALL_EL \t.P[t] trl] |- !v. P[Node v trl] % % % % --------------------------------------------------------------------- % let ltree_INDUCT_TAC (A,term) = (let t,body = dest_forall term in let t' = variant ((frees term) @ (freesl A)) t in let t_ty = hd(snd(dest_type(type_of t))) in let body' = subst [t',t] body in let v' = variant ((frees body') @ (freesl A)) "v:^t_ty" in let trl = variant ((frees body') @ (freesl A)) "trl:((^t_ty)ltree)list" in let asm = "ALL_EL (\^t'.^body') trl" in ([ (asm.A, mk_forall (v',subst["Node (^v') ^trl",t']body'))], \[thm]. ltree_INDUCT (GEN trl (DISCH asm thm))) ) ? failwith `ltree_INDUCT_TAC`;; % Need this theorem % let Node_onto = prove_thm (`Node_onto`, "!t:(*)ltree. ?v:*. ?trl. t = Node v trl", ltree_INDUCT_TAC THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC ["v:*";"trl:((*)ltree)list"] THEN REFL_TAC);; close_theory();; quit();; hol88-2.02.19940316/theories/mk_num.ml0000640000212700021270000002176205071125205015373 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_num.ml % % % % DESCRIPTION: Creates the theory "num.th" containing Peano's % % postulates for the natural numbers. % % % % AUTHOR: T. F. Melham (88.04.02) % % % % PARENTS: BASIC-HOL.th % % WRITES FILES: num.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % Create the theory % new_theory `num`;; let INFINITY_AX = axiom `ind` `INFINITY_AX`;; let ONE_ONE_DEF = definition `bool` `ONE_ONE_DEF`;; let ONTO_DEF = definition `bool` `ONTO_DEF`;; % Define successor "SUC_REP:ind->ind" on ind. % let SUC_REP_DEF = new_definition (`SUC_REP_DEF`, "SUC_REP = @f:ind->ind. ONE_ONE f /\ ~(ONTO f)");; % "ZERO_REP:ind" represents "0:num" % let ZERO_REP_DEF = new_definition (`ZERO_REP_DEF`, "ZERO_REP = @x:ind. !y. ~(x = SUC_REP y)");; % "IS_NUM:ind->bool" defines the subset of ":ind" used to represent % % numbers. It is the smallest subset containing "ZERO_REP" and closed % % under "SUC_REP" % let IS_NUM_REP = new_definition (`IS_NUM_REP`, "IS_NUM_REP m = !P:ind->bool. P ZERO_REP /\ (!n. P n ==> P(SUC_REP n)) ==> P m");; % Prove that there is a representation in ind of at least one number. % let EXISTS_NUM_REP = TAC_PROOF (([],"?n. IS_NUM_REP n"), PURE_REWRITE_TAC [IS_NUM_REP] THEN EXISTS_TAC "ZERO_REP" THEN REPEAT STRIP_TAC);; % make the type definition. % let num_TY_DEF = new_type_definition (`num`, "IS_NUM_REP", EXISTS_NUM_REP);; % --------------------------------------------------------------------- % % Define a representation function, REP_num, from the type num to % % the representing type ind, and the inverse abstraction % % function ABS_num, and prove some trivial lemmas about them. % % --------------------------------------------------------------------- % let num_ISO_DEF = define_new_type_bijections `num_ISO_DEF` `ABS_num` `REP_num` num_TY_DEF;; let R_11 = prove_rep_fn_one_one num_ISO_DEF and R_ONTO = prove_rep_fn_onto num_ISO_DEF and A_11 = prove_abs_fn_one_one num_ISO_DEF and A_ONTO = prove_abs_fn_onto num_ISO_DEF;; % The following hack, and explanation are mjcg's % % % % "0" is defined to be the element of ":num" that % % is represented by "ZERO_REP". Unfortunately we cannot use the ML % % function new_definition as "0" is recognised by the parser as % % a constant of type ":num" (a hack needed to get over the problem that % % there are infinitely many numerals) and so new_definition thinks % % one is trying to redefine a constant. The following lisp hack fixes % % things by switching off the automatic constantization of numerals. % % MJCG 9/11/88 for HOL88 % % Redefined numconstp rather than constp % lisp `(setdebug t)`;; lisp `(defun numconstp (tok) nil)`;; let ZERO_DEF = new_definition(`ZERO_DEF`, "0 = ABS_num(ZERO_REP)");; % Define the successor function on num. % let SUC_DEF = new_definition(`SUC_DEF`, "SUC m = ABS_num(SUC_REP(REP_num m))");; close_theory();; % Prove that IS_NUM_REP ZERO_REP % let IS_NUM_REP_ZERO = TAC_PROOF (([], "IS_NUM_REP ZERO_REP"), REWRITE_TAC [IS_NUM_REP] THEN REPEAT STRIP_TAC);; % Prove that IS_NUM_REP (SUC_REP x) % let IS_NUM_SUC_REP = TAC_PROOF (([], "!i. IS_NUM_REP i ==> IS_NUM_REP (SUC_REP i)"), REWRITE_TAC [IS_NUM_REP] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC);; let IS_NUM_REP_SUC_REP = TAC_PROOF (([], "!n. IS_NUM_REP(SUC_REP(REP_num n))"), GEN_TAC THEN MATCH_MP_TAC IS_NUM_SUC_REP THEN REWRITE_TAC [R_ONTO] THEN EXISTS_TAC "n:num" THEN REFL_TAC);; % Prove that SUC_REP is one-to-one and ZERO_REP ~= SUC_REP i. % let thm1 = REWRITE_RULE [SYM SUC_REP_DEF] (SELECT_RULE INFINITY_AX);; let thm2 = REWRITE_RULE [ONE_ONE_DEF;ONTO_DEF] thm1;; % |- !x1 x2. (SUC_REP x1 = SUC_REP x2) ==> (x1 = x2) % let SUC_REP_11 = CONJUNCT1 thm2;; % |- !x. ~(SUC_REP x = ZERO_REP) % let NOT_SUC_ZERO = let th1 = CONV_RULE NOT_FORALL_CONV (CONJUNCT2 thm2) in let th2 = CONV_RULE (ONCE_DEPTH_CONV NOT_EXISTS_CONV) th1 in let th3 = SELECT_RULE th2 in let th4 = REWRITE_RULE [SYM ZERO_REP_DEF] th3 in CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) th4;; % --------------------------------------------------------------------- % % Proof of NOT_SUC : |- !n. ~(SUC n = 0) % % --------------------------------------------------------------------- % let NOT_SUC = prove_thm (`NOT_SUC`, "!n. ~(SUC n = 0)", PURE_REWRITE_TAC [SUC_DEF;ZERO_DEF] THEN GEN_TAC THEN MP_TAC (SPECL ["SUC_REP(REP_num n)";"ZERO_REP"] A_11) THEN REWRITE_TAC [IS_NUM_REP_ZERO;IS_NUM_REP_SUC_REP] THEN DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC NOT_SUC_ZERO);; % --------------------------------------------------------------------- % % Prove that |- !m n. (SUC m = SUC n) ==> (m = n) % % --------------------------------------------------------------------- % let INV_SUC = prove_thm (`INV_SUC`, "!m n. (SUC m = SUC n) ==> (m = n)", REPEAT GEN_TAC THEN REWRITE_TAC [SUC_DEF] THEN MP_TAC (SPECL ["SUC_REP(REP_num m)";"SUC_REP(REP_num n)"] A_11) THEN REWRITE_TAC [IS_NUM_REP_SUC_REP] THEN DISCH_THEN SUBST1_TAC THEN DISCH_THEN (MP_TAC o MATCH_MP SUC_REP_11) THEN REWRITE_TAC [R_11]);; % --------------------------------------------------------------------- % % Prove induction theorem. % % --------------------------------------------------------------------- % let ind_lemma1 = TAC_PROOF (([], "!P. P ZERO_REP /\ (!i. (P i ==> P(SUC_REP i))) ==> (!i. IS_NUM_REP i ==> P i)"), PURE_ONCE_REWRITE_TAC [IS_NUM_REP] THEN REPEAT STRIP_TAC THEN RES_TAC);; let lemma = TAC_PROOF(([], "(A ==> A /\ B) = (A ==> B)"), ASM_CASES_TAC "A:bool" THEN ASM_REWRITE_TAC []);; let ind_lemma2 = TAC_PROOF (([], "!P. P ZERO_REP /\ (!i. (IS_NUM_REP i /\ P i ==> P(SUC_REP i))) ==> (!i. IS_NUM_REP i ==> P i)"), GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPEC "\i. IS_NUM_REP i /\ P i" ind_lemma1) THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [lemma] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC [IS_NUM_REP_ZERO] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC IS_NUM_SUC_REP THEN RES_TAC);; let lemma1 = TAC_PROOF (([], "(!i. IS_NUM_REP i ==> P(ABS_num i)) = (!n. P n)"), EQ_TAC THEN REPEAT STRIP_TAC THENL [STRIP_ASSUME_TAC (SPEC "n:num" A_ONTO) THEN RES_TAC THEN ASM_REWRITE_TAC []; POP_ASSUM MP_TAC THEN REWRITE_TAC [R_ONTO] THEN STRIP_GOAL_THEN (STRIP_THM_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC []]);; let INDUCTION = prove_thm (`INDUCTION`, "!P. (P 0 /\ (!n. P n ==> P(SUC n))) ==> !n. P n", GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPEC "\i. P(ABS_num i):bool" ind_lemma2) THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [SYM ZERO_DEF;lemma1] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; REWRITE_TAC [R_ONTO] THEN GEN_TAC THEN CONV_TAC ANTE_CONJ_CONV THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC [num_ISO_DEF;SYM (SPEC_ALL SUC_DEF)]]);; quit();; hol88-2.02.19940316/theories/mk_pair.ml0000640000212700021270000000715505071125205015527 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_pair.ml % % % % DESCRIPTION: Define a theory of pairs % % % % WRITES FILES: pair.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % In this theory we define pairs and verify the basic properties. The built-in theory of pairs (i.e. the theory `prod`) is put in with mk_thm for kludgy reasons hinted at in the file theories/mk_bool.ml % new_theory `pair`;; let MAKE_PAIR_DEF = new_definition (`MAKE_PAIR_DEF`, "MAKE_PAIR(x:*)(y:**) = \a b.(a=x)/\(b=y)");; let ISA_PAIR_DEF = new_definition (`ISA_PAIR_DEF`, "ISA_PAIR p = ?x:*.?y:**. p = MAKE_PAIR x y");; let PAIR_EXISTS_THM = prove_thm (`PAIR_EXISTS_THM`, "?p:*->**->bool. ISA_PAIR p", EXISTS_TAC "MAKE_PAIR (x:*) (y:**)" THEN REWRITE_TAC[MAKE_PAIR_DEF;ISA_PAIR_DEF] THEN EXISTS_TAC "x:*" THEN EXISTS_TAC "y:**" THEN REWRITE_TAC[]);; new_type_definition (`pair`, "ISA_PAIR:(*->**->bool)->bool", PAIR_EXISTS_THM);; let ABS_pair = new_definition (`ABS_pair_DEF`, "ABS_pair p = @p':(*,**)pair. REP_pair p' = p");; let COMMA_DEF = new_infix_definition (`COMMA`, "$COMMA (x:*) (y:**) = ABS_pair(MAKE_PAIR x y)");; let FIRST_DEF = new_definition (`FIRST_DEF`, "FIRST(p:(*,**)pair) = @x.?y. MAKE_PAIR x y = REP_pair p");; let SECOND_DEF = new_definition (`SECOND_DEF`, "SECOND(p:(*,**)pair) = @y.?x. MAKE_PAIR x y = REP_pair p");; % Not yet finished ... % let ABS_REP = prove_thm (`ABS_REP`, "ABS_pair(REP_pair(p:(*,**)pair)) = p", ???);; let PAIR_THM = prove_thm (`PAIR_THM`, "!x:(*,**)pair. (FIRST x) COMMA (SECOND x) = x", GEN_TAC THEN REWRITE_TAC[FIRST_DEF;SECOND_DEF;COMMA_DEF;MAKE_PAIR_DEF]);; let FIRST_THM = prove_thm (`FIRST_THM`, "!x:*.!y:**. FIRST(x COMMA y) = x", GEN_TAC THEN REWRITE_TAC[FIRST_DEF;SECOND_DEF;COMMA_DEF;MAKE_PAIR_DEF]);; let SECOND_THM = prove_thm (`SECOND_THM`, "!x:*.!y:**. SECOND(x COMMA y) = y", GEN_TAC THEN REWRITE_TAC[FIRST_DEF;SECOND_DEF;COMMA_DEF;MAKE_PAIR_DEF]);; close_theory();; hol88-2.02.19940316/theories/mk_sum.ml0000640000212700021270000003751605071125206015405 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_sum.ml % % % % DESCRIPTION: Creates the theory "sum.th" containing the logical % % definition of the sum type operator. The sum type is % % defined and the following "axiomatization" is proven % % from the definition of the type: % % % % |- !f g. ?!h. (h o INL = f) /\ (h o INR = g) % % % % Using this axiom, the following standard theorems are % % proved. % % % % |- ISL (INL a) |- ISR (INR b) % % |- ~ISL (INR b) |- ~ISR (INL a) % % |- OUTL (INL a) = a |- OUTR (INR b) = b % % |- ISL(x) ==> INL (OUTL x)=x % % |- ISR(x) ==> INR (OUTR x)=x % % |- !x. ISL x \/ ISR x % % % % AUTHOR: T. F. Melham (86.11.24) % % % % PARENTS: combin.th % % WRITES FILES: sum.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % % % % REVISION HISTORY: 87.03.14 90.04.10 90.09.09 % %=============================================================================% % --------------------------------------------------------------------- % % Create and open the new theory sum.th. % % --------------------------------------------------------------------- % new_theory `sum`;; % parent theory is theory of combinators. % new_parent `combin`;; % Fetch theorems needed from combin.th % let o_DEF = definition `combin` `o_DEF`;; let o_THM = theorem `combin` `o_THM`;; % ===================================================================== % % Introduce the new type. % % ===================================================================== % % --------------------------------------------------------------------- % % The sum of types ":*" and ":**" will be represented by a certain % % subset of type ":bool->*->**->bool". A left injection of value "p:*" % % will be represented by: "\b x y. x=p /\ b". A right injection of % % value "q:**" will be represented by: "\b x y. x=q /\ ~b". % % The predicate IS_SUM_REP is true of just those objects of the type % % ":bool->*->**->bool" which are representations of some injection. % % --------------------------------------------------------------------- % let IS_SUM_REP = new_definition (`IS_SUM_REP`, "IS_SUM_REP (f:bool->*->**->bool) = ?v1 v2. (f = \b x y.(x=v1) /\ b) \/ (f = \b x y.(y=v2) /\ ~b)");; % --------------------------------------------------------------------- % % Prove that there exists some object in the representing type that % % lies in the subset of legal representations. % % --------------------------------------------------------------------- % let EXISTS_SUM_REP = TAC_PROOF(([], "?f:bool -> * -> ** -> bool. IS_SUM_REP f"), EXISTS_TAC "\b x (y:**). (x=@x:*.T) /\ b" THEN PURE_ONCE_REWRITE_TAC [IS_SUM_REP] THEN EXISTS_TAC "@x:*.T" THEN REWRITE_TAC []);; % --------------------------------------------------------------------- % % Use the type definition mechanism to introduce the new type. % % The theorem returned is: |- ?rep. TYPE_DEFINITION IS_SUM_REP rep % % --------------------------------------------------------------------- % let sum_TY_DEF = new_type_definition (`sum`, "IS_SUM_REP:(bool -> * -> ** -> bool) -> bool", EXISTS_SUM_REP);; % --------------------------------------------------------------------- % % Define a representation function, REP_sum, from the type (*,**)sum to % % the representing type bool->*->**->bool, and the inverse abstraction % % function ABS_sum, and prove some trivial lemmas about them. % % --------------------------------------------------------------------- % let sum_ISO_DEF = define_new_type_bijections `sum_ISO_DEF` `ABS_sum` `REP_sum` sum_TY_DEF;; let R_A = GEN_ALL (SYM (SPEC_ALL (CONJUNCT2 sum_ISO_DEF))) and R_11 = SYM(SPEC_ALL (prove_rep_fn_one_one sum_ISO_DEF)) and A_ONTO = REWRITE_RULE [IS_SUM_REP] (prove_abs_fn_onto sum_ISO_DEF);; % --------------------------------------------------------------------- % % The definitions of the constants INL and INR follow: % % --------------------------------------------------------------------- % % Define the injection function INL:*->(*,**)sum % let INL_DEF = new_definition (`INL_DEF`, "!e.(INL:*->(*,**)sum) e = ABS_sum(\b x (y:**). (x = e) /\ b)");; % Define the injection function INR:**->(*,**)sum % let INR_DEF = new_definition (`INR_DEF`, "!e.(INR:**->(*,**)sum) e = ABS_sum(\b (x:*) y. (y = e) /\ ~b)");; % ===================================================================== % % The proof of the "axiom" for sum types follows. % % ===================================================================== % % Two abbreviations. NB: local to this file only! [TFM 90.05.26] % let SIMP = REWRITE_RULE [];; let REWRITE1_TAC th = REWRITE_TAC [th];; % Prove that REP_sum(INL v) gives the representation of INL v. % let REP_INL = TAC_PROOF(([], "REP_sum (INL v) = \b x (y:**). (x:* = v) /\ b"), PURE_REWRITE_TAC [INL_DEF;R_A;IS_SUM_REP] THEN EXISTS_TAC "v:*" THEN REWRITE_TAC[]);; % Prove that REP_sum(INR v) gives the representation of INR v. % let REP_INR = TAC_PROOF(([], "REP_sum (INR v) = \b (x:*) y. (y:** = v) /\ ~b"), PURE_REWRITE_TAC [INR_DEF;R_A;IS_SUM_REP] THEN MAP_EVERY EXISTS_TAC ["v:*";"v:**"] THEN REWRITE_TAC[]);; % Prove that INL is one-to-one % let INL_11 = TAC_PROOF(([], "(INL x = (INL y:(*,**)sum)) = (x = y)"), EQ_TAC THENL [PURE_REWRITE_TAC [R_11;REP_INL] THEN CONV_TAC (REDEPTH_CONV (FUN_EQ_CONV ORELSEC BETA_CONV)) THEN DISCH_THEN (ACCEPT_TAC o SIMP o SPECL ["T";"x:*";"y:**"]); DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; % Prove that INR is one-to-one % let INR_11 = TAC_PROOF(([], "(INR x = (INR y:(*,**)sum)) = (x = y)"), EQ_TAC THENL [PURE_REWRITE_TAC [R_11;REP_INR] THEN CONV_TAC (REDEPTH_CONV (FUN_EQ_CONV ORELSEC BETA_CONV)) THEN DISCH_THEN (ACCEPT_TAC o SYM o SIMP o SPECL["F";"x:*";"y:**"]); DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; % Prove that left injections and right injections are not equal. % let INR_neq_INL = TAC_PROOF(([],"!v1 v2. ~(INR v2:(*,**)sum = INL v1)"), PURE_REWRITE_TAC [R_11;REP_INL;REP_INR] THEN REPEAT GEN_TAC THEN CONV_TAC (REDEPTH_CONV (FUN_EQ_CONV ORELSEC BETA_CONV)) THEN DISCH_THEN (CONTR_TAC o SIMP o SPECL ["T";"v1:*";"v2:**"]));; % Prove a little lemma about epsilon-terms. % let EPS_lemma = TAC_PROOF(([], "(@x:*.y=x) = y"), CONV_TAC (SYM_CONV THENC SELECT_CONV) THEN EXISTS_TAC "y:*" THEN REFL_TAC);; % --------------------------------------------------------------------- % % The abstract "axiomatization" of the sum type consists of the single % % theorem given below: % % % % sum_axiom |- !f g. ?!h. (h o INL = f) /\ (h o INR = g) % % % % The definitions of the usual operators ISL, OUTL, etc. follow from % % this axiom. % % --------------------------------------------------------------------- % let sum_axiom = prove_thm(`sum_axiom`, "!f:*->***. !g:**->***. ?!h. (h o INL = f) /\ (h o INR = g)", PURE_REWRITE_TAC [EXISTS_UNIQUE_DEF;o_DEF] THEN CONV_TAC (REDEPTH_CONV (BETA_CONV ORELSEC FUN_EQ_CONV)) THEN REPEAT (FILTER_STRIP_TAC "x:(*,**)sum->***") THENL [EXISTS_TAC "\x:(*,**)sum.((?v1. x = INL v1) => f(@v1.x = INL v1) | g(@v2.x = INR v2)):***" THEN PURE_REWRITE_TAC [EXISTS_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REWRITE_TAC [INL_11;INR_11;INR_neq_INL;EPS_lemma]; REPEAT GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC (REWRITE1_TAC o (CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)))) THEN REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "s:(*,**)sum" A_ONTO) THEN ASM_REWRITE_TAC (map (SYM o SPEC_ALL) [INL_DEF;INR_DEF])]);; % --------------------------------------------------------------------- % % We also prove a version of sum_axiom which is in a form suitable for % % use with the recursive type definition tools. % % --------------------------------------------------------------------- % let sum_Axiom = prove_thm (`sum_Axiom`, "!f:*->***. !g:**->***. ?! h. (!x. h(INL x) = f x) /\ (!y. h(INR y) = g y)", let cnv = CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) sum_axiom in let rew = SPEC_ALL (REWRITE_RULE [o_THM] cnv) in MATCH_ACCEPT_TAC rew);; % --------------------------------------------------------------------- % % The definitions of ISL, ISR, OUTL, OUTR follow. % % --------------------------------------------------------------------- % % Derive the defining property for ISL. % let ISL_DEF = TAC_PROOF(([], "?ISL. (!x:*. ISL(INL x)) /\ (!y:**. ~ISL(INR y))"), let inst = (INST_TYPE [":bool",":***"] sum_axiom) in let spec = SPECL ["\x:*.T"; "\y:**.F"] inst in let exth = CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV spec) in let conv = CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) exth in STRIP_ASSUME_TAC (REWRITE_RULE [o_THM] conv) THEN EXISTS_TAC "h:(*,**)sum->bool" THEN ASM_REWRITE_TAC []);; % Then define ISL with a constant specification. % let ISL = new_specification `ISL` [`constant`,`ISL`] ISL_DEF;; % Derive the defining property for ISR. % let ISR_DEF = TAC_PROOF(([], "?ISR. (!x:**. ISR(INR x)) /\ (!y:*. ~ISR(INL y))"), let inst = (INST_TYPE [":bool",":***"] sum_axiom) in let spec = SPECL ["\x:*.F"; "\y:**.T"] inst in let exth = CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV spec) in let conv = CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) exth in STRIP_ASSUME_TAC (REWRITE_RULE [o_THM] conv) THEN EXISTS_TAC "h:(*,**)sum->bool" THEN ASM_REWRITE_TAC []);; % Then define ISR with a constant specification. % let ISR = new_specification `ISR` [`constant`,`ISR`] ISR_DEF;; % Derive the defining property of OUTL. % let OUTL_DEF = TAC_PROOF(([], "?OUTL. !x. OUTL(INL x:(*,**)sum) = x"), let inst = (INST_TYPE [":*",":***"] sum_axiom) in let spec = SPECL ["\x:*.x"; "\y:**.@x:*.F"] inst in let exth = CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV spec) in let conv = CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) exth in STRIP_ASSUME_TAC (REWRITE_RULE [o_THM] (BETA_RULE conv)) THEN EXISTS_TAC "h:(*,**)sum->*" THEN ASM_REWRITE_TAC []);; % Then define OUTL with a constant specification. % let OUTL = new_specification `OUTL` [`constant`,`OUTL`] OUTL_DEF;; % Derive the defining property of OUTR. % let OUTR_DEF = TAC_PROOF(([], "?OUTR. !x. OUTR(INR x:(*,**)sum) = x"), let inst = (INST_TYPE [":**",":***"] sum_axiom) in let spec = SPECL ["\x:*.@y:**.F"; "\y:**.y"] inst in let exth = CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV spec) in let conv = CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) exth in STRIP_ASSUME_TAC (REWRITE_RULE [o_THM] (BETA_RULE conv)) THEN EXISTS_TAC "h:(*,**)sum->**" THEN ASM_REWRITE_TAC []);; % Then define OUTR with a constant specification. % let OUTR = new_specification `OUTR` [`constant`,`OUTR`] OUTR_DEF;; % Close the theory. % close_theory();; % --------------------------------------------------------------------- % % Prove the following standard theorems about the sum type. % % % % |- ISL(s) ==> INL (OUTL s)=s % % |- ISR(s) ==> INR (OUTR s)=s % % |- !s. ISL s \/ ISR s % % % % --------------------------------------------------------------------- % % First, get the existence and uniqueness parts of sum_axiom. % % % % sum_EXISTS: % % |- !f g. ?h. (!x. h(INL x) = f x) /\ (!x. h(INR x) = g x) % % % % sum_UNIQUE: % % |- !f g x y. % % ((!x. x(INL x) = f x) /\ (!x. x(INR x) = g x)) /\ % % ((!x. y(INL x) = f x) /\ (!x. y(INR x) = g x)) ==> % % (!s. x s = y s) % let [sum_EXISTS;sum_UNIQUE] = let cnv = CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) sum_axiom in let rew = SPEC_ALL (REWRITE_RULE [o_THM] cnv) in let [a;b] = map GEN_ALL (CONJUNCTS (CONV_RULE EXISTS_UNIQUE_CONV rew)) in [a; BETA_RULE (CONV_RULE (ONCE_DEPTH_CONV FUN_EQ_CONV) b)];; % Prove the following key lemma by contradiction. % let sum_lemma = let lemma = TAC_PROOF (([],"~~!v:(*,**)sum. (?x. v = INL x) \/ (?x. v = INR x)"), CONV_TAC (DEPTH_CONV NOT_FORALL_CONV) THEN PURE_REWRITE_TAC [DE_MORGAN_THM] THEN DISCH_THEN (STRIP_ASSUME_TAC o (CONV_RULE (DEPTH_CONV NOT_EXISTS_CONV))) THEN MP_TAC (SPECL ["\x:*.T";"\x:**.F"; "\v':(*,**)sum. ((v = v') => T | ISL v')"; "ISL:(*,**)sum->bool"] (INST_TYPE [":bool",":***"] sum_UNIQUE)) THEN MP_TAC (SPECL ["\x:*.T";"\x:**.F"; "\v':(*,**)sum. ((v = v') => F | ISL v')"; "ISL:(*,**)sum->bool"] (INST_TYPE [":bool",":***"] sum_UNIQUE)) THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC [ISR;ISL] THEN DISCH_THEN (\th. PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL th)]) THEN DISCH_THEN (MP_TAC o SPEC "v:(*,**)sum") THEN REWRITE_TAC[]) in REWRITE_RULE [] lemma;; % Prove that: !x. ISL(x) \/ ISR(x) % let ISL_OR_ISR = prove_thm (`ISL_OR_ISR`, "!x:(*,**)sum. ISL(x) \/ ISR(x)", STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "x:(*,**)sum" sum_lemma) THEN ASM_REWRITE_TAC [ISL;ISR]);; % Prove that: |- !x. ISL(x) ==> INL (OUTL x) = x % let INL = prove_thm(`INL`, "!x:(*,**)sum. ISL(x) ==> (INL (OUTL x) = x)", STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "x:(*,**)sum" sum_lemma) THEN ASM_REWRITE_TAC [ISL;OUTL]);; % Prove that: |- !x. ISR(x) ==> INR (OUTR x) = x % let INR = prove_thm(`INR`, "!x:(*,**)sum. ISR(x) ==> (INR (OUTR x) = x)", STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "x:(*,**)sum" sum_lemma) THEN ASM_REWRITE_TAC [ISR;OUTR]);; quit();; hol88-2.02.19940316/theories/mk_tydefs.ml0000640000212700021270000003157305512606270016101 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_tydefs.ml % % % % DESCRIPTION: Creates the theory "tydefs.th" containing the master % % theorem for axiomatizing all recursive types. % % % % AUTHOR: T. F. Melham (87.07.27) % % % % PARENTS: ltree.th % % WRITES FILES: tydefs.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1988 % % % % REVISION HISTORY: 90.04.11 % %=============================================================================% % Create the new theory % new_theory `tydefs`;; % Parent theories % map new_parent [`ltree`];; % Fetch theorems from combin.th % let o_THM = theorem `combin` `o_THM`;; % load list induction theorem % let list_INDUCT = theorem `list` `list_INDUCT`;; let MAP_o = theorem `list` `MAP_o`;; % load thms from ltree.th % let ltree_Axiom = theorem `ltree` `ltree_Axiom` and ltree_Induct = theorem `ltree` `ltree_Induct`;; % Load theorems from list.th. % let ALL_EL = definition `list` `ALL_EL` and MAP = definition `list` `MAP`;; % --------------------------------------------------------------------- % % Load/define code needed. % % --------------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml % % but it is part of hol rather than basic hol, so it's loaded % % in uncompiled. % % % % TFM 88.04.02 % loadt (concat ml_dir_pathname `ind.ml`);; % Create a tactic for list induction. % let LIST_INDUCT_TAC = INDUCT_THEN list_INDUCT ASSUME_TAC;; % --------------------------------------------------------------------- % % ltree_INDUCT: thm -> thm % % % % A |- !tl. ALL_EL \t.P[t] tl ==> !v. P[Node v tl] % % ---------------------------------------------------------- % % A |- !t. P[t] % % % % --------------------------------------------------------------------- % let ltree_INDUCT th = (let (tl,body) = dest_forall(concl th) in let (asm,v,con) = (I # dest_forall) (dest_imp body) in let ALL_EL,[P;tll] = strip_comb asm in let b = genvar bool_ty in let concth = SYM(RIGHT_BETA(REFL "^P(Node ^v ^tl)")) and IND = SPEC P (INST_TYPE [type_of v,":*"] ltree_Induct) and th' = DISCH asm (SPEC v (UNDISCH(SPEC tl th))) in let th1 = SUBST [concth,b] "^(concl th') = (ALL_EL ^P ^tl ==> ^b)" (REFL (concl th')) in let th2 = GEN tl (DISCH asm (GEN v(UNDISCH (EQ_MP th1 th')))) in CONV_RULE (ONCE_DEPTH_CONV BETA_CONV) (MP IND th2) ? failwith `ltree_INDUCT`);; % --------------------------------------------------------------------- % % % % ltree_INDUCT_TAC % % % % [A] !t.P[t] % % ================================ % % [A,ALL_EL \t.P[t] trl] |- !v. P[Node v trl] % % % % --------------------------------------------------------------------- % let ltree_INDUCT_TAC (A,term) = (let t,body = dest_forall term in let t' = variant ((frees term) @ (freesl A)) t in let t_ty = hd(snd(dest_type(type_of t))) in let body' = subst [t',t] body in let v' = variant ((frees body') @ (freesl A)) "v:^t_ty" in let trl = variant ((frees body') @ (freesl A)) "trl:((^t_ty)ltree)list" in let asm = "ALL_EL (\^t'.^body') trl" in ([ (asm.A, mk_forall (v',subst["Node (^v') ^trl",t']body'))], \[thm]. ltree_INDUCT (GEN trl (DISCH asm thm))) ) ? failwith `ltree_INDUCT_TAC`;; % First, a little lemma about Node. % let Node_onto = TAC_PROOF(([], "!t:(*)ltree. ?v:*. ?trl. t = Node v trl"), ltree_INDUCT_TAC THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC ["v:*";"trl:((*)ltree)list"] THEN REFL_TAC);; % A little lemma about ALL_EL and MAP % let ALL_EL_MAP_lemma = TAC_PROOF (([], "!l:(*)list. ALL_EL (\x.x) (MAP P l) = ALL_EL P l"), LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL;MAP] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; % Existence part of ltree_Axiom. % let exists_lemma = GEN_ALL(CONJUNCT1(CONV_RULE EXISTS_UNIQUE_CONV (SPEC_ALL ltree_Axiom)));; % Show that for every predicate P on Nodes of a (*)ltree, there is a % % predicate TRP that holds of a (*)ltree if P holds of every node in % % the tree. % let TRP_thm = TAC_PROOF( ([], "!P. ?TRP. !v:*. !tl. TRP(Node v tl) = P v tl /\ ALL_EL TRP tl"), STRIP_TAC THEN MP_TAC (SPEC "\rl:(bool)list. \v:*. \tl:((*)ltree)list. P v tl /\ ALL_EL (\x.x) rl" (INST_TYPE [":bool",":**"] exists_lemma)) THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REWRITE_TAC [ALL_EL_MAP_lemma] THEN STRIP_TAC THEN EXISTS_TAC "fn:(*)ltree->bool" THEN POP_ASSUM ACCEPT_TAC);; % A lemma % let lemma1 = TAC_PROOF( ([], "!l:(*)list. !x y. (ALL_EL P l /\ ALL_EL (\e. P e ==> (x e:** = y e)) l) ==> (MAP x l = MAP y l)"), LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL;MAP] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; % There is a unique function on trees all of whose nodes satisfy P % % Following proof revised for version 1.12 resolution. [TFM 91.01.18] % let TRP_EU = TAC_PROOF( ([], "!TRP:(*)ltree->bool. !P. (!v:*. !tl. TRP(Node v tl) = P v tl /\ ALL_EL TRP tl) ==> !f. (?fn. !v tl. TRP(Node v tl) ==> (fn(Node v tl):** = f (MAP fn tl) v tl)) /\ !x y. (!v tl. TRP(Node v tl) ==> (x(Node v tl) = f (MAP x tl) v tl)) ==> (!v tl. TRP(Node v tl) ==> (y(Node v tl) = f (MAP y tl) v tl)) ==> (!t. TRP t ==> (x t = y t))"), REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN CONJ_TAC THENL [STRIP_ASSUME_TAC (SPEC "f:(**)list->*->((*)ltree)list->**" exists_lemma) THEN EXISTS_TAC "fn:(*)ltree->**" THEN ASM_REWRITE_TAC []; REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN ltree_INDUCT_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC lemma1 THEN ASM_REWRITE_TAC []]);; % define a function TRP P t = P holds of every node in t % let TRP_DEF = new_definition (`TRP_DEF`, "TRP P = @trp. !v:*. !tl. trp(Node v tl) = P v tl /\ ALL_EL trp tl");; let TRP = prove_thm (`TRP`, "!P v tl.(TRP P) (Node v tl) = P (v:*) tl /\ ALL_EL (TRP P)tl", REWRITE_TAC [TRP_DEF] THEN CONV_TAC (DEPTH_CONV SELECT_CONV) THEN MATCH_ACCEPT_TAC TRP_thm);; % There is a unique recursive function on TRP-subsets of (*)ltree % % % % |- !P f. % % (?fn. !v tl. TRP P(Node v tl) ==> % % (fn(Node v tl) = f(MAP fn tl)v tl)) /\ % % (!x y. (!v tl. TRP P(Node v tl) ==> % % (x(Node v tl) = f(MAP x tl)v tl)) ==> % % (!v tl. TRP P(Node v tl) ==> % % (y(Node v tl) = f(MAP y tl)v tl)) ==> % % (!x. TRP P x ==> (x x = y x))) % let TRP_EU_thm = GEN_ALL (MATCH_MP TRP_EU (SPEC "P:*->((*)ltree)list->bool" TRP));; % Some lemmas about ABS and REP % let AR_lemma1 = TAC_PROOF(([],"(!a:**.ABS(REP a:(*)ltree) = a) ==> (!r:(*)ltree. TRP P r = (REP(ABS r:**) = r)) ==> !tl. ALL_EL (TRP P) (MAP REP tl)"), REPEAT DISCH_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;ALL_EL]);; let AR_lemma2 = TAC_PROOF(([],"(!a:**.ABS(REP a:(*)ltree) = a) ==> (!r:(*)ltree. TRP P r = (REP(ABS r:**) = r)) ==> !tl v. P v (MAP REP tl) ==> (REP(ABS(Node v (MAP REP tl))) = Node v (MAP REP tl))"), DISCH_TAC THEN DISCH_THEN (\th. REWRITE_TAC [SYM(SPEC_ALL th)] THEN ASSUME_TAC th) THEN IMP_RES_TAC AR_lemma1 THEN REWRITE_TAC [TRP] THEN ASM_REWRITE_TAC[]);; let AR_lemma3 = TAC_PROOF(([], "(!a:**.ABS(REP a:(*)ltree) = a) ==> (!r:(*)ltree. TRP P r = (REP(ABS r:**) = r)) ==> !trl. ALL_EL (TRP P) trl ==> ?tl. trl = MAP REP tl"), REPEAT DISCH_TAC THEN LIST_INDUCT_TAC THENL [REWRITE_TAC[ALL_EL] THEN EXISTS_TAC "NIL:(**)list" THEN REWRITE_TAC [MAP]; ASM_REWRITE_TAC [ALL_EL] THEN REPEAT STRIP_TAC THEN RES_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC "CONS (ABS (h:(*)ltree):**) tl" THEN ASM_REWRITE_TAC [MAP]]);; let AR_lemma4 = TAC_PROOF(([], "(!a:**.ABS(REP a:(*)ltree) = a) ==> (!al. MAP ABS (MAP REP al) = al)"), STRIP_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP]);; let AR_lemma5 = (GEN_ALL o UNDISCH_ALL o hd o IMP_CANON o DISCH_ALL o prove_abs_fn_onto) (ASSUME "(!a:**.ABS(REP a:(*)ltree) = a) /\ (!r:(*)ltree. TRP P r = (REP(ABS r:**) = r))");; %< Moved to the theory list (file mk_list_thm2.ml) by WW 5 Jan 94 let MAP_o = prove_thm (`MAP_o`, "!f:**->***. !g:*->**. MAP (f o g) = (MAP f) o (MAP g)", REPEAT GEN_TAC THEN CONV_TAC FUN_EQ_CONV THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;o_THM]);; >% % ===================================================================== % % NOW... the main theorem.... % % Following proof revised for version 1.12 resolution. [TFM 91.01.18] % % ===================================================================== % let TY_DEF_THM = prove_thm (`TY_DEF_THM`, "!REP. !ABS. !P. ((!a:**.ABS(REP a:(*)ltree) = a) /\ (!r:(*)ltree. TRP P r = (REP(ABS r:**) = r))) ==> !f. ?!fn. !v:*. !tl. P v (MAP REP tl) ==> (fn(ABS(Node v (MAP REP tl)):**):*** = f (MAP fn tl) v tl)", REPEAT GEN_TAC THEN CONV_TAC (ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV FUN_EQ_CONV) THEN REPEAT STRIP_TAC THENL [MP_TAC (CONJUNCT1 (SPECL ["P:*->((*)ltree)list->bool"; "\l:(***)list.\v:*.\tl:((*)ltree)list. f l v (MAP ABS tl:(**)list):***"] (INST_TYPE [":***",":**"] TRP_EU_thm))) THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN PURE_ONCE_REWRITE_TAC [TRP] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "((fn:(*)ltree->***) o REP):(**)->***" THEN REPEAT GEN_TAC THEN STRIP_TAC THEN ASSUME_TAC (SPEC_ALL (UNDISCH_ALL AR_lemma1)) THEN IMP_RES_TAC AR_lemma2 THEN IMP_RES_TAC AR_lemma4 THEN RES_TAC THEN ASM_REWRITE_TAC [MAP_o;o_THM]; REPEAT_TCL STRIP_THM_THEN (\th g. SUBST1_TAC th g ? MP_TAC th g) (SPEC "x:**" AR_lemma5) THEN SPEC_TAC ("r:(*)ltree","r:(*)ltree") THEN MP_TAC (CONJUNCT2 (SPECL ["P:*->((*)ltree)list->bool"; "\l:(***)list.\v:*.\tl:((*)ltree)list. f l v (MAP ABS tl:(**)list):***"] (INST_TYPE [":***",":**"] TRP_EU_thm))) THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN DISCH_THEN (MP_TAC o (REWRITE_RULE [SYM(ANTE_CONJ_CONV "A /\ B ==> C")])) THEN DISCH_THEN (MP_TAC o (SPECL["((fn:**->***) o ABS):(*)ltree->***"; "((fn':**->***) o ABS):(*)ltree->***"])) THEN REWRITE_TAC [o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC [TRP] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN CONV_TAC ANTE_CONJ_CONV THEN DISCH_THEN (\t. STRIP_TAC THEN MP_TAC t) THEN IMP_RES_THEN (STRIP_THM_THEN SUBST1_TAC) (UNDISCH_ALL AR_lemma3) THEN IMP_RES_TAC AR_lemma4 THEN ASM_REWRITE_TAC [MAP_o;o_THM]]);; % For use in type definition package... % let exists_TRP = prove_thm (`exists_TRP`, "!P. (?v:*. P v NIL) ==> ?t:(*)ltree. TRP P t", GEN_TAC THEN STRIP_TAC THEN EXISTS_TAC "Node (v:*) NIL" THEN ASM_REWRITE_TAC [TRP;ALL_EL]);; close_theory();; quit();; hol88-2.02.19940316/theories/READ-ME0000640000212700021270000000654404610714047014517 0ustar cammcamm+ ===================================================================== + | HOL DISTRIBUTION DIRECTORY: theories | + ===================================================================== + This directory contains the files needed to rebuild all the built-in HOL theories. The theory files themselves are also kept here. Theory Hierarchy for BASIC-HOL is: PPLAMB | | bool | | ind | | BASIC-HOL Where these theories are: PPLAMB - The interface to the LCF world. HOL users don't need to know about this. bool - Introduces the type ":bool" and the constants "==>", "=" and "@". Contains the definitions of the logical constants ("T", "!", "?", "/\", \/", "<=>", "F", "~", "LET", "COND", "FCOND", "ONE_ONE" and "ONTO"). Introduces the axioms of HOL. The type ":prod" is also introduced in the theory bool, together with the pairing functions "$,", "FST" and "SND". For boring reasons to do with how the system is build pairing can't be in a separate theory with `bool` as parent (see hol/theories/mk_bool.ml for details). ind - Introduces the type ":ind" and the Axiom of Infinity. BASIC-HOL - A dummy theory which is what you are in when you run the basic-hol system (HOL users can ignore this). The HOL system is built on top of BASIC-HOL, which is a parent to all the theories described below. The theory hierarchy for HOL is: num | | prim_rec | | arithmetic combin | | | | list --------- | | | | | sum one tree | | | | | | | --------| | | | | | | | ltree | | | | | | | | tydefs | | | | | | | | --------- | ---------- | | | | | | HOL Where these theories are combin - defines the combinators o, K, S, I. sum - defines the disjoint sum type operator one - defines the type :one with only one element num - Defines the type ":num" and the constants "0" and "SUC". Has Peano's Axioms as theorems. prim_rec - Defines "<" and contains the Primitive Recursion Theorem (together with several trivial about numbers that are needed in proving it). arithmetic - Defines "+", "-", "*", "/", ">", "<=", ">=" and contains various theorems about them. list - Defines the type ":list" and the constants "NIL", "CONS", "HD", "TL", "NULL" and various others. Contains various theorems including structural induction. tree - defines the type :tree of arbitrary-branching trees. Used to automate recursive type definitions. ltree - defines the type :(*)ltree of arbitrary-branching LABELLED trees. Used to automate recursive type definitions. tydefs - contains the proof of a "master theorem" for automating recursive type definitions. HOL - The theory you are in when starting up a hol system. hol88-2.02.19940316/theories/.CKP0000640000212700021270000000000104615303231014150 0ustar cammcamm>hol88-2.02.19940316/theories/mk_list_thms.ml0000640000212700021270000004446705524667446016636 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_list_thms.ml % % % % DESCRIPTION: Extends the theory list.th with some theorems % % Definitions have been moved to mk_list_defs.ml % % % % AUTHORS: T. F. Melham (86.11.24) % % W. Wong (2 Jan 94) % % % % WRITES FILES: list.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % % W. Wong 1994 % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Reopen the theory % % --------------------------------------------------------------------- % load_theory `list`;; % --------------------------------------------------------------------- % % fetch axiom and definitions for lists. % % --------------------------------------------------------------------- % let list_Axiom = theorem `list` `list_Axiom`;; let NULL_DEF = definition `list` `NULL_DEF`;; let HD = definition `list` `HD`;; let TL = definition `list` `TL`;; let SNOC = definition `list` `SNOC`;; let FOLDR = definition `list` `FOLDR`;; let FOLDL = definition `list` `FOLDL`;; let FILTER = definition `list` `FILTER`;; let MAP = definition `list` `MAP`;; let MAP2 = definition `list` `MAP2`;; let SCANR = definition `list` `SCANR`;; let SCANL = definition `list` `SCANL`;; let SEG = definition `list` `SEG`;; let REVERSE = definition `list` `REVERSE`;; let APPEND = definition `list` `APPEND`;; let FLAT = definition `list` `FLAT`;; let LENGTH = definition `list` `LENGTH`;; let ALL_EL = definition `list` `ALL_EL`;; let SOME_EL = definition `list` `SOME_EL`;; let IS_EL_DEF = definition `list` `IS_EL_DEF`;; let AND_EL_DEF = definition `list` `AND_EL_DEF`;; let OR_EL_DEF = definition `list` `OR_EL_DEF`;; let FIRSTN = definition `list` `FIRSTN`;; let BUTFIRSTN = definition `list` `BUTFIRSTN`;; let LASTN = definition `list` `LASTN`;; let BUTLASTN = definition `list` `BUTLASTN`;; let LAST_DEF = definition `list` `LAST_DEF`;; let BUTLAST_DEF = definition `list` `BUTLAST_DEF`;; let EL = definition `list` `EL`;; let ELL = definition `list` `ELL`;; let IS_PREFIX = definition `list` `IS_PREFIX`;; let IS_SUFFIX = definition `list` `IS_SUFFIX`;; let IS_SUBLIST = definition `list` `IS_SUBLIST`;; let SPLITP = definition `list` `SPLITP`;; let PREFIX_DEF = definition `list` `PREFIX_DEF`;; let SUFFIX_DEF = definition `list` `SUFFIX_DEF`;; let ZIP = definition `list` `ZIP`;; let UNZIP = definition `list` `UNZIP`;; let UNZIP_FST_DEF = definition `list` `UNZIP_FST_DEF`;; let UNZIP_SND_DEF = definition `list` `UNZIP_SND_DEF`;; let SUM = definition `list` `SUM`;; let GENLIST = definition `list` `GENLIST`;; let REPLICATE = definition `list` `REPLICATE`;; % --------------------------------------------------------------------- % % Fetch a few theorems from num.th % % --------------------------------------------------------------------- % let NOT_SUC = theorem `num` `NOT_SUC`;; let INV_SUC = theorem `num` `INV_SUC`;; let INDUCTION = theorem `num` `INDUCTION`;; % --------------------------------------------------------------------- % % Fetch a few theorems from prim_rec.th % % --------------------------------------------------------------------- % %< let num_Axiom = theorem `prim_rec` `num_Axiom`;; let NOT_LESS_0 = theorem `prim_rec` `NOT_LESS_0`;; let LESS_0 = theorem `prim_rec` `LESS_0`;; let LESS_MONO = theorem `prim_rec` `LESS_MONO`;; let INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ`;; >% map autoload_theory [`theorem`, `prim_rec`, `INV_SUC_EQ`; `theorem`, `prim_rec`, `LESS_REFL`; `theorem`, `prim_rec`, `SUC_LESS`; `theorem`, `prim_rec`, `NOT_LESS_0`; `theorem`, `prim_rec`, `LESS_MONO`; `theorem`, `prim_rec`, `LESS_SUC_REFL`; `theorem`, `prim_rec`, `LESS_SUC`; `theorem`, `prim_rec`, `LESS_THM`; `theorem`, `prim_rec`, `LESS_SUC_IMP`; `theorem`, `prim_rec`, `LESS_0`; `theorem`, `prim_rec`, `EQ_LESS`; `theorem`, `prim_rec`, `SUC_ID`; `theorem`, `prim_rec`, `NOT_LESS_EQ`; `theorem`, `prim_rec`, `LESS_NOT_EQ`; `theorem`, `prim_rec`, `LESS_SUC_SUC`; `theorem`, `prim_rec`, `PRE`; `theorem`, `prim_rec`, `num_Axiom`];; % --------------------------------------------------------------------- % % Fetch a few things from arithmetic.th % % --------------------------------------------------------------------- % %< let ADD_CLAUSES = theorem `arithmetic` `ADD_CLAUSES`;; let LESS_MONO_EQ = theorem `arithmetic` `LESS_MONO_EQ`;; let ADD_EQ_0 = theorem `arithmetic` `ADD_EQ_0`;; let SUC_NOT = theorem `arithmetic` `SUC_NOT`;; % WW % let EQ_MONO_ADD_EQ = theorem `arithmetic` `EQ_MONO_ADD_EQ;; let ADD1 = theorem `arithmetic` `ADD1`;; >% map autoload_theory [`definition`, `arithmetic`, `LESS_OR_EQ`; `definition`, `arithmetic`, `ADD`; `definition`, `arithmetic`, `SUB`; `theorem`, `arithmetic`, `ADD_SUC`; `theorem`, `arithmetic`, `ADD_CLAUSES`; `theorem`, `arithmetic`, `ADD_SYM`; `theorem`, `arithmetic`, `LESS_MONO_EQ`; `theorem`, `arithmetic`, `SUC_SUB1`; `theorem`, `arithmetic`, `LESS_ADD`; `theorem`, `arithmetic`, `SUB_0`; `theorem`, `arithmetic`, `LESS_TRANS`; `theorem`, `arithmetic`, `ADD1`; `theorem`, `arithmetic`, `ADD_0`; `theorem`, `arithmetic`, `LESS_ANTISYM`; `theorem`, `arithmetic`, `LESS_LESS_SUC`; `theorem`, `arithmetic`, `LESS_SUC_EQ_COR`; `theorem`, `arithmetic`, `LESS_OR`; `theorem`, `arithmetic`, `OR_LESS`; `theorem`, `arithmetic`, `LESS_EQ`; `theorem`, `arithmetic`, `LESS_NOT_SUC`; `theorem`, `arithmetic`, `LESS_EQ_ANTISYM`; `theorem`, `arithmetic`, `LESS_EQ_ADD`; `theorem`, `arithmetic`, `NOT_LESS`; `theorem`, `arithmetic`, `SUB_EQ_0`; `theorem`, `arithmetic`, `ADD_ASSOC`; `theorem`, `arithmetic`, `SUB_ADD`; `theorem`, `arithmetic`, `ADD_EQ_0`; `theorem`, `arithmetic`, `ADD_INV_0_EQ`; `theorem`, `arithmetic`, `LESS_SUC_NOT`; `theorem`, `arithmetic`, `LESS_MONO_ADD`; `theorem`, `arithmetic`, `LESS_MONO_ADD_EQ`; `theorem`, `arithmetic`, `EQ_MONO_ADD_EQ`; `theorem`, `arithmetic`, `LESS_EQ_MONO_ADD_EQ`; `theorem`, `arithmetic`, `LESS_EQ_TRANS`; `theorem`, `arithmetic`, `LESS_EQ_LESS_EQ_MONO`; `theorem`, `arithmetic`, `LESS_EQ_REFL`; `theorem`, `arithmetic`, `LESS_IMP_LESS_OR_EQ`; `theorem`, `arithmetic`, `LESS_MONO_MULT`; `theorem`, `arithmetic`, `LESS_0_CASES`; `theorem`, `arithmetic`, `ZERO_LESS_EQ`; `theorem`, `arithmetic`, `LESS_EQ_MONO`; `theorem`, `arithmetic`, `LESS_OR_EQ_ADD`; `theorem`, `arithmetic`, `SUC_NOT`; `theorem`, `arithmetic`, `SUB_MONO_EQ`; `theorem`, `arithmetic`, `SUB_LESS_EQ`; `theorem`, `arithmetic`, `LESS_EQUAL_ANTISYM`; `theorem`, `arithmetic`, `SUB_LESS_0`; `theorem`, `arithmetic`, `SUB_LESS_OR`; `theorem`, `arithmetic`, `LESS_ADD_SUC`; `theorem`, `arithmetic`, `LESS_SUB_ADD_LESS`; `theorem`, `arithmetic`, `ADD_SUB`; `theorem`, `arithmetic`, `LESS_EQ_ADD_SUB`; `theorem`, `arithmetic`, `SUB_EQUAL_0`; `theorem`, `arithmetic`, `LESS_EQ_SUB_LESS`; `theorem`, `arithmetic`, `NOT_SUC_LESS_EQ`; `theorem`, `arithmetic`, `SUB_SUB`; `theorem`, `arithmetic`, `LESS_IMP_LESS_ADD`; `theorem`, `arithmetic`, `LESS_EQ_IMP_LESS_SUC`; `theorem`, `arithmetic`, `SUB_LESS_EQ_ADD`; `theorem`, `arithmetic`, `LESS_LESS_CASES`; `theorem`, `arithmetic`, `LESS_EQ_0`; `theorem`, `arithmetic`, `EQ_LESS_EQ`; `theorem`, `arithmetic`, `ADD_MONO_LESS_EQ`; `theorem`, `arithmetic`, `NOT_SUC_LESS_EQ_0`; `theorem`, `arithmetic`, `PRE_SUC_EQ`; `theorem`, `arithmetic`, `NOT_LEQ`; `theorem`, `arithmetic`, `NOT_NUM_EQ`; `theorem`, `arithmetic`, `NOT_GREATER`; `theorem`, `arithmetic`, `NOT_GREATER_EQ`; `theorem`, `arithmetic`, `SUC_ONE_ADD`; `theorem`, `arithmetic`, `SUC_ADD_SYM`; `theorem`, `arithmetic`, `NOT_SUC_ADD_LESS_EQ`; `theorem`, `arithmetic`, `MULT_LESS_EQ_SUC`; `theorem`, `arithmetic`, `PRE_SUB1`; `theorem`, `arithmetic`, `SUB_PLUS`; `theorem`, `arithmetic`, `GREATER_EQ` ];; % --------------------------------------------------------------------- % % Fetch a few definitions and theorems from fun.th % % --------------------------------------------------------------------- % let ASSOC_DEF = definition `fun` `ASSOC_DEF`;; let COMM_DEF = definition `fun` `COMM_DEF`;; let FCOMM_DEF = definition `fun` `FCOMM_DEF`;; let RIGHT_ID_DEF = definition `fun` `RIGHT_ID_DEF`;; let LEFT_ID_DEF = definition `fun` `LEFT_ID_DEF`;; let MONOID_DEF = definition `fun` `MONOID_DEF`;; let ASSOC_CONJ = theorem `fun` `ASSOC_CONJ`;; let ASSOC_DISJ = theorem `fun` `ASSOC_DISJ`;; let FCOMM_ASSOC = theorem `fun` `FCOMM_ASSOC`;; let MONOID_CONJ_T = theorem `fun` `MONOID_CONJ_T`;; let MONOID_DISJ_F = theorem `fun` `MONOID_CONJ_T`;; % --------------------------------------------------------------------- % % Fetch a few definitions and theorems from combin.th % % --------------------------------------------------------------------- % let o_DEF = definition `combin` `o_DEF`;; let o_THM = theorem `combin` `o_THM`;; let I_THM = theorem `combin` `I_THM`;; let UNCURRY_DEF = definition `bool` `UNCURRY_DEF`;; % --------------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml, but it % % is part of hol rather than basic hol. So it's loaded in uncompiled % % (because it may not have been recompiled since basic-hol was last % % rebuilt. [TFM 88.04.02] % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `ind.ml`);; % --------------------------------------------------------------------- % % Create an induction tactic for :num % % --------------------------------------------------------------------- % let INDUCT_TAC = INDUCT_THEN (theorem `num` `INDUCTION`) ASSUME_TAC;; % --------------------------------------------------------------------- % % Load the code for primitive recursive definitions on arbitrary types. % % % % Note that prim_rec_ml.o must be recompiled if basic-hol has been % % rebuilt. The uncompiled version is therefore loaded here. % % % % TFM 88.04.02 % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `prim_rec.ml`);; % --------------------------------------------------------------------- % % Load the auxiliary code for recursive types. % % NOTE: uses things defined in prim_rec.ml (load uncompiled) % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `tyfns.ml`);; loadt (concat ml_dir_pathname `numconv.ml`);; % --------------------------------------------------------------------- % % Proofs of some theorems about lists. % % --------------------------------------------------------------------- % let NULL = prove_thm (`NULL`, "(NULL (NIL:(*)list)) /\ !h t. ~NULL(CONS (h:*) t)", REWRITE_TAC [NULL_DEF]);; % List induction % % |- P NIL /\ (!t. P t ==> !h. P(CONS h t)) ==> (!x.P x) % let list_INDUCT = save_thm (`list_INDUCT`, prove_induction_thm list_Axiom);; % Create a tactic. % let LIST_INDUCT_TAC = INDUCT_THEN list_INDUCT ASSUME_TAC;; % Cases theorem: |- !l. (l = []) \/ (?t h. l = CONS h t) % let list_CASES = save_thm(`list_CASES`, prove_cases_thm list_INDUCT);; % CONS11: |- !h t h' t'. (CONS h t = CONS h' t') = (h = h') /\ (t = t') % let CONS_11 = save_thm(`CONS_11`, prove_constructors_one_one list_Axiom);; let NOT_NIL_CONS = save_thm(`NOT_NIL_CONS`, prove_constructors_distinct list_Axiom);; let NOT_CONS_NIL = save_thm (`NOT_CONS_NIL`, CONV_RULE(ONCE_DEPTH_CONV SYM_CONV) NOT_NIL_CONS);; let LIST_NOT_EQ = prove_thm (`LIST_NOT_EQ`, "!l1 l2. ~(l1 = l2) ==> !h1:*. !h2. ~(CONS h1 l1 = CONS h2 l2)", REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [CONS_11]);; let NOT_EQ_LIST = prove_thm (`NOT_EQ_LIST`, "!h1:*. !h2. ~(h1 = h2) ==> !l1 l2. ~(CONS h1 l1 = CONS h2 l2)", REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [CONS_11]);; let EQ_LIST = prove_thm (`EQ_LIST`, "!h1:*.!h2.(h1=h2) ==> !l1 l2. (l1 = l2) ==> (CONS h1 l1 = CONS h2 l2)", REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [CONS_11]);; let CONS = prove_thm (`CONS`, "!l:(*)list. ~NULL l ==> (CONS (HD l) (TL l) = l)", STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "l:(*)list" list_CASES) THEN POP_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC [HD;TL;NULL]);; let APPEND_ASSOC = prove_thm (`APPEND_ASSOC`, "!l1:(*)list. !l2 l3. APPEND l1 (APPEND l2 l3) = (APPEND (APPEND l1 l2) l3)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [APPEND]);; let LENGTH_APPEND = prove_thm (`LENGTH_APPEND`, "!l1:(*)list.!l2:(*)list. LENGTH (APPEND l1 l2) = (LENGTH l1) + (LENGTH l2)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH;APPEND;ADD_CLAUSES]);; let MAP_APPEND = prove_thm (`MAP_APPEND`, "!f:*->**.!l1 l2. MAP f (APPEND l1 l2) = APPEND (MAP f l1) (MAP f l2)", STRIP_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;APPEND]);; let LENGTH_MAP = prove_thm (`LENGTH_MAP`, "!l. !f:*->**. LENGTH (MAP f l) = LENGTH l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;LENGTH]);; %< DELETED by WW 2 Jan 94 EVERY --> ALL_EL let EVERY_EL = prove_thm (`EVERY_EL`, "!l P. EVERY P l = !n. n < LENGTH l ==> P(EL n l:*)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [EVERY_DEF;LENGTH;NOT_LESS_0] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC THEN INDUCT_TAC THENL [ASM_REWRITE_TAC [EL;HD]; ASM_REWRITE_TAC [LESS_MONO_EQ;EL;TL]]; REPEAT STRIP_TAC THENL [POP_ASSUM (MP_TAC o SPEC "0") THEN REWRITE_TAC [LESS_0;EL;HD]; POP_ASSUM ((ANTE_RES_THEN ASSUME_TAC) o (MATCH_MP LESS_MONO)) THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [EL;TL]]]);; let EVERY_CONJ = prove_thm (`EVERY_CONJ`, "!l. EVERY (\x:*. P x /\ Q x) l = (EVERY P l /\ EVERY Q l)", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [EVERY_DEF] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN FIRST_ASSUM ACCEPT_TAC);; let ALL_EL_CONJ = prove_thm(`ALL_EL_CONJ`, "!P Q l. ALL_EL (\x:*. P x /\ Q x) l = (ALL_EL P l /\ ALL_EL Q l)", GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN FIRST_ASSUM ACCEPT_TAC);; >% let LENGTH_NIL = prove_thm (`LENGTH_NIL`, "!l. (LENGTH l = 0) = (l:(*)list = NIL)", LIST_INDUCT_TAC THEN REWRITE_TAC [LENGTH;NOT_SUC;NOT_CONS_NIL]);; let LENGTH_CONS = prove_thm (`LENGTH_CONS`, "!l n. (LENGTH l = (SUC n)) = (?h:*. ?l'. (LENGTH l' = n) /\ (l = CONS h l'))", LIST_INDUCT_TAC THENL [REWRITE_TAC [LENGTH;NOT_EQ_SYM(SPEC_ALL NOT_SUC);NOT_NIL_CONS]; REWRITE_TAC [LENGTH;INV_SUC_EQ;CONS_11] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [EXISTS_TAC "h:*" THEN EXISTS_TAC "l:(*)list" THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]]);; let LENGTH_EQ_SUC = prove_thm (`LENGTH_EQ_CONS`, "!P:(*)list->bool. !n:num. (!l. (LENGTH l = SUC n) ==> P l) = !l. (LENGTH l = n) ==> (\l. !x:*. P (CONS x l)) l", CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [LENGTH]; DISCH_TAC THEN INDUCT_THEN list_INDUCT STRIP_ASSUME_TAC THENL [REWRITE_TAC [LENGTH;NOT_NIL_CONS;NOT_EQ_SYM(SPEC_ALL NOT_SUC)]; ASM_REWRITE_TAC [LENGTH;INV_SUC_EQ;CONS_11] THEN REPEAT STRIP_TAC THEN RES_THEN MATCH_ACCEPT_TAC]]);; let LENGTH_EQ_NIL = prove_thm (`LENGTH_EQ_NIL`, "!P:(*)list->bool. (!l. (LENGTH l = 0) ==> P l) = P []", REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC [LENGTH]; DISCH_TAC THEN INDUCT_THEN list_INDUCT STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC []; ASM_REWRITE_TAC [LENGTH;NOT_SUC]]]);; % Added by WW 07-05-93 % let LENGTH_MAP2 = prove_thm(`LENGTH_MAP2`, "!l1 l2. (LENGTH l1 = LENGTH l2) ==> (!f:*->**->***. (LENGTH(MAP2 f l1 l2) = LENGTH l1) /\ (LENGTH(MAP2 f l1 l2) = LENGTH l2))", LIST_INDUCT_TAC THENL[ LIST_INDUCT_TAC THENL[ DISCH_TAC THEN PURE_ONCE_REWRITE_TAC[MAP2] THEN REWRITE_TAC[LENGTH]; GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN REWRITE_TAC[SUC_NOT]]; GEN_TAC THEN LIST_INDUCT_TAC THENL[ PURE_ONCE_REWRITE_TAC[LENGTH] THEN REWRITE_TAC[NOT_SUC]; GEN_TAC THEN PURE_ONCE_REWRITE_TAC[MAP2] THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN PURE_ONCE_REWRITE_TAC[INV_SUC_EQ] THEN DISCH_TAC THEN RES_THEN ASSUME_TAC THEN GEN_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]);; loadt`mk_list_thm2`;; quit();; hol88-2.02.19940316/theories/mk_arith_thms.ml0000640000212700021270000021725505511536743016756 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_arith_thms.ml % % % % DESCRIPTION: Proves many trivial theorems about arithmetic. Also % % some logical theorems. % % % % WRITES FILES: arithmetic.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: 88.04.02 by T. F. Melham % %=============================================================================% % Load the theory. % load_theory `arithmetic`;; % Fetch the definitions from arithmetic.th % % theorem changed to definition in HOL88 % let ADD = definition `arithmetic` `ADD` and SUB = definition `arithmetic` `SUB` and MULT = definition `arithmetic` `MULT` and EXP = definition `arithmetic` `EXP` and FACT = definition `arithmetic` `FACT` and EVEN = definition `arithmetic` `EVEN` and ODD = definition `arithmetic` `ODD`;; let GREATER = definition `arithmetic` `GREATER` and LESS_OR_EQ = definition `arithmetic` `LESS_OR_EQ` and GREATER_OR_EQ = definition `arithmetic` `GREATER_OR_EQ`;; % Fetch theorems from prim_rec.th % let INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ` and LESS_REFL = theorem `prim_rec` `LESS_REFL` and SUC_LESS = theorem `prim_rec` `SUC_LESS` and NOT_LESS_0 = theorem `prim_rec` `NOT_LESS_0` and LESS_MONO = theorem `prim_rec` `LESS_MONO` and LESS_SUC_REFL = theorem `prim_rec` `LESS_SUC_REFL` and LESS_SUC = theorem `prim_rec` `LESS_SUC` and LESS_THM = theorem `prim_rec` `LESS_THM` and LESS_SUC_IMP = theorem `prim_rec` `LESS_SUC_IMP` and LESS_0 = theorem `prim_rec` `LESS_0` and EQ_LESS = theorem `prim_rec` `EQ_LESS` and SUC_ID = theorem `prim_rec` `SUC_ID` and NOT_LESS_EQ = theorem `prim_rec` `NOT_LESS_EQ` and LESS_NOT_EQ = theorem `prim_rec` `LESS_NOT_EQ` and LESS_SUC_SUC = theorem `prim_rec` `LESS_SUC_SUC` and PRE = theorem `prim_rec` `PRE`;; % Load theorems from num.th % let NOT_SUC = theorem `num` `NOT_SUC` and INV_SUC = theorem `num` `INV_SUC` and INDUCTION = theorem `num` `INDUCTION`;; % Fetch definitions from fun.th % let ASSOC_DEF = definition `fun` `ASSOC_DEF` and RIGHT_ID_DEF = definition `fun` `RIGHT_ID_DEF` and LEFT_ID_DEF = definition `fun` `LEFT_ID_DEF` and MONOID_DEF = definition `fun` `MONOID_DEF`;; % --------------------------------------------------------------------- % % Load the axiom scheme for numerals. % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `numconv.ml`);; % --------------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml % % but it is part of hol rather than basic hol, so it's loaded % % in uncompiled (since it may not have been recompiled since % % basic-hol was last rebuilt. % % % % TFM 88.04.02 % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `ind.ml`);; % And create an induction tactic % % Added: TFM 88.03.31 % let INDUCT_TAC = INDUCT_THEN INDUCTION ASSUME_TAC;; % --------------------------------------------------------------------- % % ARITHMETIC THEOREMS % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % SUC_NOT = |- !n. ~(0 = SUC n) % % --------------------------------------------------------------------- % let SUC_NOT = save_thm(`SUC_NOT`, GEN "n:num" (NOT_EQ_SYM (SPEC "n:num" NOT_SUC)));; let ADD_0 = prove_thm (`ADD_0`, "!m. m + 0 = m", INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]);; let ADD_SUC = prove_thm (`ADD_SUC`, "!m n. SUC(m + n) = m + SUC n", INDUCT_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[ADD]);; let ADD_CLAUSES = prove_thm (`ADD_CLAUSES`, "(0 + m = m) /\ (m + 0 = m) /\ (SUC m + n = SUC(m + n)) /\ (m + SUC n = SUC(m + n))", REWRITE_TAC[ADD;ADD_0;ADD_SUC]);; let ADD_SYM = prove_thm (`ADD_SYM`, "!m n. m + n = n + m", INDUCT_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[ADD_0;ADD;ADD_SUC]);; let num_CASES = prove_thm (`num_CASES`, "!m. (m = 0) \/ ?n. m = SUC n", INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN EXISTS_TAC "m:num" THEN REWRITE_TAC[]);; let LESS_MONO_REV = prove_thm (`LESS_MONO_REV`, "!m n. (SUC m) < (SUC n) ==> (m < n)", REPEAT GEN_TAC THEN REWRITE_TAC[LESS_THM] THEN STRIP_TAC THEN IMP_RES_TAC SUC_LESS THEN IMP_RES_TAC EQ_LESS THEN ASM_REWRITE_TAC[]);; % |- !m n. (SUC m) < (SUC n) = m < n % let LESS_MONO_EQ = save_thm (`LESS_MONO_EQ`, GENL ["m:num";"n:num"] (IMP_ANTISYM_RULE (SPEC_ALL LESS_MONO_REV) (SPEC_ALL LESS_MONO)));; let SUC_SUB1 = prove_thm (`SUC_SUB1`, "!m. (SUC m) - 1 = m", REWRITE_TAC[num_CONV "1"] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[SUB;LESS_0;NOT_LESS_0;LESS_MONO_EQ]);; let PRE_SUB1 = prove_thm (`PRE_SUB1`, "!m. PRE m = (m - 1)", GEN_TAC THEN STRUCT_CASES_TAC(SPEC "m:num" num_CASES) THEN ASM_REWRITE_TAC[PRE;CONJUNCT1 SUB;SUC_SUB1]);; % --------------------------------------------------------------------- % % LESS_ADD proof rewritten: TFM 90.09.21 % % --------------------------------------------------------------------- % let LESS_ADD = prove_thm (`LESS_ADD`, "!m n. (n ?p. p+n = m", INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC[NOT_LESS_0;LESS_THM] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "SUC 0" THEN ASM_REWRITE_TAC[ADD]; RES_THEN (STRIP_THM_THEN (SUBST1_TAC o SYM)) THEN EXISTS_TAC "SUC p" THEN REWRITE_TAC [ADD]]);; let SUB_0 = prove_thm (`SUB_0`, "!m. (0 - m = 0) /\ (m - 0 = m)", INDUCT_TAC THEN ASM_REWRITE_TAC[SUB;NOT_LESS_0]);; let LESS_TRANS = prove_thm (`LESS_TRANS`, "!m n p. (m < n) /\ (n < p) ==> (m < p)", REPEAT GEN_TAC THEN SPEC_TAC("n:num","n:num") THEN SPEC_TAC("m:num","m:num") THEN SPEC_TAC("p:num","p:num") THEN INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0;LESS_THM] THEN REPEAT STRIP_TAC THEN RES_TAC THENL [SUBST_TAC[SYM(ASSUME "n:num = p")];ALL_TAC] THEN ASM_REWRITE_TAC[]);; let ADD1 = prove_thm (`ADD1`, "!m. SUC m = m + 1", INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES;num_CONV "1"]);; let LESS_ANTISYM = prove_thm (`LESS_ANTISYM`, "!m n. ~((m < n) /\ (n < m))", INDUCT_TAC THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_TRANS THEN IMP_RES_TAC LESS_REFL THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LESS_LESS_SUC = prove_thm (`LESS_LESS_SUC`, "!m n. ~((m < n) /\ (n < SUC m))", REWRITE_TAC[LESS_THM] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_TRANS THEN IMP_RES_TAC(DISCH_ALL(SUBS[ASSUME"n:num=m"](ASSUME"mbool. !x1 x2. f x1 /\ ~f x2 ==> ~(x1 = x2)", REPEAT STRIP_TAC THEN IMP_RES_TAC (DISCH_ALL(SUBS[ASSUME "x1:*=x2"](ASSUME"(f:*->bool)x1"))) THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LESS_OR = prove_thm (`LESS_OR`, "!m n. m < n ==> SUC m <= n", GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC [LESS_OR_EQ;NOT_LESS_0;LESS_THM;LESS_MONO_EQ;INV_SUC_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; let OR_LESS = prove_thm (`OR_LESS`, "!m n. (SUC m <= n) ==> (m < n)", REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN STRIP_TAC THEN IMP_RES_TAC SUC_LESS THEN IMP_RES_TAC EQ_LESS THEN ASM_REWRITE_TAC[]);; % |- !m n. (m < n) = (SUC m <= n) % let LESS_EQ = save_thm (`LESS_EQ`, GEN_ALL(IMP_ANTISYM_RULE (SPEC_ALL LESS_OR) (SPEC_ALL OR_LESS)));; let LESS_SUC_EQ_COR = prove_thm (`LESS_SUC_EQ_COR`, "!m n. m < n /\ ~(SUC m = n) ==> SUC m < n", REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_OR THEN MP_TAC(ASSUME "(SUC m) <= n") THEN REWRITE_TAC[LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN RES_TAC);; % RES_TAC doesn't solve the goal when "F" is in the assumptions % let LESS_NOT_SUC = prove_thm (`LESS_NOT_SUC`, "!m n. (m < n) /\ ~(n = SUC m) ==> SUC m < n", REPEAT GEN_TAC THEN ASM_CASES_TAC "n = SUC m" THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN MP_TAC (REWRITE_RULE[LESS_OR_EQ](EQ_MP(SPEC_ALL LESS_EQ)(ASSUME "m < n"))) THEN STRIP_TAC THEN ASSUME_TAC(SYM(ASSUME "SUC m = n")) THEN RES_TAC);; % RES_TAC doesn't solve "F" in assumptions % let LESS_0_CASES = prove_thm (`LESS_0_CASES`, "!m. (0 = m) \/ (0 < m)", INDUCT_TAC THEN REWRITE_TAC[LESS_0]);; let LESS_CASES_IMP = prove_thm (`LESS_CASES_IMP`, "!m n. ~(m < n) /\ ~(m = n) ==> (n < m)", GEN_TAC THEN INDUCT_TAC THEN STRIP_TAC THENL [MP_TAC(ASSUME "~(m = 0)") THEN ACCEPT_TAC (DISJ_IMP (SUBS [SPECL["0";"m:num"](INST_TYPE[":num",":*"]EQ_SYM_EQ)] (SPEC_ALL LESS_0_CASES))); MP_TAC(ASSUME "~m < (SUC n)") THEN REWRITE_TAC[LESS_THM;DE_MORGAN_THM] THEN STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC LESS_NOT_SUC THEN ASM_REWRITE_TAC[]]);; let LESS_CASES = prove_thm (`LESS_CASES`, "!m n. (m < n) \/ (n <= m)", REPEAT GEN_TAC THEN ASM_REWRITE_TAC[LESS_OR_EQ;DE_MORGAN_THM] THEN ASM_CASES_TAC "m:num = n" THEN ASM_CASES_TAC "m < n" THEN IMP_RES_TAC LESS_CASES_IMP THEN ASM_REWRITE_TAC[]);; let ADD_INV_0 = prove_thm (`ADD_INV_0`, "!m n. (m + n = m) ==> (n = 0)", REPEAT GEN_TAC THEN SPEC_TAC("m:num","m:num") THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES;INV_SUC_EQ]);; let LESS_EQ_ADD = prove_thm (`LESS_EQ_ADD`, "!m n. m <= m + n", GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN MP_TAC(ASSUME "m < (m + n) \/ (m = m + n)") THEN STRIP_TAC THENL [IMP_RES_TAC LESS_SUC THEN ASM_REWRITE_TAC[]; REWRITE_TAC[SYM(ASSUME "m = m + n");LESS_SUC_REFL]]);; let LESS_EQ_SUC_REFL = prove_thm (`LESS_EQ_SUC_REFL`, "!m. m <= SUC m", GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ;LESS_SUC_REFL]);; let LESS_ADD_NONZERO = prove_thm (`LESS_ADD_NONZERO`, "!m n. ~(n = 0) ==> (m < m + n)", GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC;ADD_CLAUSES] THEN ASM_CASES_TAC "n = 0" THEN ASSUME_TAC(SPEC "m + n" LESS_SUC_REFL) THEN RES_TAC THEN IMP_RES_TAC LESS_TRANS THEN ASM_REWRITE_TAC[ADD_CLAUSES;LESS_SUC_REFL]);; let LESS_EQ_ANTISYM = prove_thm (`LESS_EQ_ANTISYM`, "!m n. ~(m < n /\ n <= m)", REWRITE_TAC[LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_ANTISYM THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC(SYM(ASSUME "n:num = m")) THEN IMP_RES_TAC NOT_LESS_EQ THEN ASM_REWRITE_TAC[]);; let NOT_LESS = prove_thm (`NOT_LESS`, "!m n. ~(m < n) = (n <= m)", REPEAT GEN_TAC THEN ASM_CASES_TAC "m < n" THEN ASM_CASES_TAC "n <= m" THEN IMP_RES_TAC(DISJ_IMP(SPEC_ALL LESS_CASES)) THEN IMP_RES_TAC(CONTRAPOS(DISJ_IMP(SPEC_ALL LESS_CASES))) THEN RES_TAC THEN IMP_RES_TAC LESS_EQ_ANTISYM THEN ASM_REWRITE_TAC[]);; % I was exhausted when I did the proof below - it can almostly certainly be drastically shortened % let SUB_EQ_0 = prove_thm (`SUB_EQ_0`, "!m n. (m - n = 0) = (m <= n)", INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC[SUB;LESS_OR_EQ] THENL [REWRITE_TAC[SPECL["0 < n"; "0 = n"]DISJ_SYM;LESS_0_CASES];ALL_TAC] THEN ASM_CASES_TAC "m < n" THEN ASM_CASES_TAC "SUC m = n" THEN IMP_RES_TAC EQ_LESS THEN IMP_RES_TAC LESS_SUC_EQ_COR THEN IMP_RES_TAC(fst(EQ_IMP_RULE(SPEC_ALL NOT_LESS))) THEN IMP_RES_TAC(fst(EQ_IMP_RULE(SPEC_ALL LESS_OR_EQ))) THEN ASM_REWRITE_TAC [SPECL["n:num=m";"n ((m - n) + n = m)", INDUCT_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SUB;ADD_CLAUSES;LESS_SUC_REFL] THEN IMP_RES_TAC NOT_LESS_0 THEN ASM_CASES_TAC "m < n" THEN IMP_RES_TAC LESS_LESS_SUC THEN IMP_RES_TAC(fst(EQ_IMP_RULE(SPEC_ALL NOT_LESS))) THEN RES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let PRE_SUB = prove_thm (`PRE_SUB`, "!m n. PRE(m - n) = (PRE m) - n", INDUCT_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[SUB;PRE] THEN ASM_CASES_TAC "m < n" THEN ASM_REWRITE_TAC [PRE;LESS_OR_EQ; SUBS[SPECL["m-n";"0"](INST_TYPE[":num",":*"]EQ_SYM_EQ)] (SPECL ["m:num";"n:num"] SUB_EQ_0)]);; let ADD_EQ_0 = prove_thm (`ADD_EQ_0`, "!m n. (m + n = 0) = (m = 0) /\ (n = 0)", INDUCT_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES;NOT_SUC]);; let ADD_INV_0_EQ = prove_thm (`ADD_INV_0_EQ`, "!m n. (m + n = m) = (n = 0)", REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ADD_INV_0] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; let PRE_SUC_EQ = prove_thm (`PRE_SUC_EQ`, "!m n. (0 < n) ==> ((m = PRE n) = (SUC m = n))", INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[PRE;LESS_REFL;INV_SUC_EQ]);; let INV_PRE_EQ = prove_thm (`INV_PRE_EQ`, "!m n. (0 < m) /\ (0 < n) ==> ((PRE m = PRE n) = (m = n))", INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[PRE;LESS_REFL;INV_SUC_EQ]);; let LESS_SUC_NOT = prove_thm (`LESS_SUC_NOT`, "!m n. m < n ==> ~(n < SUC m)", REPEAT GEN_TAC THEN ASM_REWRITE_TAC[NOT_LESS] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_OR THEN ASM_REWRITE_TAC[]);; % About now I burned out and resorted to dreadful hacks. The name of the next theorem speaks for itself. % % Changed from prove_thm to TAC_PROOF, so that it doesn't have to appear % % in the REFERENCE manual. (TFM 90.04.11) % let TOTALLY_AD_HOC_LEMMA = TAC_PROOF (([], "!m n. (m + (SUC n) = n) = (SUC m = 0)"), REPEAT GEN_TAC THEN REWRITE_TAC [NOT_SUC;SYM(SPECL ["m:num";"n:num"] (CONJUNCT2 ADD)); (\[();();();th].th)(CONJUNCTS ADD_CLAUSES)] THEN REWRITE_TAC[SPECL["SUC m";"n:num"]ADD_SYM] THEN STRIP_TAC THEN IMP_RES_TAC ADD_INV_0 THEN IMP_RES_TAC NOT_SUC);; % The next proof took me ages - there must be a better way! % let ADD_EQ_SUB = prove_thm (`ADD_EQ_SUB`, "!m n p. (n <= p) ==> ((m + n = p) = (m = p - n))", INDUCT_TAC THEN INDUCT_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC [LESS_OR_EQ;ADD_CLAUSES;NOT_LESS_0;INV_SUC_EQ;LESS_MONO_EQ; NOT_SUC;NOT_EQ_SYM(SPEC_ALL NOT_SUC);LESS_0;SUB;SUB_0] THEN STRIP_TAC THEN IMP_RES_TAC LESS_NOT_EQ THEN ASM_REWRITE_TAC[LESS_SUC_REFL] THEN IMP_RES_TAC LESS_SUC_NOT THEN ASM_REWRITE_TAC[NOT_EQ_SYM(SPEC_ALL NOT_SUC);INV_SUC_EQ] THEN IMP_RES_TAC(fst(EQ_IMP_RULE(SPEC_ALL NOT_LESS))) THEN RES_TAC THEN ASM_REWRITE_TAC [SYM((\[();();();th].th)(CONJUNCTS(SPEC_ALL ADD_CLAUSES))); TOTALLY_AD_HOC_LEMMA]);; let LESS_MONO_ADD = prove_thm (`LESS_MONO_ADD`, "!m n p. (m < n) ==> (m + p) < (n + p)", GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN DISCH_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES;LESS_MONO_EQ]);; let LESS_MONO_ADD_INV = prove_thm (`LESS_MONO_ADD_INV`, "!m n p. ((m + p) < (n + p)) ==> (m < n)", GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES;LESS_MONO_EQ]);; let LESS_MONO_ADD_EQ = prove_thm (`LESS_MONO_ADD_EQ`, "!m n p. ((m + p) < (n + p)) = (m < n)", REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LESS_MONO_ADD;LESS_MONO_ADD_INV]);; let EQ_MONO_ADD_EQ = prove_thm (`EQ_MONO_ADD_EQ`, "!m n p. ((m + p) = (n + p)) = (m = n)", GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES;INV_SUC_EQ]);; let LESS_EQ_MONO_ADD_EQ = prove_thm (`LESS_EQ_MONO_ADD_EQ`, "!m n p. ((m + p) <= (n + p)) = (m <= n)", REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[LESS_MONO_ADD_EQ;EQ_MONO_ADD_EQ]);; let LESS_EQ_TRANS = prove_thm (`LESS_EQ_TRANS`, "!m n p. (m <= n) /\ (n <= p) ==> (m <= p)", REWRITE_TAC[LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_TRANS THEN ASM_REWRITE_TAC[] THEN SUBST_TAC[SYM(ASSUME "n:num = p")] THEN ASM_REWRITE_TAC[]);; % Proof modified for new IMP_RES_TAC [TFM 90.04.25] % let LESS_EQ_LESS_EQ_MONO = prove_thm (`LESS_EQ_LESS_EQ_MONO`, "!m n p q. (m <= p) /\ (n <= q) ==> ((m + n) <= (p + q))", REPEAT STRIP_TAC THEN let th1 = snd(EQ_IMP_RULE (SPEC_ALL LESS_EQ_MONO_ADD_EQ)) in let th2 = PURE_ONCE_REWRITE_RULE [ADD_SYM] th1 in IMP_RES_THEN (ASSUME_TAC o SPEC "n:num") th1 THEN IMP_RES_THEN (ASSUME_TAC o SPEC "p:num") th2 THEN IMP_RES_TAC LESS_EQ_TRANS);; let LESS_EQ_REFL = prove_thm (`LESS_EQ_REFL`, "!m. m <= m", GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ]);; let LESS_IMP_LESS_OR_EQ = prove_thm (`LESS_IMP_LESS_OR_EQ`, "!m n. (m < n) ==> (m <= n)", REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LESS_OR_EQ]);; let LESS_MONO_MULT = prove_thm (`LESS_MONO_MULT`, "!m n p. (m <= n) ==> ((m * p) <= (n * p))", GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC [ADD_CLAUSES;MULT_CLAUSES;LESS_EQ_MONO_ADD_EQ;LESS_EQ_REFL] THEN RES_TAC THEN IMP_RES_TAC(SPECL["m:num";"m*p";"n:num";"n*p"]LESS_EQ_LESS_EQ_MONO) THEN ASM_REWRITE_TAC[]);; % Proof modified for new IMP_RES_TAC [TFM 90.04.25] % let RIGHT_SUB_DISTRIB = prove_thm (`RIGHT_SUB_DISTRIB`, "!m n p. (m - n) * p = (m * p) - (n * p)", REPEAT GEN_TAC THEN ASM_CASES_TAC "n <= m" THENL [let imp = SPECL ["(m-n)*p";"n*p";"m*p"] ADD_EQ_SUB in IMP_RES_THEN (SUBST1_TAC o SYM o MP imp o SPEC "p:num")LESS_MONO_MULT THEN REWRITE_TAC[SYM(SPEC_ALL RIGHT_ADD_DISTRIB)] THEN IMP_RES_THEN SUBST1_TAC SUB_ADD THEN REFL_TAC; IMP_RES_TAC (REWRITE_RULE[](AP_TERM "$~" (SPEC_ALL NOT_LESS))) THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_THEN (ASSUME_TAC o SPEC "p:num") LESS_MONO_MULT THEN IMP_RES_TAC SUB_EQ_0 THEN ASM_REWRITE_TAC[MULT_CLAUSES]]);; % --------------------------------------------------------------------- % % Theorem moved from the `more_arithmetic' library [RJB 92.10.08] % % --------------------------------------------------------------------- % let LEFT_SUB_DISTRIB = prove_thm (`LEFT_SUB_DISTRIB`, "!m n p. p * (m - n) = (p * m) - (p * n)", PURE_ONCE_REWRITE_TAC [MULT_SYM] THEN REWRITE_TAC [RIGHT_SUB_DISTRIB]);; % --------------------------------------------------------------------- % % The theorem below (and proof) are from tfm. [rewritten TFM 90.09.21] % % --------------------------------------------------------------------- % let LESS_ADD_1 = prove_thm (`LESS_ADD_1`, "!m n. (n ?p. m = n + p + 1", CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0;LESS_THM] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "0" THEN ASM_REWRITE_TAC [ADD_CLAUSES]; RES_THEN (STRIP_THM_THEN SUBST1_TAC) THEN EXISTS_TAC "SUC p" THEN REWRITE_TAC [ADD_CLAUSES]]);; % --------------------------------------------------------------------- % % The following arithmetic theorems were added by TFM in 88.03.31 % % % % These are needed to build the recursive type definition package % % --------------------------------------------------------------------- % let EXP_ADD = prove_thm (`EXP_ADD`, "!p q n. n EXP (p+q) = (n EXP p) * (n EXP q)", INDUCT_TAC THEN ASM_REWRITE_TAC [EXP;ADD_CLAUSES;MULT_CLAUSES;MULT_ASSOC]);; let NOT_ODD_EQ_EVEN = prove_thm (`NOT_ODD_EQ_EVEN`, "!n m. ~(SUC(n + n) = (m + m))", REPEAT (INDUCT_TAC THEN REWRITE_TAC [ADD_CLAUSES]) THENL [MATCH_ACCEPT_TAC NOT_SUC; REWRITE_TAC [INV_SUC_EQ;NOT_EQ_SYM (SPEC_ALL NOT_SUC)]; REWRITE_TAC [INV_SUC_EQ;NOT_SUC]; ASM_REWRITE_TAC [INV_SUC_EQ]]);; let MULT_SUC_EQ = prove_thm (`MULT_SUC_EQ`, "!p m n. ((n * (SUC p)) = (m * (SUC p))) = (n = m)", REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (REWRITE_RULE [LESS_OR_EQ] (SPEC_ALL LESS_CASES)) THEN ASM_REWRITE_TAC [] THENL [ALL_TAC;ONCE_REWRITE_TAC [INST_TYPE [":num",":*"] EQ_SYM_EQ] THEN POP_ASSUM MP_TAC THEN (MAP_EVERY SPEC_TAC ["m:num","m:num";"n:num","n:num"])THEN MAP_EVERY X_GEN_TAC ["m:num";"n:num"] THEN DISCH_TAC] THEN IMP_RES_THEN (\th. REWRITE_TAC [NOT_EQ_SYM th]) LESS_NOT_EQ THEN POP_ASSUM (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC [MULT_CLAUSES;SYM(SPEC_ALL ADD_ASSOC)] THEN ONCE_REWRITE_TAC [ADD_SYM] THEN REWRITE_TAC [EQ_MONO_ADD_EQ] THEN REWRITE_TAC [RIGHT_ADD_DISTRIB;MULT_CLAUSES] THEN ONCE_REWRITE_TAC [SPEC "p * q" ADD_SYM] THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN REWRITE_TAC [ADD_ASSOC; REWRITE_RULE [ADD_CLAUSES] (SPEC "0" EQ_MONO_ADD_EQ)] THEN ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN REWRITE_TAC [num_CONV "1";ADD_CLAUSES;NOT_SUC]);; let MULT_EXP_MONO = prove_thm (`MULT_EXP_MONO`, "!p q n m.((n * ((SUC q) EXP p)) = (m * ((SUC q) EXP p))) = (n = m)", INDUCT_TAC THENL [REWRITE_TAC [EXP;MULT_CLAUSES;ADD_CLAUSES]; ASM_REWRITE_TAC [EXP;MULT_ASSOC;MULT_SUC_EQ]]);; let LESS_EQUAL_ANTISYM = prove_thm (`LESS_EQUAL_ANTISYM`, "!n m. n <= m /\ m <= n ==> (n = m)", REWRITE_TAC [LESS_OR_EQ] THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC LESS_ANTISYM; ASM_REWRITE_TAC[]]);; let LESS_ADD_SUC = prove_thm (`LESS_ADD_SUC`, "!m n. m < m + SUC n", INDUCT_TAC THENL [REWRITE_TAC [LESS_0;ADD_CLAUSES]; POP_ASSUM (ASSUME_TAC o REWRITE_RULE [ADD_CLAUSES]) THEN ASM_REWRITE_TAC [LESS_MONO_EQ;ADD_CLAUSES]]);; let ZERO_LESS_EQ = prove_thm (`ZERO_LESS_EQ`, "!n. 0 <= n", GEN_TAC THEN REPEAT_TCL STRIP_THM_THEN SUBST1_TAC (SPEC "n:num" num_CASES) THEN REWRITE_TAC [LESS_0;LESS_OR_EQ]);; let LESS_EQ_MONO = prove_thm (`LESS_EQ_MONO`, "!n m. (SUC n <= SUC m) = (n <= m)", REWRITE_TAC [LESS_OR_EQ;LESS_MONO_EQ;INV_SUC_EQ]);; % Following proof revised for version 1.12 resolution. [TFM 91.01.18] % let LESS_OR_EQ_ADD = prove_thm (`LESS_OR_EQ_ADD`, "!n m. n < m \/ ?p. n = p+m", REPEAT GEN_TAC THEN ASM_CASES_TAC "n (?n. P n /\ (!m. m < n ==> ~P m)) % % % % I.e. considering P to be a set, that is the set of numbers, x , such % % that P(x), then every non-empty P has a smallest element. % % ===================================================================== % % --------------------------------------------------------------------- % % We first prove that, if there does NOT exist a smallest n such that % % P(n) is true, then for all n P is false of all numbers smaller than n.% % The main step is an induction on n. % % --------------------------------------------------------------------- % let lemma = TAC_PROOF(([], "(~?n. P(n) /\ (!m. m ~P(m))) ==> (!n m. m ~P(m))"), CONV_TAC (DEPTH_CONV NOT_EXISTS_CONV) THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC [NOT_LESS_0;LESS_THM] THEN REPEAT (FILTER_STRIP_TAC "P:num->bool") THENL [POP_ASSUM SUBST1_TAC THEN DISCH_TAC;ALL_TAC] THEN RES_TAC);; % --------------------------------------------------------------------- % % We now prove the well ordering property. % % --------------------------------------------------------------------- % let WOP = prove_thm(`WOP`, "!P. (?n.P(n)) ==> (?n. P(n) /\ (!m. m ~P(m)))", GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN (ASSUME_TAC o MP lemma) THEN CONV_TAC NOT_EXISTS_CONV THEN GEN_TAC THEN POP_ASSUM (MATCH_MP_TAC o SPECL ["SUC n";"n:num"]) THEN MATCH_ACCEPT_TAC LESS_SUC_REFL);; % ===================================================================== % % Added TFM 90.05.24 % % % % Prove the division algorithm: % % % % |- !k n. (n>0) ==> ?q r. k=qn+r /\ 0<=r (!q. ~(k=q*n+y))) % % --------------------------------------------------------------------- % let smallest_lemma = CONV_RULE (DEPTH_CONV NOT_EXISTS_CONV) (MATCH_MP (CONV_RULE (DEPTH_CONV BETA_CONV) (SPEC "\r.?q.k=(q*n)+r" WOP)) exists_lemma);; % We will need the lemma |- !m n. n <= m ==> (?p. m = n + p) % let leq_add_lemma = TAC_PROOF(([],"!m n. (n<=m) ==> ?p.m=n+p"), REWRITE_TAC [LESS_OR_EQ] THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM (STRIP_ASSUME_TAC o MATCH_MP LESS_ADD_1) THEN EXISTS_TAC "p+1" THEN FIRST_ASSUM ACCEPT_TAC; EXISTS_TAC "0" THEN ASM_REWRITE_TAC [ADD_CLAUSES]]);; % We will also need the lemma: |- k=qn+n+p ==> k=(q+1)*n+p % let k_expr_lemma = TAC_PROOF(([], "(k=(q*n)+n+p) ==> (k=((q+1)*n)+p)"), REWRITE_TAC [RIGHT_ADD_DISTRIB;MULT_CLAUSES;ADD_ASSOC]);; % We will also need the lemma: [0 ?r q. (k=(q*n)+r) /\ r !k.?q.(k=((q * n)+(MOD k n))) /\ ((MOD k n) < n)"), EXISTS_TAC "\k n. @r. ?q. (k = (q * n) + r) /\ r < n" THEN REPEAT STRIP_TAC THEN IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC "k:num") DA THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN CONV_TAC SELECT_CONV THEN MAP_EVERY EXISTS_TAC ["r:num";"q:num"] THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC);; % Now, prove the existence of MOD and DIV. % let MOD_DIV_exist = TAC_PROOF( ([], "?MOD DIV. !n.(0 < n) ==> !k.((k = (((DIV k n) * n) + (MOD k n))) /\ ((MOD k n) < n))"), STRIP_ASSUME_TAC MOD_exists THEN EXISTS_TAC "MOD:num->num->num" THEN EXISTS_TAC "\k n. @q. (k = (q * n) + (MOD k n))" THEN REPEAT STRIP_TAC THENL [CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN CONV_TAC SELECT_CONV THEN RES_THEN (STRIP_ASSUME_TAC o SPEC "k:num") THEN EXISTS_TAC "q:num" THEN FIRST_ASSUM ACCEPT_TAC; RES_THEN (STRIP_ASSUME_TAC o SPEC "k:num")]);; % Now define MOD and DIV by a constant specification. % let DIVISION = new_specification `DIVISION` [`infix`,`MOD`;`infix`,`DIV`] MOD_DIV_exist;; close_theory();; % --------------------------------------------------------------------- % % Properties of MOD and DIV that don't depend on uniqueness. % % --------------------------------------------------------------------- % let MOD_ONE = prove_thm (`MOD_ONE`, "!k. (k MOD (SUC 0)) = 0", STRIP_TAC THEN let th = REWRITE_RULE [LESS_SUC_REFL] (SPEC "SUC 0" DIVISION) in MP_TAC (CONJUNCT2 (SPEC "k:num" th)) THEN REWRITE_TAC [LESS_THM;NOT_LESS_0]);; let DIV_LESS_EQ = prove_thm (`DIV_LESS_EQ`, "!n. (0 < n) ==> !k. (k DIV n) <= k", REPEAT STRIP_TAC THEN IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC "k:num") DIVISION THEN FIRST_ASSUM (\th. \g. SUBST_OCCS_TAC [[2],th] g) THEN REPEAT_TCL STRIP_THM_THEN MP_TAC (SPEC "n:num" num_CASES) THENL [IMP_RES_TAC LESS_NOT_EQ THEN DISCH_THEN (ASSUME_TAC o SYM) THEN RES_TAC; DISCH_THEN (\th. SUBST_OCCS_TAC [[3],th]) THEN REWRITE_TAC [MULT_CLAUSES] THEN REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN MATCH_ACCEPT_TAC LESS_EQ_ADD]);; % --------------------------------------------------------------------- % % Now, show that the quotient and remainder are unique. % % % % NB: the beastly proof given below of DIV_UNIQUE is definitely NOT % % good HOL style. % % --------------------------------------------------------------------- % let DIV_UNIQUE = prove_thm (`DIV_UNIQUE`, "!n k q. (?r. (k = (q * n) + r) /\ (r < n)) ==> ((k DIV n) = q)", REPEAT GEN_TAC THEN DISCH_THEN (CHOOSE_THEN (CONJUNCTS_THEN2 MP_TAC (STRIP_THM_THEN SUBST_ALL_TAC o MATCH_MP LESS_ADD_1))) THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES] THEN let eq,ls = CONJ_PAIR (SPEC "k:num" (REWRITE_RULE [LESS_0] (SPEC "SUC(r + p)" DIVISION))) in DISCH_THEN (\th1. MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL NOT_LESS)] THEN CONJ_TAC THEN DISCH_THEN \th2. MP_TAC (TRANS (SYM eq) th1) THEN STRIP_THM_THEN SUBST_ALL_TAC (MATCH_MP LESS_ADD_1 th2)) THEN REWRITE_TAC [LEFT_ADD_DISTRIB;RIGHT_ADD_DISTRIB;MULT_CLAUSES] THEN REWRITE_TAC [SYM (SPEC_ALL ADD_ASSOC)] THEN REWRITE_TAC [PURE_ONCE_REWRITE_RULE [ADD_SYM] EQ_MONO_ADD_EQ] THENL [PURE_ONCE_REWRITE_TAC [SPEC "SUC(r+p)" ADD_SYM] THEN SUBST1_TAC (SPECL ["r:num";"p:num"] ADD_SYM) THEN REWRITE_TAC [SYM(el 3 (CONJUNCTS (ADD_CLAUSES)));ADD_ASSOC] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN DISCH_THEN (MP_TAC o MATCH_MP ADD_INV_0) THEN REWRITE_TAC [ADD_CLAUSES;NOT_SUC]; let conv = (REWR_CONV ADD_SYM) THENC RATOR_CONV(RAND_CONV(REWR_CONV ADD_SYM)) in CONV_TAC (ONCE_DEPTH_CONV (RAND_CONV conv)) THEN REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN REWRITE_TAC [PURE_ONCE_REWRITE_RULE [ADD_SYM] EQ_MONO_ADD_EQ] THEN REWRITE_TAC [ADD_ASSOC] THEN CONV_TAC (ONCE_DEPTH_CONV (RAND_CONV (REWR_CONV ADD_SYM))) THEN REWRITE_TAC [SYM(SPEC_ALL (ADD_ASSOC))] THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN PURE_ONCE_REWRITE_TAC [el 2 (CONJUNCTS ADD_CLAUSES)] THEN PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN SUBST1_TAC (SPECL ["p:num";"r:num"] ADD_SYM) THEN let th1 = MATCH_MP LESS_ADD_1 ls in let th2 = ONCE_REWRITE_RULE [SPEC "n MOD m" ADD_SYM] th1 in STRIP_THM_THEN (\th. SUBST_OCCS_TAC [[2],th]) th2 THEN REWRITE_TAC [ADD_ASSOC] THEN let th3 = PURE_ONCE_REWRITE_RULE [ADD_SYM] ADD_INV_0 in DISCH_THEN (MP_TAC o MATCH_MP th3 o SYM) THEN REWRITE_TAC [num_CONV "1"; ADD_CLAUSES; NOT_SUC]]);; % NB: this lemma is strictly local to this file. % let lemma = TAC_PROOF( ([], "!n k q r. ((k = (q * n) + r) /\ r < n) ==> (k DIV n = q)"), REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQUE THEN EXISTS_TAC "r:num" THEN ASM_REWRITE_TAC []);; let MOD_UNIQUE = prove_thm (`MOD_UNIQUE`, "!n k r. (?q. (k = (q * n) + r) /\ r < n) ==> (k MOD n = r)", REPEAT STRIP_TAC THEN MP_TAC (DISCH_ALL (SPEC "k:num" (UNDISCH (SPEC "n:num" DIVISION)))) THEN FIRST_ASSUM (\th g. let thm = MATCH_MP LESS_ADD_1 th in let tcl t = (SUBST_OCCS_TAC [[1],t]) in STRIP_THM_THEN tcl thm g) THEN REWRITE_TAC [LESS_0;num_CONV "1";ADD_CLAUSES] THEN IMP_RES_THEN (IMP_RES_THEN SUBST1_TAC) lemma THEN FIRST_ASSUM (\th g. SUBST_OCCS_TAC [[1],th] g) THEN let th = PURE_ONCE_REWRITE_RULE [ADD_SYM] EQ_MONO_ADD_EQ in PURE_ONCE_REWRITE_TAC [th] THEN DISCH_THEN (STRIP_THM_THEN \th g. ACCEPT_TAC (SYM th) g));; % --------------------------------------------------------------------- % % Properties of MOD and DIV proved using uniqueness. % % --------------------------------------------------------------------- % let DIV_MULT = prove_thm (`DIV_MULT`, "!n r. r < n ==> !q. (((q * n) + r) DIV n = q)", REPEAT GEN_TAC THEN REPEAT_TCL STRIP_THM_THEN SUBST1_TAC (SPEC "n:num" num_CASES) THENL [REWRITE_TAC [NOT_LESS_0]; REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQUE THEN EXISTS_TAC "r:num" THEN ASM_REWRITE_TAC []]);; let LESS_MOD = prove_thm (`LESS_MOD`, "!n k. k < n ==> ((k MOD n) = k)", REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQUE THEN EXISTS_TAC "0" THEN ASM_REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES]);; let MOD_EQ_0 = prove_thm (`MOD_EQ_0`, "!n. (0 < n) ==> !k. ((k * n) MOD n) = 0", REPEAT STRIP_TAC THEN IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC "k * n") DIVISION THEN MATCH_MP_TAC MOD_UNIQUE THEN EXISTS_TAC "k:num" THEN CONJ_TAC THENL [REWRITE_TAC [ADD_CLAUSES]; FIRST_ASSUM ACCEPT_TAC]);; let ZERO_MOD = prove_thm (`ZERO_MOD`, "!n. (0 < n) ==> ((0 MOD n) = 0)", REPEAT STRIP_TAC THEN IMP_RES_THEN (MP_TAC o SPEC "0") MOD_EQ_0 THEN REWRITE_TAC [MULT_CLAUSES]);; let ZERO_DIV = prove_thm (`ZERO_DIV`, "!n. 0 < n ==> ((0 DIV n) = 0)", REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQUE THEN EXISTS_TAC "0" THEN ASM_REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES]);; let MOD_MULT = prove_thm (`MOD_MULT`, "!n r. r < n ==> !q. (((q * n) + r) MOD n) = r", REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQUE THEN EXISTS_TAC "q:num" THEN ASM_REWRITE_TAC [ADD_CLAUSES;MULT_CLAUSES]);; let MOD_TIMES = prove_thm (`MOD_TIMES`, "!n. (0 < n) ==> !q r. (((q * n) + r) MOD n) = (r MOD n)", let SUBS th = SUBST_OCCS_TAC [[1],th] in REPEAT STRIP_TAC THEN IMP_RES_THEN (TRY o SUBS o SPEC "r:num") DIVISION THEN REWRITE_TAC [ADD_ASSOC;SYM(SPEC_ALL RIGHT_ADD_DISTRIB)] THEN IMP_RES_THEN (ASSUME_TAC o SPEC "r:num") DIVISION THEN IMP_RES_TAC MOD_MULT THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let MOD_PLUS = prove_thm (`MOD_PLUS`, "!n. (0 < n) ==> !j k. (((j MOD n) + (k MOD n)) MOD n) = ((j+k) MOD n)", let SUBS th = SUBST_OCCS_TAC [[2],th] in REPEAT STRIP_TAC THEN IMP_RES_TAC MOD_TIMES THEN IMP_RES_THEN (TRY o SUBS o SPEC "j:num") DIVISION THEN ASM_REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN IMP_RES_THEN (TRY o SUBS o SPEC "k:num") DIVISION THEN ASM_REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)]);; let MOD_MOD = prove_thm (`MOD_MOD`, "!n. (0 < n) ==> (!k. (k MOD n) MOD n = (k MOD n))", REPEAT STRIP_TAC THEN MATCH_MP_TAC LESS_MOD THEN IMP_RES_THEN (STRIP_ASSUME_TAC o SPEC "k:num") DIVISION);; % --------------------------------------------------------------------- % % Some more theorems, mostly about subtraction. % % --------------------------------------------------------------------- % let SUB_MONO_EQ = prove_thm (`SUB_MONO_EQ`, "!n m. (SUC n) - (SUC m) = (n - m)", INDUCT_TAC THENL [REWRITE_TAC [SUB;LESS_0];ASM_REWRITE_TAC [SUB;LESS_MONO_EQ]]);; % SUB_RIGHT_SUB is the symmetric version of this theorem [RJB 92.09.29] % let SUB_PLUS = prove_thm (`SUB_PLUS`, "!a b c. a - (b + c) = (a - b) - c", REPEAT INDUCT_TAC THEN REWRITE_TAC [SUB_0;ADD_CLAUSES;SUB_MONO_EQ] THEN PURE_ONCE_REWRITE_TAC [SYM (el 4 (CONJUNCTS ADD_CLAUSES))] THEN PURE_ONCE_ASM_REWRITE_TAC [] THEN REFL_TAC);; % --------------------------------------------------------------------- % % Theorem modified : TFM/BTG 91.09.02 % % % % let INV_PRE_LESS = % % prove_thm % % (`INV_PRE_LESS`, % % "!m n. 0 < m /\ 0 < n ==> ((PRE m < PRE n) = (m < n))", % % REPEAT INDUCT_TAC THEN % % REWRITE_TAC[LESS_REFL;SUB;LESS_0;PRE] THEN % % MATCH_ACCEPT_TAC (SYM(SPEC_ALL LESS_MONO_EQ)));; % % --------------------------------------------------------------------- % let INV_PRE_LESS = prove_thm (`INV_PRE_LESS`, "!m. 0 < m ==> !n. ((PRE m < PRE n) = (m < n))", REPEAT (INDUCT_TAC THEN TRY DISCH_TAC) THEN REWRITE_TAC[LESS_REFL;SUB;LESS_0;PRE;NOT_LESS_0] THEN IMP_RES_TAC LESS_REFL THEN MATCH_ACCEPT_TAC (SYM(SPEC_ALL LESS_MONO_EQ)));; let INV_PRE_LESS_EQ = prove_thm (`INV_PRE_LESS_EQ`, "!n. 0 < n ==> !m. ((PRE m <= PRE n) = (m <= n))", INDUCT_TAC THEN REWRITE_TAC [LESS_REFL;LESS_0;PRE] THEN INDUCT_TAC THEN REWRITE_TAC [PRE;ZERO_LESS_EQ] THEN REWRITE_TAC [ADD1;LESS_EQ_MONO_ADD_EQ]);; let SUB_LESS_EQ = prove_thm (`SUB_LESS_EQ`, "!n m. (n - m) <= n", REWRITE_TAC [SYM(SPEC_ALL SUB_EQ_0);SYM(SPEC_ALL SUB_PLUS)] THEN CONV_TAC (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM)) THEN REWRITE_TAC [SUB_EQ_0;LESS_EQ_ADD]);; let SUB_EQ_EQ_0 = prove_thm (`SUB_EQ_EQ_0`, "!m n. (m - n = m) = ((m = 0) \/ (n = 0))", REPEAT INDUCT_TAC THEN REWRITE_TAC [SUB_0;NOT_SUC] THEN REWRITE_TAC [SUB] THEN ASM_CASES_TAC "m n <= (m - 1)", REPEAT GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC [SYM (SPEC_ALL PRE_SUB1)] THEN REWRITE_TAC [PRE;num_CONV "1";ADD_CLAUSES;LESS_EQ_ADD]);; let LESS_SUB_ADD_LESS = prove_thm (`LESS_SUB_ADD_LESS`, "!n m i. (i < (n - m)) ==> ((i + m) < n)", INDUCT_TAC THENL [REWRITE_TAC [SUB_0;NOT_LESS_0]; REWRITE_TAC [SUB] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC "n < m" THEN ASM_REWRITE_TAC [NOT_LESS_0;LESS_THM] THEN let tac th g = SUBST1_TAC th g ? ASSUME_TAC th g in DISCH_THEN (STRIP_THM_THEN tac) THENL [DISJ1_TAC THEN MATCH_MP_TAC SUB_ADD THEN ASM_REWRITE_TAC [SYM(SPEC_ALL NOT_LESS)]; RES_TAC THEN ASM_REWRITE_TAC[]]]);; let TIMES2 = prove_thm (`TIMES2`, "!n. 2 * n = n + n", CONV_TAC (REDEPTH_CONV num_CONV) THEN PURE_REWRITE_TAC [MULT_CLAUSES] THEN INDUCT_TAC THEN ASM_REWRITE_TAC [ADD_CLAUSES]);; let LESS_MULT_MONO = prove_thm (`LESS_MULT_MONO`, "!m i n. ((SUC n) * m) < ((SUC n) * i) = (m < i)", REWRITE_TAC [MULT_CLAUSES] THEN INDUCT_TAC THENL [INDUCT_TAC THEN REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES;LESS_0]; INDUCT_TAC THENL [REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES;NOT_LESS_0]; INDUCT_TAC THENL [REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES]; REWRITE_TAC [LESS_MONO_EQ;ADD_CLAUSES;MULT_CLAUSES] THEN REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN REWRITE_TAC [LESS_MONO_ADD_EQ] THEN REWRITE_TAC [ADD_ASSOC] THEN let th = SYM(el 5 (CONJUNCTS(SPEC_ALL MULT_CLAUSES))) in PURE_ONCE_REWRITE_TAC [th] THEN ASM_REWRITE_TAC[]]]]);; let MULT_MONO_EQ = prove_thm (`MULT_MONO_EQ`, "!m i n. (((SUC n) * m) = ((SUC n) * i)) = (m = i)", REWRITE_TAC [MULT_CLAUSES] THEN INDUCT_TAC THENL [INDUCT_TAC THEN REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES; NOT_EQ_SYM(SPEC_ALL NOT_SUC)]; INDUCT_TAC THENL [REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES;NOT_SUC]; INDUCT_TAC THENL [REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES]; REWRITE_TAC [INV_SUC_EQ;ADD_CLAUSES;MULT_CLAUSES] THEN REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC)] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN REWRITE_TAC [EQ_MONO_ADD_EQ] THEN REWRITE_TAC [ADD_ASSOC] THEN let th = SYM(el 5 (CONJUNCTS(SPEC_ALL MULT_CLAUSES))) in PURE_ONCE_REWRITE_TAC [th] THEN ASM_REWRITE_TAC[]]]]);; let ADD_SUB = prove_thm (`ADD_SUB`, "!a c. (a + c) - c = a", INDUCT_TAC THEN REWRITE_TAC [ADD_CLAUSES] THENL [INDUCT_TAC THEN REWRITE_TAC [SUB;LESS_SUC_REFL]; ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL NOT_LESS)] LESS_EQ_ADD) THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN ASM_REWRITE_TAC [SUB;INV_SUC_EQ] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN FIRST_ASSUM ACCEPT_TAC]);; let LESS_EQ_ADD_SUB = prove_thm (`LESS_EQ_ADD_SUB`, "!c b. (c <= b) ==> !a. (((a + b) - c) = (a + (b - c)))", PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN REPEAT GEN_TAC THEN let tac th g = SUBST1_TAC th g ? MP_TAC th g in DISCH_THEN (STRIP_THM_THEN tac) THENL [DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN SUBST1_TAC (SPECL ["c:num";"p + (SUC 0)"] ADD_SYM) THEN REWRITE_TAC [ADD_ASSOC;ADD_SUB]; GEN_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC [ADD_SUB;ADD_INV_0_EQ;SUB_EQ_0;LESS_EQ_REFL]]);; % --------------------------------------------------------------------- % % SUB_EQUAL_0 = |- !c. c - c = 0 % % --------------------------------------------------------------------- % let SUB_EQUAL_0 = save_thm (`SUB_EQUAL_0`, REWRITE_RULE [ADD_CLAUSES] (SPEC "0" ADD_SUB));; let LESS_EQ_SUB_LESS = prove_thm (`LESS_EQ_SUB_LESS`, "!a b. (b <= a) ==> !c. ((a - b) < c) = (a < (b + c))", PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN REPEAT GEN_TAC THEN let tac th g = SUBST1_TAC th g ? MP_TAC th g in DISCH_THEN (STRIP_THM_THEN tac) THENL [DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN GEN_TAC THEN SUBST1_TAC (SPECL ["b:num";"p + (SUC 0)"] ADD_SYM) THEN SUBST1_TAC (SPECL ["b:num";"c:num"] ADD_SYM) THEN REWRITE_TAC [ADD_SUB;LESS_MONO_ADD_EQ]; REWRITE_TAC [SUB_EQUAL_0] THEN GEN_TAC THEN REPEAT_TCL STRIP_THM_THEN SUBST1_TAC (SPEC "c:num" num_CASES) THEN REWRITE_TAC [ADD_CLAUSES;LESS_REFL;LESS_0;LESS_ADD_SUC]]);; let NOT_SUC_LESS_EQ = prove_thm (`NOT_SUC_LESS_EQ`, "!n m.(~(SUC n) <= m) = (m <= n)", REWRITE_TAC [SYM (SPEC_ALL LESS_EQ);NOT_LESS]);; let SUB_SUB = prove_thm (`SUB_SUB`, "!b c. (c <= b) ==> !a. ((a - (b - c)) = ((a + c) - b))", PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN REPEAT GEN_TAC THEN let tac th g = SUBST1_TAC th g ? MP_TAC th g in DISCH_THEN (STRIP_THM_THEN tac) THENL [DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN SUBST_OCCS_TAC [[1],(SPECL ["c:num";"p + (SUC 0)"] ADD_SYM)] THEN REWRITE_TAC [ADD_SUB] THEN REWRITE_TAC [SUB_PLUS;ADD_SUB]; REWRITE_TAC [SUB_EQUAL_0] THEN REWRITE_TAC [ADD_SUB;SUB_0]]);; let LESS_IMP_LESS_ADD = prove_thm (`LESS_IMP_LESS_ADD`, "!n m. n < m ==> !p. n < (m + p)", REPEAT GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC [SYM(SPEC_ALL ADD_ASSOC);num_CONV "1"] THEN PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN GEN_TAC THEN MATCH_ACCEPT_TAC LESS_ADD_SUC);; let LESS_EQ_IMP_LESS_SUC = prove_thm (`LESS_EQ_IMP_LESS_SUC`, "!n m. (n <= m) ==> (n < (SUC m))", REWRITE_TAC [LESS_OR_EQ] THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC LESS_SUC; ASM_REWRITE_TAC [LESS_SUC_REFL]]);; % This theorem could be strengthened; see SUB_RIGHT_LESS_EQ [RJB 92.09.29] % let SUB_LESS_EQ_ADD = prove_thm (`SUB_LESS_EQ_ADD`, "!m p. (m <= p) ==> !n. (((p - m) <= n) = (p <= (m + n)))", REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_EQ_SUB_LESS THEN IMP_RES_TAC (SPEC "n:num" ADD_EQ_SUB) THEN ASM_REWRITE_TAC [LESS_OR_EQ] THEN SUBST_OCCS_TAC [[3], SPECL ["m:num";"n:num"] ADD_SYM] THEN CONV_TAC (RAND_CONV (ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_REWRITE_TAC [] THEN CONV_TAC (RAND_CONV (ONCE_DEPTH_CONV SYM_CONV)) THEN REFL_TAC);; let SUB_CANCEL = prove_thm (`SUB_CANCEL`, "!p n m. ((n <= p) /\ (m <= p)) ==> (((p - n) = (p - m)) = (n = m))", REWRITE_TAC [LESS_OR_EQ] THEN REPEAT GEN_TAC THEN let tac th g = SUBST1_TAC th g ? MP_TAC th g in DISCH_THEN (REPEAT_TCL STRIP_THM_THEN tac) THENL [DISCH_THEN (STRIP_THM_THEN SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN SUBST_OCCS_TAC [[3], SPECL ["m:num";"p'+1"] ADD_SYM] THEN REWRITE_TAC [ADD_SUB] THEN DISCH_TAC THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_TAC (CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) ADD_EQ_SUB) THEN CONV_TAC (RATOR_CONV(RAND_CONV SYM_CONV)) THEN SUBST1_TAC (SPECL ["p'+1";"m:num"] ADD_SYM) THEN ASM_REWRITE_TAC [] THEN SUBST1_TAC (SPECL ["m:num";"p'+1"] ADD_SYM) THEN PURE_ONCE_REWRITE_TAC [ADD_SUB] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN MATCH_ACCEPT_TAC EQ_MONO_ADD_EQ; REWRITE_TAC [SUB_EQUAL_0;SUB_EQ_0] THEN DISCH_TAC THEN ASM_REWRITE_TAC [SYM(SPEC_ALL NOT_LESS)] THEN IMP_RES_TAC LESS_NOT_EQ; PURE_ONCE_REWRITE_TAC [SUB_EQUAL_0] THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC [ADD_INV_0_EQ] THEN SUBST1_TAC (SPECL ["m:num";"p'+1"] ADD_SYM) THEN REWRITE_TAC [ADD_SUB] THEN MATCH_ACCEPT_TAC EQ_SYM_EQ; REWRITE_TAC []]);; let CANCEL_SUB = prove_thm (`CANCEL_SUB`, "!p n m.((p <= n) /\ (p <= m)) ==> (((n - p) = (m - p)) = (n = m))", REWRITE_TAC [LESS_OR_EQ] THEN REPEAT GEN_TAC THEN let tac th g = SUBST1_TAC th g ? MP_TAC th g in DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN DISCH_THEN (STRIP_THM_THEN tac) THENL [DISCH_THEN \th1. DISCH_THEN \th2. (MP_TAC th1 THEN STRIP_THM_THEN tac th2) THENL [REPEAT(DISCH_THEN(STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1))THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN REWRITE_TAC [ADD_SUB;EQ_MONO_ADD_EQ]; DISCH_TAC THEN CONV_TAC (RATOR_CONV(RAND_CONV SYM_CONV)) THEN REWRITE_TAC [SUB_EQUAL_0;SUB_EQ_0] THEN IMP_RES_TAC LESS_NOT_EQ THEN ASM_REWRITE_TAC [SYM(SPEC_ALL NOT_LESS)]]; DISCH_THEN (STRIP_THM_THEN tac) THENL [DISCH_TAC THEN CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC [SUB_EQUAL_0;SUB_EQ_0] THEN IMP_RES_TAC LESS_NOT_EQ THEN ASM_REWRITE_TAC [SYM(SPEC_ALL NOT_LESS)]; REWRITE_TAC[]]]);; let NOT_EXP_0 = prove_thm (`NOT_EXP_0`, "!m n. ~(((SUC n) EXP m) = 0)", INDUCT_TAC THEN REWRITE_TAC [EXP] THENL [CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC [NOT_SUC]; STRIP_TAC THEN let th = (SYM(el 2 (CONJUNCTS (SPECL ["SUC n";"1"] MULT_CLAUSES)))) in SUBST1_TAC th THEN REWRITE_TAC [MULT_MONO_EQ] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let ZERO_LESS_EXP = prove_thm (`ZERO_LESS_EXP`, "!m n. 0 < ((SUC n) EXP m)", REPEAT STRIP_TAC THEN let th = SPEC "(SUC n) EXP m" LESS_0_CASES in let tac th g = ASSUME_TAC (SYM th) g ? ACCEPT_TAC th g in STRIP_THM_THEN tac th THEN IMP_RES_TAC NOT_EXP_0);; let ODD_OR_EVEN = prove_thm (`ODD_OR_EVEN`, "!n. ?m. (n = (SUC(SUC 0) * m)) \/ (n = ((SUC(SUC 0) * m) + 1))", CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN INDUCT_THEN INDUCTION STRIP_ASSUME_TAC THENL [EXISTS_TAC "0" THEN REWRITE_TAC [ADD_CLAUSES;MULT_CLAUSES]; EXISTS_TAC "m:num" THEN ASM_REWRITE_TAC[ADD_CLAUSES]; EXISTS_TAC "SUC m" THEN ASM_REWRITE_TAC[MULT_CLAUSES;ADD_CLAUSES]]);; let LESS_EXP_SUC_MONO = prove_thm (`LESS_EXP_SUC_MONO`, "!n m.((SUC(SUC m)) EXP n) < ((SUC(SUC m)) EXP (SUC n))", INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC [EXP] THENL [REWRITE_TAC [EXP;ADD_CLAUSES;MULT_CLAUSES] THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC [ADD_CLAUSES;LESS_MONO_EQ;LESS_0]; ASM_REWRITE_TAC [LESS_MULT_MONO]]);; %----------------------------------------------------------------------------% % More arithmetic theorems, mainly concerning orderings [JRH 92.07.14] % %----------------------------------------------------------------------------% let LESS_LESS_CASES = prove_thm(`LESS_LESS_CASES`, "!m n. (m = n) \/ (m < n) \/ (n < m)", let th = REWRITE_RULE[LESS_OR_EQ] (SPECL["m:num"; "n:num"] LESS_CASES) in REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN (\t. REWRITE_TAC[t]) th);; let GREATER_EQ = prove_thm(`GREATER_EQ`, "!n m. n >= m = m <= n", REPEAT GEN_TAC THEN REWRITE_TAC[GREATER_OR_EQ; GREATER; LESS_OR_EQ] THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC EQ_SYM_EQ);; let LESS_EQ_CASES = prove_thm(`LESS_EQ_CASES`, "!m n. m <= n \/ n <= m", REPEAT GEN_TAC THEN DISJ_CASES_THEN2 (ASSUME_TAC o MATCH_MP LESS_IMP_LESS_OR_EQ) ASSUME_TAC (SPECL ["m:num"; "n:num"] LESS_CASES) THEN ASM_REWRITE_TAC[]);; let LESS_EQUAL_ADD = prove_thm(`LESS_EQUAL_ADD`, "!m n. m <= n ==> ?p. n = m + p", REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN DISCH_THEN(DISJ_CASES_THEN2 MP_TAC SUBST1_TAC) THENL [MATCH_ACCEPT_TAC(GSYM (ONCE_REWRITE_RULE[ADD_SYM] LESS_ADD)); EXISTS_TAC "0" THEN REWRITE_TAC[ADD_CLAUSES]]);; let LESS_EQ_EXISTS = prove_thm(`LESS_EQ_EXISTS`, "!m n. m <= n = ?p. n = m + p", REPEAT GEN_TAC THEN EQ_TAC THENL [MATCH_ACCEPT_TAC LESS_EQUAL_ADD; DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC LESS_EQ_ADD]);; let NOT_LESS_EQUAL = prove_thm(`NOT_LESS_EQUAL`, "!m n. ~(m <= n) = n < m", REWRITE_TAC[GSYM NOT_LESS]);; let LESS_EQ_0 = prove_thm(`LESS_EQ_0`, "!n. (n <= 0) = (n = 0)", GEN_TAC THEN EQ_TAC THENL [DISCH_THEN(MP_TAC o C CONJ (SPEC "n:num" ZERO_LESS_EQ)) THEN MATCH_ACCEPT_TAC LESS_EQUAL_ANTISYM; DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC LESS_EQ_REFL]);; let MULT_EQ_0 = prove_thm(`MULT_EQ_0`, "!m n. (m * n = 0) = (m = 0) \/ (n = 0)", REPEAT GEN_TAC THEN MAP_EVERY (STRUCT_CASES_TAC o C SPEC num_CASES) ["m:num"; "n:num"] THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; NOT_SUC]);; let LESS_MULT2 = prove_thm(`LESS_MULT2`, "!m n. 0 < m /\ 0 < n ==> 0 < (m * n)", REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LESS; LESS_EQ_0; DE_MORGAN_THM; MULT_EQ_0]);; let LESS_EQ_LESS_TRANS = prove_thm(`LESS_EQ_LESS_TRANS`, "!m n p. m <= n /\ n < p ==> m < p", REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN ASM_CASES_TAC "m:num = n" THEN ASM_REWRITE_TAC[LESS_TRANS]);; let LESS_LESS_EQ_TRANS = prove_thm(`LESS_LESS_EQ_TRANS`, "!m n p. m < n /\ n <= p ==> m < p", REPEAT GEN_TAC THEN REWRITE_TAC[LESS_OR_EQ] THEN ASM_CASES_TAC "n:num = p" THEN ASM_REWRITE_TAC[LESS_TRANS]);; %----------------------------------------------------------------------------% % Single theorem about the factorial function [JRH 92.07.14] % %----------------------------------------------------------------------------% let FACT_LESS = prove_thm(`FACT_LESS`, "!n. 0 < FACT(n)", INDUCT_TAC THEN REWRITE_TAC[FACT; num_CONV "1"; LESS_SUC_REFL] THEN MATCH_MP_TAC LESS_MULT2 THEN ASM_REWRITE_TAC[LESS_0]);; %----------------------------------------------------------------------------% % Theorems about evenness and oddity [JRH 92.07.14] % %----------------------------------------------------------------------------% let EVEN_ODD = prove_thm(`EVEN_ODD`, "!n. EVEN n = ~(ODD n)", INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ODD]);; let ODD_EVEN = prove_thm(`ODD_EVEN`, "!n. ODD n = ~(EVEN n)", REWRITE_TAC[EVEN_ODD]);; let EVEN_OR_ODD = prove_thm(`EVEN_OR_ODD`, "!n. EVEN n \/ ODD n", REWRITE_TAC[EVEN_ODD; REWRITE_RULE[DE_MORGAN_THM] NOT_AND]);; let EVEN_AND_ODD = prove_thm(`EVEN_AND_ODD`, "!n. ~(EVEN n /\ ODD n)", REWRITE_TAC[ODD_EVEN; NOT_AND]);; let EVEN_ADD = prove_thm(`EVEN_ADD`, "!m n. EVEN(m + n) = (EVEN m = EVEN n)", INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; EVEN] THEN BOOL_CASES_TAC "EVEN m" THEN REWRITE_TAC[]);; let EVEN_MULT = prove_thm(`EVEN_MULT`, "!m n. EVEN(m * n) = EVEN(m) \/ EVEN(n)", INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; EVEN_ADD; EVEN] THEN BOOL_CASES_TAC "EVEN m" THEN REWRITE_TAC[]);; let ODD_ADD = prove_thm(`ODD_ADD`, "!m n. ODD(m + n) = ~(ODD m = ODD n)", REPEAT GEN_TAC THEN REWRITE_TAC[ODD_EVEN; EVEN_ADD] THEN BOOL_CASES_TAC "EVEN m" THEN REWRITE_TAC[]);; let ODD_MULT = prove_thm(`ODD_MULT`, "!m n. ODD(m * n) = ODD(m) /\ ODD(n)", REPEAT GEN_TAC THEN REWRITE_TAC[ODD_EVEN; EVEN_MULT; DE_MORGAN_THM]);; let EVEN_DOUBLE = prove_thm(`EVEN_DOUBLE`, "!n. EVEN(2 * n)", GEN_TAC THEN REWRITE_TAC[EVEN_MULT] THEN DISJ1_TAC THEN CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[EVEN]);; let ODD_DOUBLE = prove_thm(`ODD_DOUBLE`, "!n. ODD(SUC(2 * n))", REWRITE_TAC[ODD] THEN REWRITE_TAC[GSYM EVEN_ODD; EVEN_DOUBLE]);; let EVEN_ODD_EXISTS = prove_thm(`EVEN_ODD_EXISTS`, "!n. (EVEN n ==> ?m. n = 2 * m) /\ (ODD n ==> ?m. n = SUC(2 * m))", REWRITE_TAC[ODD_EVEN] THEN INDUCT_TAC THEN REWRITE_TAC[EVEN] THENL [EXISTS_TAC "0" THEN REWRITE_TAC[MULT_CLAUSES]; POP_ASSUM STRIP_ASSUME_TAC THEN CONJ_TAC THEN DISCH_THEN(\th. FIRST_ASSUM(X_CHOOSE_THEN "m:num" SUBST1_TAC o C MATCH_MP th)) THENL [EXISTS_TAC "SUC m" THEN REWRITE_TAC[num_CONV "2"; num_CONV "1"; MULT_CLAUSES; ADD_CLAUSES]; EXISTS_TAC "m:num" THEN REFL_TAC]]);; let EVEN_EXISTS = prove_thm(`EVEN_EXISTS`, "!n. EVEN n = ?m. n = 2 * m", GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[EVEN_ODD_EXISTS]; DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC EVEN_DOUBLE]);; let ODD_EXISTS = prove_thm(`ODD_EXISTS`, "!n. ODD n = ?m. n = SUC(2 * m)", GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[EVEN_ODD_EXISTS]; DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC ODD_DOUBLE]);; % --------------------------------------------------------------------- % % Theorems moved from the `more_arithmetic' library [RJB 92.09.28] % % --------------------------------------------------------------------- % let EQ_LESS_EQ = prove_thm (`EQ_LESS_EQ`, "!m n. (m = n) = ((m <= n) /\ (n <= m))", REPEAT GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC [LESS_EQ_REFL]; REWRITE_TAC [LESS_EQUAL_ANTISYM]]);; let ADD_MONO_LESS_EQ = prove_thm (`ADD_MONO_LESS_EQ`, "!m n p. (m + n) <= (m + p) = (n <= p)", ONCE_REWRITE_TAC [ADD_SYM] THEN REWRITE_TAC [LESS_EQ_MONO_ADD_EQ]);; let NOT_SUC_LESS_EQ_0 = prove_thm (`NOT_SUC_LESS_EQ_0`, "!n. ~(SUC n <= 0)", REWRITE_TAC [NOT_LESS_EQUAL;LESS_0]);; % --------------------------------------------------------------------- % % Theorems to support the arithmetic proof procedure [RJB 92.09.29] % % --------------------------------------------------------------------- % let NOT_LEQ = prove_thm (`NOT_LEQ`, "!m n. ~(m <= n) = (SUC n) <= m", REWRITE_TAC [SYM (SPEC_ALL LESS_EQ)] THEN REWRITE_TAC [SYM (SPEC_ALL NOT_LESS)]);; let NOT_NUM_EQ = prove_thm (`NOT_NUM_EQ`, "!m n. ~(m = n) = (((SUC m) <= n) \/ ((SUC n) <= m))", REWRITE_TAC [EQ_LESS_EQ;DE_MORGAN_THM;NOT_LEQ] THEN MATCH_ACCEPT_TAC DISJ_SYM);; let NOT_GREATER = prove_thm (`NOT_GREATER`, "!m n. ~(m > n) = (m <= n)", REWRITE_TAC [GREATER;NOT_LESS]);; let NOT_GREATER_EQ = prove_thm (`NOT_GREATER_EQ`, "!m n. ~(m >= n) = (SUC m) <= n", REWRITE_TAC [GREATER_EQ;NOT_LEQ]);; let SUC_ONE_ADD = prove_thm (`SUC_ONE_ADD`, "!n. SUC n = 1 + n", GEN_TAC THEN ONCE_REWRITE_TAC [ADD1;ADD_SYM] THEN REFL_TAC);; let SUC_ADD_SYM = prove_thm (`SUC_ADD_SYM`, "!m n. SUC (m + n) = (SUC n) + m", REPEAT GEN_TAC THEN ONCE_REWRITE_TAC [ADD_CLAUSES;ADD_SYM] THEN REFL_TAC);; let NOT_SUC_ADD_LESS_EQ = prove_thm (`NOT_SUC_ADD_LESS_EQ`, "!m n. ~(SUC (m + n) <= m)", REPEAT GEN_TAC THEN REWRITE_TAC [SYM (SPEC_ALL LESS_EQ)] THEN REWRITE_TAC [NOT_LESS;LESS_EQ_ADD]);; let MULT_LESS_EQ_SUC = let th1 = SPEC "b:num" (SPEC "c:num" (SPEC "a:num" LESS_MONO_ADD)) in let th2 = SPEC "c:num" (SPEC "d:num" (SPEC "b:num" LESS_MONO_ADD)) in let th3 = ONCE_REWRITE_RULE [ADD_SYM] th2 in let th4 = CONJ (UNDISCH_ALL th1) (UNDISCH_ALL th3) in let th5 = MATCH_MP LESS_TRANS th4 in let th6 = DISCH_ALL th5 in prove_thm (`MULT_LESS_EQ_SUC`, "!m n p. m <= n = ((SUC p) * m) <= ((SUC p) * n)", REPEAT GEN_TAC THEN EQ_TAC THENL [ONCE_REWRITE_TAC [MULT_SYM] THEN REWRITE_TAC [LESS_MONO_MULT]; CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC [SYM (SPEC_ALL NOT_LESS)] THEN SPEC_TAC ("p:num","p:num") THEN INDUCT_TAC THENL [REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES]; STRIP_TAC THEN RES_TAC THEN ONCE_REWRITE_TAC [MULT_CLAUSES] THEN IMP_RES_TAC th6]]);; let SUB_LEFT_ADD = prove_thm (`SUB_LEFT_ADD`, "!m n p. m + (n - p) = ((n <= p) => m | (m + n) - p)", REPEAT GEN_TAC THEN ASM_CASES_TAC "n <= p" THENL [IMP_RES_THEN (\th. ASM_REWRITE_TAC [th;ADD_CLAUSES]) (SYM (SPEC_ALL SUB_EQ_0)); ASSUM_LIST (MAP_EVERY (ASSUME_TAC o (PURE_REWRITE_RULE [SYM (SPEC_ALL NOT_LESS);NOT_CLAUSES]))) THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_THEN (\th. ASM_REWRITE_TAC [th]) LESS_EQ_ADD_SUB]);; let SUB_RIGHT_ADD = prove_thm (`SUB_RIGHT_ADD`, "!m n p. (m - n) + p = ((m <= n) => p | (m + p) - n)", REPEAT GEN_TAC THEN ASM_CASES_TAC "m <= n" THENL [IMP_RES_THEN (\th. ASM_REWRITE_TAC [th;ADD_CLAUSES]) (SYM (SPEC_ALL SUB_EQ_0)); ASSUM_LIST (MAP_EVERY (ASSUME_TAC o (PURE_REWRITE_RULE [SYM (SPEC_ALL NOT_LESS);NOT_CLAUSES]))) THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN IMP_RES_THEN (\th. ASM_REWRITE_TAC [th]) LESS_EQ_ADD_SUB]);; let SUB_LEFT_SUB = prove_thm (`SUB_LEFT_SUB`, "!m n p. m - (n - p) = ((n <= p) => m | (m + p) - n)", REPEAT GEN_TAC THEN ASM_CASES_TAC "n <= p" THENL [IMP_RES_THEN (\th. ASM_REWRITE_TAC [th;SUB_0]) (SYM (SPEC_ALL SUB_EQ_0)); ASSUM_LIST (MAP_EVERY (ASSUME_TAC o (PURE_REWRITE_RULE [SYM (SPEC_ALL NOT_LESS);NOT_CLAUSES]))) THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_THEN (\th. ASM_REWRITE_TAC [th]) SUB_SUB]);; let SUB_RIGHT_SUB = prove_thm (`SUB_RIGHT_SUB`, "!m n p. (m - n) - p = m - (n + p)", REPEAT INDUCT_TAC THEN REWRITE_TAC [SUB_0;ADD_CLAUSES;SUB_MONO_EQ] THEN PURE_ONCE_REWRITE_TAC [SYM (el 4 (CONJUNCTS ADD_CLAUSES))] THEN PURE_ONCE_ASM_REWRITE_TAC [] THEN REFL_TAC);; let SUB_LEFT_SUC = prove_thm (`SUB_LEFT_SUC`, "!m n. SUC (m - n) = ((m <= n) => (SUC 0) | (SUC m) - n)", REPEAT GEN_TAC THEN ASM_CASES_TAC "m <= n" THENL [IMP_RES_THEN (\th. ASM_REWRITE_TAC [th]) (SYM (SPEC_ALL SUB_EQ_0)); ASM_REWRITE_TAC [SUB] THEN ASSUM_LIST (MAP_EVERY (REWRITE_TAC o CONJUNCTS o (PURE_REWRITE_RULE [LESS_OR_EQ;DE_MORGAN_THM])))]);; let SUB_LEFT_LESS_EQ = prove_thm (`SUB_LEFT_LESS_EQ`, "!m n p. (m <= (n - p)) = ((m + p) <= n) \/ (m <= 0)", REPEAT GEN_TAC THEN ASM_CASES_TAC "p <= n" THENL [SUBST_TAC [SYM (SPECL ["m:num";"n - p";"p:num"] LESS_EQ_MONO_ADD_EQ)] THEN IMP_RES_THEN (\th. PURE_ONCE_REWRITE_TAC [th]) SUB_ADD THEN ASM_CASES_TAC "m <= 0" THENL [IMP_RES_THEN (\th. ASM_REWRITE_TAC [th;ADD_CLAUSES;LESS_EQ_REFL]) (fst (EQ_IMP_RULE (REWRITE_RULE [NOT_LESS_0] (SPECL ["m:num";"0"] LESS_OR_EQ)))); ASM_REWRITE_TAC []]; ASSUM_LIST (MAP_EVERY (ASSUME_TAC o (PURE_REWRITE_RULE [SYM (SPEC_ALL NOT_LESS);NOT_CLAUSES]))) THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_THEN (\th. PURE_ONCE_REWRITE_TAC [th]) (snd (EQ_IMP_RULE (SPEC_ALL SUB_EQ_0))) THEN BOOL_CASES_TAC "m <= 0" THENL [REWRITE_TAC []; PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN IMP_RES_THEN (\th. REWRITE_TAC [th;SYM (SPEC_ALL NOT_LESS);NOT_CLAUSES]) LESS_IMP_LESS_ADD]]);; let SUB_RIGHT_LESS_EQ = prove_thm (`SUB_RIGHT_LESS_EQ`, "!m n p. ((m - n) <= p) = (m <= (n + p))", REPEAT GEN_TAC THEN ASM_CASES_TAC "n <= m" THENL [IMP_RES_THEN (\th. PURE_ONCE_REWRITE_TAC [th]) SUB_LESS_EQ_ADD THEN REFL_TAC; ASSUM_LIST (MAP_EVERY (ASSUME_TAC o (PURE_REWRITE_RULE [SYM (SPEC_ALL NOT_LESS);NOT_CLAUSES]))) THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_THEN (\th. PURE_REWRITE_TAC [th;ZERO_LESS_EQ]) (snd (EQ_IMP_RULE (SPEC_ALL SUB_EQ_0))) THEN IMP_RES_THEN (\th. REWRITE_TAC [th;LESS_OR_EQ]) LESS_IMP_LESS_ADD]);; let SUB_LEFT_LESS = prove_thm (`SUB_LEFT_LESS`, "!m n p. (m < (n - p)) = ((m + p) < n)", REPEAT GEN_TAC THEN PURE_REWRITE_TAC [LESS_EQ;SYM (SPEC_ALL (CONJUNCT2 ADD))] THEN PURE_ONCE_REWRITE_TAC [SUB_LEFT_LESS_EQ] THEN REWRITE_TAC [SYM (SPEC_ALL LESS_EQ);NOT_LESS_0]);; let SUB_RIGHT_LESS = let BOOL_EQ_NOT_BOOL_EQ = prove ("!x y. (x = y) = (~x = ~y)", REPEAT GEN_TAC THEN BOOL_CASES_TAC "x:bool" THEN REWRITE_TAC []) in prove_thm (`SUB_RIGHT_LESS`, "!m n p. ((m - n) < p) = ((m < (n + p)) /\ (0 < p))", REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [BOOL_EQ_NOT_BOOL_EQ] THEN PURE_REWRITE_TAC [DE_MORGAN_THM;NOT_LESS] THEN SUBST1_TAC (SPECL ["n:num";"p:num"] ADD_SYM) THEN REWRITE_TAC [SUB_LEFT_LESS_EQ]);; let SUB_LEFT_GREATER_EQ = prove_thm (`SUB_LEFT_GREATER_EQ`, "!m n p. (m >= (n - p)) = ((m + p) >= n)", REPEAT GEN_TAC THEN PURE_REWRITE_TAC [GREATER_OR_EQ;GREATER] THEN CONV_TAC (RAND_CONV (ONCE_DEPTH_CONV SYM_CONV) THENC RATOR_CONV (RAND_CONV (ONCE_DEPTH_CONV SYM_CONV))) THEN PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL LESS_OR_EQ)] THEN SUBST1_TAC (SPECL ["m:num";"p:num"] ADD_SYM) THEN REWRITE_TAC [SUB_RIGHT_LESS_EQ]);; let SUB_RIGHT_GREATER_EQ = prove_thm (`SUB_RIGHT_GREATER_EQ`, "!m n p. ((m - n) >= p) = ((m >= (n + p)) \/ (0 >= p))", REPEAT GEN_TAC THEN PURE_REWRITE_TAC [GREATER_OR_EQ;GREATER] THEN CONV_TAC (RAND_CONV (ONCE_DEPTH_CONV SYM_CONV) THENC RATOR_CONV (RAND_CONV (ONCE_DEPTH_CONV SYM_CONV))) THEN PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL LESS_OR_EQ)] THEN SUBST1_TAC (SPECL ["n:num";"p:num"] ADD_SYM) THEN REWRITE_TAC [SUB_LEFT_LESS_EQ]);; let SUB_LEFT_GREATER = prove_thm (`SUB_LEFT_GREATER`, "!m n p. (m > (n - p)) = (((m + p) > n) /\ (m > 0))", REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [GREATER] THEN SUBST1_TAC (SPECL ["m:num";"p:num"] ADD_SYM) THEN REWRITE_TAC [SUB_RIGHT_LESS]);; let SUB_RIGHT_GREATER = prove_thm (`SUB_RIGHT_GREATER`, "!m n p. ((m - n) > p) = (m > (n + p))", REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [GREATER] THEN SUBST1_TAC (SPECL ["n:num";"p:num"] ADD_SYM) THEN REWRITE_TAC [SUB_LEFT_LESS]);; let SUB_LEFT_EQ = prove_thm (`SUB_LEFT_EQ`, "!m n p. (m = (n - p)) = ((m + p) = n) \/ ((m <= 0) /\ (n <= p))", REPEAT GEN_TAC THEN PURE_REWRITE_TAC [EQ_LESS_EQ;SUB_LEFT_LESS_EQ;SUB_RIGHT_LESS_EQ;RIGHT_AND_OVER_OR] THEN SUBST1_TAC (SPECL ["p:num";"m:num"] ADD_SYM) THEN ASM_CASES_TAC "m = 0" THENL [ASM_REWRITE_TAC [ADD_CLAUSES]; IMP_RES_TAC (REWRITE_RULE [ADD_CLAUSES] (SPEC "0" LESS_ADD_NONZERO)) THEN ASM_REWRITE_TAC [SYM (SPECL ["0";"m:num"] NOT_LESS)]]);; let SUB_RIGHT_EQ = prove_thm (`SUB_RIGHT_EQ`, "!m n p. ((m - n) = p) = (m = (n + p)) \/ ((m <= n) /\ (p <= 0))", REPEAT GEN_TAC THEN PURE_REWRITE_TAC [EQ_LESS_EQ;SUB_LEFT_LESS_EQ;SUB_RIGHT_LESS_EQ;LEFT_AND_OVER_OR] THEN SUBST1_TAC (SPECL ["p:num";"n:num"] ADD_SYM) THEN ASM_CASES_TAC "p = 0" THENL [ASM_REWRITE_TAC [ADD_CLAUSES]; IMP_RES_TAC (PURE_ONCE_REWRITE_RULE [ADD_CLAUSES] (SPEC "0" LESS_ADD_NONZERO)) THEN ASM_REWRITE_TAC [SYM (SPECL ["0";"p:num"] NOT_LESS)]]);; %------------------------------------------------------------------% %- Theorems about arithmetic functions --- Added by WW (2 Jan 94) -% %------------------------------------------------------------------% let ASSOC_ADD = prove_thm (`ASSOC_ADD`, "ASSOC $+", REWRITE_TAC[ASSOC_DEF;ADD_ASSOC]);; let RIGHT_ID_ADD_0 = prove_thm (`RIGHT_ID_ADD_0`, "RIGHT_ID $+ 0", REWRITE_TAC[RIGHT_ID_DEF;ADD_CLAUSES]);; let LEFT_ID_ADD_0 = prove_thm (`LEFT_ID_ADD_0`, "LEFT_ID $+ 0", REWRITE_TAC[LEFT_ID_DEF;ADD_CLAUSES]);; let MONOID_ADD_0 = prove_thm (`MONOID_ADD_0`, "MONOID $+ 0", REWRITE_TAC[MONOID_DEF;ASSOC_ADD; LEFT_ID_ADD_0;RIGHT_ID_ADD_0]);; let ASSOC_MULT = prove_thm (`ASSOC_MULT`, "ASSOC $*", REWRITE_TAC[ASSOC_DEF;MULT_ASSOC]);; let RIGHT_ID_MULT_1 = prove_thm (`RIGHT_ID_MULT_1`, "RIGHT_ID $* 1", REWRITE_TAC[RIGHT_ID_DEF;MULT_CLAUSES]);; let LEFT_ID_MULT_1 = prove_thm (`LEFT_ID_MULT_1`, "LEFT_ID $* 1", REWRITE_TAC[LEFT_ID_DEF;MULT_CLAUSES]);; let MONOID_MULT_1 = prove_thm (`MONOID_MULT_1`, "MONOID $* 1", REWRITE_TAC[MONOID_DEF;ASSOC_MULT;LEFT_ID_MULT_1;RIGHT_ID_MULT_1]);; quit();; hol88-2.02.19940316/theories/mk_list.ml0000640000212700021270000002510305230325377015551 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_list.ml % % % % DESCRIPTION: Creates the theory "list.th" containing the logical % % definition of the list type operator. The type is % % defined and the following "axiomatization" is proven % % from the definition of the type: % % % % |- !x. !f. ?!fn. (fn NIL = x) /\ % % (!h t. fn (CONS h t) = f (fn t) h t) % % % % AUTHOR: T. F. Melham (86.11.24) % % % % PARENTS: arithmetic.th % % WRITES FILES: list.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % % % % REVISION HISTORY: 97.03.14 % %=============================================================================% % Define the new theory.. % new_theory `list`;; % Parents are arithmetic. % new_parent `arithmetic`;; % fetch theorems from prim_rec.th % let NOT_LESS_0 = theorem `prim_rec` `NOT_LESS_0`;; let PRIM_REC_THM = theorem `prim_rec` `PRIM_REC_THM`;; let PRE = theorem `prim_rec` `PRE`;; let LESS_0 = theorem `prim_rec` `LESS_0`;; % Fetch theorems from num.th % let NOT_SUC = theorem `num` `NOT_SUC`;; let INDUCTION = theorem `num` `INDUCTION`;; % Fetch theorems from arithmetic.th % let ADD_CLAUSES = theorem `arithmetic` `ADD_CLAUSES`;; let LESS_ADD_1 = theorem `arithmetic` `LESS_ADD_1`;; let LESS_EQ = theorem `arithmetic` `LESS_EQ`;; let NOT_LESS = theorem `arithmetic` `NOT_LESS`;; let LESS_EQ_ADD = theorem `arithmetic` `LESS_EQ_ADD`;; let num_CASES = theorem `arithmetic` `num_CASES`;; let LESS_MONO_EQ = theorem `arithmetic` `LESS_MONO_EQ`;; % ------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml % % but it is part of hol rather than basic hol, so it's loaded % % in uncompiled (since it may not have been recompiled since % % basic-hol was last rebuilt. % % % % TFM 88.04.02 % % ------------------------------------------------------------- % loadt (concat ml_dir_pathname `ind.ml`);; % And create an induction tactic % % Added: TFM 88.03.31 % let INDUCT_TAC = INDUCT_THEN INDUCTION ASSUME_TAC;; % Load the (uncompiled) axiom scheme for numerals. % loadt (concat ml_dir_pathname `numconv.ml`);; % Define the subset predicate for lists. % let IS_list_REP = new_definition (`IS_list_REP`, "IS_list_REP r = ?f n. r = ((\m.(m f m | @x:*.T)),n)");; % Show that the representation subset is nonempty. % let EXISTS_list_REP = TAC_PROOF(([], "?p. IS_list_REP (p:(num->*) # num)"), EXISTS_TAC "(\n:num.@e:*.T),0" THEN PURE_REWRITE_TAC [IS_list_REP] THEN MAP_EVERY EXISTS_TAC ["\n:num.@e:*.T";"0"] THEN REWRITE_TAC [NOT_LESS_0]);; % Define the new type. % let list_TY_DEF = new_type_definition (`list`, "IS_list_REP:((num->*) # num) -> bool", EXISTS_list_REP);; % --------------------------------------------------------------------- % % Define a representation function, REP_list, from the type (*)list to % % the representing type and the inverse abstraction function ABS_list, % % and prove some trivial lemmas about them. % % --------------------------------------------------------------------- % let list_ISO_DEF = define_new_type_bijections `list_ISO_DEF` `ABS_list` `REP_list` list_TY_DEF;; let R_ONTO = prove_rep_fn_onto list_ISO_DEF and A_11 = prove_abs_fn_one_one list_ISO_DEF and A_R = CONJUNCT1 list_ISO_DEF and R_A = CONJUNCT2 list_ISO_DEF;; % --------------------------------------------------------------------- % % Definitions of NIL and CONS. % % --------------------------------------------------------------------- % let NIL_DEF = new_definition (`NIL_DEF`, "NIL = ABS_list ((\n:num.@e:*.T),0)");; let CONS_DEF = new_definition (`CONS_DEF`, "CONS (h:*) (t:(*)list) = (ABS_list ((\m. ((m=0) => h | (FST(REP_list t)) (PRE m))), (SUC(SND(REP_list t)))))");; close_theory();; % --------------------------------------------------------------------- % % Now, prove the axiomatization of lists. % % --------------------------------------------------------------------- % let lemma1 = TAC_PROOF( ([],"!x:**. !f:(**->*->(*)list->**). ?fn:(((num->*)#num)->**). (!g. fn(g,0) = x) /\ (!g n. fn(g,n+1) = f (fn ((\i.g(i+1)),n)) (g 0) (ABS_list((\i.g(i+1)),n)))"), REPEAT STRIP_TAC THEN EXISTS_TAC "\p:((num->*)#num). (PRIM_REC (\g.x:**) (\b m g. f (b (\i.g(i+1))) (g 0) (ABS_list((\i.g(i+1)),m)))) (SND p) (FST p)" THEN CONV_TAC (DEPTH_CONV (BETA_CONV ORELSEC num_CONV)) THEN REWRITE_TAC [PRIM_REC_THM;ADD_CLAUSES] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC[]);; let NIL_lemma = TAC_PROOF(([], "REP_list NIL = ((\n:num.@x:*.T), 0)"), REWRITE_TAC [NIL_DEF;(SYM(SPEC_ALL R_A));IS_list_REP] THEN MAP_EVERY EXISTS_TAC ["\n:num.@x:*.T";"0"] THEN REWRITE_TAC [NOT_LESS_0]);; let REP_lemma = TAC_PROOF(([], "IS_list_REP (REP_list (l:(*)list))"), REWRITE_TAC [R_ONTO] THEN EXISTS_TAC "l:(*)list" THEN REFL_TAC);; let CONS_lemma = TAC_PROOF(([], "REP_list (CONS (h:*) t) = ((\m.((m=0)=>h|FST(REP_list t)(PRE m))),SUC(SND(REP_list t)))"), REWRITE_TAC [CONS_DEF;(SYM(SPEC_ALL R_A));IS_list_REP] THEN EXISTS_TAC "\n.((n=0) => (h:*) | (FST(REP_list t)(PRE n)))" THEN EXISTS_TAC "SUC(SND(REP_list (t:(*)list)))" THEN REWRITE_TAC [PAIR_EQ] THEN CONV_TAC (REDEPTH_CONV (FUN_EQ_CONV ORELSEC BETA_CONV)) THEN STRIP_TAC THEN ASM_CASES_TAC "n < (SUC(SND(REP_list (t:(*)list))))" THEN ASM_REWRITE_TAC [] THEN STRIP_ASSUME_TAC (REWRITE_RULE [IS_list_REP] (SPEC "t:(*)list" (GEN_ALL REP_lemma))) THEN POP_ASSUM SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [FST;SND;NOT_LESS;(SYM(SPEC_ALL LESS_EQ))] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN DISCH_THEN ((STRIP_THM_THEN SUBST1_TAC) o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC [num_CONV "1";PRE;ADD_CLAUSES;NOT_SUC] THEN REWRITE_TAC[REWRITE_RULE[SYM(SPEC_ALL NOT_LESS)] LESS_EQ_ADD]);; let exists_lemma = TAC_PROOF( ([], "!x:**. !f:(**->*->(*)list->**).?fn:(*)list->**. (fn NIL = x) /\ (!h t. fn (CONS h t) = f (fn t) h t)"), REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (REWRITE_RULE [num_CONV "1";ADD_CLAUSES] (SPECL ["x:**";"f:**->*->(*)list->**"] lemma1)) THEN EXISTS_TAC "\x:(*)list.(fn (REP_list x):**)" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC [NIL_lemma;CONS_lemma] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [NOT_SUC;PRE;PAIR;ETA_AX;A_R]);; let A_11_lemma = REWRITE_RULE [SYM (ANTE_CONJ_CONV "(A /\ B) ==> C")] (DISCH_ALL(snd(EQ_IMP_RULE (UNDISCH_ALL (SPEC_ALL A_11)))));; let R_A_lemma = TAC_PROOF(([], "REP_list(ABS_list((\m.((m f(SUC m) | @x:*.T)),n)) = ((\m.((m f(SUC m) | @x:*.T)),n)"), REWRITE_TAC [SYM(SPEC_ALL R_A);IS_list_REP] THEN MAP_EVERY EXISTS_TAC ["\n.f(SUC n):*";"n:num"] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REFL_TAC);; let cons_lemma = TAC_PROOF(([], "ABS_list((\m.(m < SUC n) => f m | (@x:*.T)), (SUC n)) = (CONS(f 0)(ABS_list ((\m.((m f(SUC m) | @x:*.T)), n)))"), REWRITE_TAC [CONS_DEF] THEN MATCH_MP_TAC (GEN_ALL A_11_lemma) THEN REPEAT STRIP_TAC THENL [REWRITE_TAC [R_ONTO] THEN EXISTS_TAC "CONS (f 0)(ABS_list((\m.((m f(SUC m)|@x:*.T)),n))" THEN REWRITE_TAC [CONS_lemma]; REWRITE_TAC [IS_list_REP] THEN MAP_EVERY EXISTS_TAC ["f:num->*";"SUC n"] THEN REFL_TAC; REWRITE_TAC [PAIR_EQ;R_A_lemma] THEN CONV_TAC FUN_EQ_CONV THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "n':num" num_CASES) THEN POP_ASSUM SUBST1_TAC THENL [REWRITE_TAC [PRE;LESS_0]; REWRITE_TAC [PRE;NOT_SUC;LESS_MONO_EQ]]]);; let list_Axiom = prove_thm(`list_Axiom`, "!x:**. !f:(**->*->(*)list->**). ?!fn:(*)list->**. (fn NIL = x) /\ (!h t. fn (CONS h t) = f (fn t) h t)", PURE_REWRITE_TAC [EXISTS_UNIQUE_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REWRITE_TAC [exists_lemma] THEN REWRITE_TAC [NIL_DEF] THEN REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN CONV_TAC (ONCE_DEPTH_CONV(REWR_CONV(SYM (SPEC_ALL A_R)))) THEN X_GEN_TAC "l:(*)list" THEN STRIP_ASSUME_TAC (REWRITE_RULE [IS_list_REP] (SPEC "l:(*)list" (GEN_ALL REP_lemma))) THEN POP_ASSUM SUBST_ALL_TAC THEN SPEC_TAC ("f':num->*","f':num->*") THEN SPEC_TAC ("n:num","n:num") THEN INDUCT_TAC THENL [ASM_REWRITE_TAC [NOT_LESS_0]; STRIP_TAC THEN POP_ASSUM (ASSUME_TAC o (CONV_RULE (DEPTH_CONV BETA_CONV)) o (SPEC "\n.f'(SUC n):*")) THEN ASM_REWRITE_TAC [cons_lemma]]);; quit();; hol88-2.02.19940316/theories/mk_one.ml0000640000212700021270000001171205335675155015370 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: one.ml % % % % DESCRIPTION: Creates the theory "one.th" containing the logical % % definition of the type :one, the type with only one % % value. The type :one is defined and the following % % "axiomatization" is proven from the definition of the % % type: % % % % one_axiom: |- !f g. f = (g:*->one) % % % % and alternative axiom is also proved: % % % % one_Axiom: |- !e:*. ?!fn. fn one = e % % % % AUTHOR: T. F. Melham (87.03.03) % % % % WRITES FILES: one.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % %=============================================================================% % Create and open the new theory one.th. % new_theory `one`;; % --------------------------------------------------------------------- % % Introduce the new type. % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % The type :one will be represented by the subset {T} of :bool. % % The predicate defining this subset will be "\b.b". We must first % % prove the (trivial) theorem: ?b.(\b.b)b. % % --------------------------------------------------------------------- % let EXISTS_ONE_REP = TAC_PROOF(([], "?b:bool.(\b.b)b"), EXISTS_TAC "T" THEN CONV_TAC BETA_CONV THEN ACCEPT_TAC TRUTH);; % Use the type definition mechanism to introduce the new type. % % The theorem returned is: |- ?rep. TYPE_DEFINITION (\b.b) rep % let one_TY_DEF = REWRITE_RULE [TYPE_DEFINITION] (new_type_definition (`one`, "(\b:bool.b)", EXISTS_ONE_REP));; % Define the constant "one" of type one.... % let one_DEF = new_definition(`one_DEF`, "one = @x:one.T");; % Done with definitions --- close the theory. % close_theory ();; % --------------------------------------------------------------------- % % The proof of the "axiom" for type :one follows. % % --------------------------------------------------------------------- % % Now, prove the (only) axiom for the type :one. % % The axiom is: |- !f:*->one g. f = g % let one_axiom = prove_thm (`one_axiom`, "!f g. f = (g:*->one)", CONV_TAC (DEPTH_CONV FUN_EQ_CONV) THEN REPEAT GEN_TAC THEN STRIP_ASSUME_TAC (CONV_RULE (DEPTH_CONV BETA_CONV) one_TY_DEF) THEN FIRST_ASSUM MATCH_MP_TAC THEN EQ_TAC THEN DISCH_THEN (K ALL_TAC) THEN POP_ASSUM (CONV_TAC o REWR_CONV) THENL [EXISTS_TAC "g (x:*):one"; EXISTS_TAC "f (x:*):one"] THEN REFL_TAC);; % The following theorem shows that there is only one value of type :one % let one = prove_thm (`one`, "!v:one. v = one", GEN_TAC THEN ACCEPT_TAC (CONV_RULE (DEPTH_CONV BETA_CONV) (AP_THM (SPECL ["\x:*.v:one"; "\x:*.one"] one_axiom) "x:*")));; % Prove also the following theorem: % let one_Axiom = prove_thm (`one_Axiom`, "!e:*. ?!fn. fn one = e", STRIP_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN STRIP_TAC THENL [EXISTS_TAC "\x:one.e:*" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REFL_TAC; REPEAT STRIP_TAC THEN (CONV_TAC FUN_EQ_CONV) THEN ONCE_REWRITE_TAC [one] THEN ASM_REWRITE_TAC[]]);; quit();; hol88-2.02.19940316/theories/mk_prim_rec.ml0000640000212700021270000003574505521432636016413 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_prim_rec.ml % % % % DESCRIPTION: Prove the primitive recusion theorem % % % % PARENTS: num.th % % WRITES FILES: prim_rec.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% % In this file, which should be loaded into basic-hol after deleting hol/prim_rec.th, we prove the primitive recursion theorem directly from Peano's axioms (which are actually theorems in HOL). These `axioms' define the type ":num" and two constants "0:num" and "SUC:num->num", they are: NOT_SUC |- !n. ~(SUC n = 0) INV_SUC |- !m n. (SUC m = SUC n) ==> (m = n) INDUCTION |- !P. (P 0 /\ (!n. P n ==> P(SUC n))) ==> !n. P n Using INDUCTION one can define an induction rule and tactic. The rule is an ML function: INDUCT: (thm # thm) -> thm A1 |- t[0] A2 |- !n. t[n] ==> t[SUC n] ----------------------------------------------- A1 u A2 |- !n. t[n] The tactic is: [A] !n.t[n] ================================ [A] t[0] , [A,t[n]] t[SUC x] From now on we only make (non-recursive) definitions and prove theorems. The following definition of < is from Hodges's article in "The Handbook of Philosophical Logic" (page 111): m < n = ?P. (!n. P(SUC n) ==> P n) /\ P m /\ ~(P n) The following consequence of INV_SUC will be useful for rewriting: |- !m n. (SUC m = SUC n) = (m = n) It is used in SUC_ID and PRIM_REC_EXISTS below. We establish it by forward proof. After proving this we prove some standard properties of <. % new_theory `prim_rec`;; new_parent `num`;; % Added TFM 88.04.02 % let NOT_SUC = theorem `num` `NOT_SUC` and INV_SUC = theorem `num` `INV_SUC` and INDUCTION = theorem `num` `INDUCTION`;; let LESS = new_infix_definition (`LESS`, "$< m n = ?P. (!n. P(SUC n) ==> P n) /\ P m /\ ~(P n)");; % ------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml % % but it is part of hol rather than basic hol, so it's loaded % % in uncompiled (since it may not have been recompiled since % % basic-hol was last rebuilt. [TFM 88.04.02] % % % % Modified to load ind.ml, to ensure that it's uncompiled. % % ------------------------------------------------------------- % loadt (concat ml_dir_pathname `ind.ml`);; % And create an induction tactic % % Added: TFM 88.03.31 % let INDUCT_TAC = INDUCT_THEN INDUCTION ASSUME_TAC;; let INV_SUC_EQ = save_thm (`INV_SUC_EQ`, GEN_ALL (IMP_ANTISYM_RULE (SPEC_ALL INV_SUC) (DISCH "m:num = n" (AP_TERM "SUC" (ASSUME "m:num = n")))));; let LESS_REFL = prove_thm (`LESS_REFL`, "!n. ~(n < n)", GEN_TAC THEN REWRITE_TAC[LESS;NOT_AND]);; let SUC_LESS = prove_thm (`SUC_LESS`, "!m n. (SUC m) < n ==> m < n", REWRITE_TAC[LESS] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "P:num->bool" THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let NOT_LESS_0 = prove_thm (`NOT_LESS_0`, "!n. ~(n < 0)", INDUCT_TAC THEN REWRITE_TAC[LESS_REFL] THEN IMP_RES_TAC(CONTRAPOS(SPECL["n:num";"0"]SUC_LESS)) THEN ASM_REWRITE_TAC[]);; let LESS_0_0 = prove_thm (`LESS_0_0`, "0 < SUC 0", REWRITE_TAC[LESS] THEN EXISTS_TAC "\x.x=0" THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN REWRITE_TAC[NOT_SUC]);; let LESS_MONO = prove_thm (`LESS_MONO`, "!m n. m < n ==> SUC m < SUC n", REWRITE_TAC[LESS] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "\x.(x = SUC m) \/ (P x)" THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[] THEN IMP_RES_TAC (DISCH_ALL (CONTRAPOS(SPEC"n:num"(ASSUME "!n'. P(SUC n') ==> P n'")))) THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC INV_SUC THEN ASM_REWRITE_TAC[] THEN IMP_RES_TAC (DISCH_ALL(SUBS[ASSUME "n:num = m"](ASSUME "~(P(n:num))"))) THEN RES_TAC);; let LESS_SUC_REFL = prove_thm (`LESS_SUC_REFL`, "!n. n < SUC n", INDUCT_TAC THEN REWRITE_TAC[LESS_0_0] THEN IMP_RES_TAC LESS_MONO THEN ASM_REWRITE_TAC[]);; let LESS_SUC = prove_thm (`LESS_SUC`, "!m n. m < n ==> m < SUC n", REWRITE_TAC [LESS] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "P:num->bool" THEN IMP_RES_TAC (CONTRAPOS(SPEC "n:num" (ASSUME "!n'. P(SUC n') ==> P n'"))) THEN ASM_REWRITE_TAC[]);; let LESS_LEMMA1 = prove_thm (`LESS_LEMMA1`, "!m n. m < SUC n ==> (m = n) \/ (m < n)", REWRITE_TAC[LESS] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC "m:num = n" THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC "\x:num. ~(x = n) /\ (P x)" THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN IMP_RES_TAC (DISCH_ALL(SUBS[ASSUME "n':num = n"](ASSUME"P(SUC n'):bool"))) THEN ASSUME_TAC(REFL"n:num") THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LESS_LEMMA2 = prove_thm (`LESS_LEMMA2`, "!m n. (m = n) \/ (m < n) ==> m < SUC n", REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_SUC THEN ASM_REWRITE_TAC[LESS_SUC_REFL]);; % |- !m n. m < (SUC n) = (m = n) \/ m < n % let LESS_THM = save_thm (`LESS_THM`, GEN_ALL(IMP_ANTISYM_RULE(SPEC_ALL LESS_LEMMA1)(SPEC_ALL LESS_LEMMA2)));; let LESS_SUC_IMP = prove_thm (`LESS_SUC_IMP`, "!m n. (m < SUC n) ==> ~(m = n) ==> (m < n)", REWRITE_TAC[LESS_THM] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; let LESS_0 = prove_thm (`LESS_0`, "!n. 0 < (SUC n)", INDUCT_TAC THEN ASM_REWRITE_TAC[LESS_THM]);; let EQ_LESS = prove_thm (`EQ_LESS`, "!n. (SUC m = n) ==> (m < n)", INDUCT_TAC THEN REWRITE_TAC[NOT_SUC;LESS_THM] THEN DISCH_TAC THEN IMP_RES_TAC INV_SUC THEN ASM_REWRITE_TAC[]);; let SUC_ID = prove_thm (`SUC_ID`, "!n. ~(SUC n = n)", INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC;INV_SUC_EQ]);; let NOT_LESS_EQ = prove_thm (`NOT_LESS_EQ`, "!m n. (m = n) ==> ~(m < n)", REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[LESS_REFL]);; let LESS_NOT_EQ = prove_thm (`LESS_NOT_EQ`, "!m n. m < n ==> ~(m = n)", REPEAT STRIP_TAC THEN IMP_RES_TAC (DISCH_ALL(SUBS[ASSUME "m:num = n"](ASSUME "m < n"))) THEN IMP_RES_TAC LESS_REFL THEN RES_TAC THEN ASM_REWRITE_TAC[]);; % Now we start a new theory in which we will prove that: |- !x f. ?fun. (fun 0 = x) /\ (!m. fun(SUC m) = f(fun m)m) We start by defining a (higher order) function SIMP_REC and proving that: |- !m x f. (SIMP_REC x f 0 = x) /\ (SIMP_REC x f (SUC m) = f(SIMP_REC x f m)) We then define a function PRIM_REC in terms of SIMP_REC and prove that: |- !m x f. (PRIM_REC x f 0 = x) /\ (PRIM_REC x f (SUC m) = f(PRIM_REC x f m)m) This is sufficient to justify any primitive recursive definition because a definition: fun 0 x1 ... xn = f1(x1, ... ,xn) fun (SUC m) x1 ... xn = f2(fun m x1 ... xn, m, x1, ... ,xn) is equivalent to: fun 0 = \x1 ... xn. f1(x1, ... ,xn) fun (SUC m) = \x1 ... xn. f2(fun m x1 ... xn, m, x1, ... ,xn) = (\f m x1 ... xn. f2(f x1 ... xn, m, x1, ... ,xn))(fun m)m which defines f to be: PRIM_REC (\x1 ... xn. f1(x1, ... ,xn)) (\f m x1 ... xn. f2(f x1 ... xn, m, x1, ... ,xn)) % let SIMP_REC_REL = new_definition (`SIMP_REC_REL`, "!fun:num->*. !x:*. !f:*->*. !n:num. SIMP_REC_REL fun x f n = (fun 0 = x) /\ !m. m < n ==> (fun(SUC m) = f(fun m))");; let SIMP_REC_FUN = new_definition (`SIMP_REC_FUN`, "SIMP_REC_FUN (x:*) (f:*->*) (n:num) = @fun. SIMP_REC_REL fun x f n");; let SIMP_REC = new_definition (`SIMP_REC`, "SIMP_REC (x:*) (f:*->*) (n:num) = SIMP_REC_FUN x f (SUC n) n");; % |- (?fun. SIMP_REC_REL fun x f n) = (SIMP_REC_FUN x f n 0 = x) /\ (!m. m < n ==> (SIMP_REC_FUN x f n (SUC m) = f(SIMP_REC_FUN x f n m))) % let SIMP_REC_FUN_LEMMA = let t1 = "?fun:num->*. SIMP_REC_REL fun x f n" and t2 = "SIMP_REC_REL (@fun:num->*. SIMP_REC_REL fun x f n) x f n" in let th1 = DISCH t1 (SELECT_RULE(ASSUME t1)) and th2 = DISCH t2 (EXISTS(t1, "@fun:num->*.SIMP_REC_REL fun x f n")(ASSUME t2)) in let th3 = PURE_REWRITE_RULE[SYM(SPEC_ALL SIMP_REC_FUN)](IMP_ANTISYM_RULE th1 th2) in save_thm (`SIMP_REC_FUN_LEMMA`, th3 TRANS DEPTH_CONV(REWR_CONV SIMP_REC_REL)(rhs(concl th3)));; % A |- ~(t1 = t2) ----------------- A |- ~(t2 = t1) Deleted by WW 26 Jan 94. Use the global version let NOT_EQ_SYM th = let t = (mk_eq o (\(x,y).(y,x)) o dest_eq o dest_neg o concl) th in MP (SPEC t IMP_F) (DISCH t (MP th (SYM(ASSUME t))));; % % Following proof revised for version 1.12 resolution. [TFM 91.01.18] % let SIMP_REC_EXISTS = prove_thm (`SIMP_REC_EXISTS`, "!x f n. ?fun:(num->*). SIMP_REC_REL fun x f n", GEN_TAC THEN GEN_TAC THEN INDUCT_THEN INDUCTION STRIP_ASSUME_TAC THEN PURE_REWRITE_TAC[SIMP_REC_REL] THENL [EXISTS_TAC "\p:num.(x:*)" THEN REWRITE_TAC[NOT_LESS_0]; EXISTS_TAC "\p. ((p=(SUC n)) => f(SIMP_REC_FUN (x:*) f n n) | SIMP_REC_FUN x f n p)" THEN CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[NOT_EQ_SYM(SPEC_ALL NOT_SUC)] THEN IMP_RES_TAC SIMP_REC_FUN_LEMMA THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC "m:num = n" THEN IMP_RES_TAC LESS_NOT_EQ THEN IMP_RES_TAC LESS_SUC_IMP THEN RES_TAC THEN ASM_REWRITE_TAC[LESS_THM;INV_SUC_EQ;SUC_ID]]);; % |- !x f n. (SIMP_REC_FUN x f n 0 = x) /\ (!m. m < n ==> (SIMP_REC_FUN x f n (SUC m) = f(SIMP_REC_FUN x f n m))) % % No longer saved in prim_rec.th. [TFM 90.04.25] % let SIMP_REC_FUN_THM = GEN_ALL(EQ_MP(SPEC_ALL SIMP_REC_FUN_LEMMA)(SPEC_ALL SIMP_REC_EXISTS));; let SIMP_REC_FUN_THM1 = GEN_ALL(CONJUNCT1(SPEC_ALL SIMP_REC_FUN_THM));; let SIMP_REC_FUN_THM2 = GEN "n:num" (CONJUNCT2(SPEC_ALL SIMP_REC_FUN_THM));; % Proof modified for new RES_TAC [TFM 90.04.25] % % Also, result not now saved in prim_rec.th. % let SIMP_REC_UNIQUE = TAC_PROOF (([], "!n m1 m2 (x:*) f. (n < m1) ==> (n < m2) ==> (SIMP_REC_FUN x f m1 n = SIMP_REC_FUN x f m2 n)"), INDUCT_TAC THEN ASM_REWRITE_TAC[SIMP_REC_FUN_THM1] THEN REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN IMP_RES_TAC SUC_LESS THEN IMP_RES_TAC SIMP_REC_FUN_THM2 THEN ASM_REWRITE_TAC[] THEN RES_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let LESS_SUC_SUC = prove_thm (`LESS_SUC_SUC`, "!m. m < SUC m /\ m < SUC(SUC m)", INDUCT_TAC THEN ASM_REWRITE_TAC[LESS_THM]);; let SIMP_REC_THM = prove_thm (`SIMP_REC_THM`, "!(x:*) f. (SIMP_REC x f 0 = x) /\ (!m. SIMP_REC x f (SUC m) = f(SIMP_REC x f m))", ASM_REWRITE_TAC [SIMP_REC;SIMP_REC_FUN_THM1; MP(SPECL["SUC(SUC m)";"m:num"]SIMP_REC_FUN_THM2) (CONJUNCT2(SPEC_ALL LESS_SUC_SUC)); MP (MP(SPEC_ALL(SPECL["m:num";"SUC(SUC m)";"SUC m"]SIMP_REC_UNIQUE)) (CONJUNCT2(SPEC_ALL LESS_SUC_SUC))) (CONJUNCT1(SPEC_ALL LESS_SUC_SUC))]);; % We now use simple recursion to prove that: |- !x f. ?fun. (fun 0 = x) /\ (!m. fun(SUC m) = f(fun m)m) We proceed by defining a function PRIM_REC and proving that: |- !m x f. (PRIM_REC x f 0 = x) /\ (PRIM_REC x f (SUC m) = f(PRIM_REC x f m)m) % % First we define a partial inverse to SUC called PRE such that: (PRE 0 = 0) /\ (!m. PRE(SUC m) = m) % let PRE_DEF = new_definition(`PRE_DEF`, "PRE m = ((m=0) => 0 | @n. m = SUC n)");; % Now we prove some theorems: % % |- (@n. m = n) = m % let SELECT_LEMMA = let th = SELECT_INTRO(EQ_MP (SYM(BETA_CONV "(\n:*. m = n) m")) (REFL "m:*")) in SYM(EQ_MP(BETA_CONV(concl th))th);; let PRE = prove_thm (`PRE`, "(PRE 0 = 0) /\ (!m. PRE(SUC m) = m)", REPEAT STRIP_TAC THEN REWRITE_TAC[PRE_DEF;INV_SUC_EQ;NOT_SUC;SELECT_LEMMA]);; let PRIM_REC_FUN = new_definition (`PRIM_REC_FUN`, "PRIM_REC_FUN (x:*) (f:*->num->*) = SIMP_REC (\n:num. x) (\fun n. f(fun(PRE n))n)");; let PRIM_REC_EQN = prove_thm (`PRIM_REC_EQN`, "!(x:*) f. (!n. PRIM_REC_FUN x f 0 n = x) /\ (!m n. PRIM_REC_FUN x f (SUC m) n = f (PRIM_REC_FUN x f m (PRE n)) n)", REPEAT STRIP_TAC THEN REWRITE_TAC [PRIM_REC_FUN;SIMP_REC_THM] THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN REWRITE_TAC[]);; let PRIM_REC = new_definition (`PRIM_REC`, "PRIM_REC (x:*) f m = PRIM_REC_FUN x f m (PRE m)");; let PRIM_REC_THM = prove_thm (`PRIM_REC_THM`, "!x f. (PRIM_REC (x:*) f 0 = x) /\ (!m. PRIM_REC x f (SUC m) = f(PRIM_REC x f m)m)", REPEAT STRIP_TAC THEN REWRITE_TAC[PRIM_REC;PRIM_REC_FUN;SIMP_REC_THM] THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN REWRITE_TAC[PRE]);; % --------------------------------------------------------------------- % % Unique existence theorem for prim rec definitions on num. % % % % ADDED TFM 88.04.02 % % --------------------------------------------------------------------- % let num_Axiom = prove_thm (`num_Axiom`, "!e:*. !f. ?! fn. ((fn 0) = e) /\ (!n. fn(SUC n) = f (fn n) n)", REPEAT GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL [EXISTS_TAC "PRIM_REC (e:*) (f:*->num->*)" THEN REWRITE_TAC [PRIM_REC_THM]; CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN INDUCT_TAC THEN ASM_REWRITE_TAC []]);; close_theory();; quit();; hol88-2.02.19940316/theories/mk_tree.ml0000640000212700021270000011662705511561033015542 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_tree.ml % % % % DESCRIPTION: Creates the theory "tree.th" containing the % % definition of a type of (bare) trees. % % % % AUTHOR: T. F. Melham (87.07.27) % % % % PARENTS: list.th % % WRITES FILES: tree.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1988 % % % % REVISION HISTORY: Mike Gordon and John Carroll (26 August 1989) % %=============================================================================% % Create the new theory "tree.th". % new_theory `tree`;; % The theory of lists is a parent theory. % new_parent `list`;; % fetch theorems from list.th % let list_Axiom = theorem `list` `list_Axiom` and list_INDUCT = theorem `list` `list_INDUCT` and CONS_11 = theorem `list` `CONS_11` and NULL = theorem `list` `NULL` and NOT_CONS_NIL = theorem `list` `NOT_CONS_NIL` and NOT_NIL_CONS = theorem `list` `NOT_NIL_CONS` and ALL_EL_CONJ = theorem `list` `ALL_EL_CONJ`;; % theorem changed to definition for HOL88 % let ALL_EL = definition `list` `ALL_EL` and MAP = definition `list` `MAP` and HD = definition `list` `HD` and TL = definition `list` `TL`;; % Need arithmetic definitions. % let LESS_OR_EQ = definition `arithmetic` `LESS_OR_EQ`;; % theorem changed to definition for HOL88 % let EXP = definition `arithmetic` `EXP`;; % Need various arithmetic theorems. % let LESS_ADD_1 = theorem `arithmetic` `LESS_ADD_1` and ADD_SYM = theorem `arithmetic` `ADD_SYM` and EXP_ADD = theorem `arithmetic` `EXP_ADD` and MULT_ASSOC = theorem `arithmetic` `MULT_ASSOC` and MULT_EXP_MONO = theorem `arithmetic` `MULT_EXP_MONO` and MULT_CLAUSES = theorem `arithmetic` `MULT_CLAUSES` and ADD_CLAUSES = theorem `arithmetic` `ADD_CLAUSES` and NOT_ODD_EQ_EVEN = theorem `arithmetic` `NOT_ODD_EQ_EVEN` and LESS_CASES = theorem `arithmetic` `LESS_CASES` and WOP = theorem `arithmetic` `WOP` and num_CASES = theorem `arithmetic` `num_CASES` and NOT_LESS = theorem `arithmetic` `NOT_LESS` and LESS_IMP_LESS_OR_EQ = theorem `arithmetic` `LESS_IMP_LESS_OR_EQ` and LESS_EQ_TRANS = theorem `arithmetic` `LESS_EQ_TRANS` and LESS_EQ_ADD = theorem `arithmetic` `LESS_EQ_ADD` and LESS_TRANS = theorem `arithmetic` `LESS_TRANS` and LESS_EQ_ANTISYM = theorem `arithmetic` `LESS_EQ_ANTISYM` and LESS_EQ = theorem `arithmetic` `LESS_EQ`;; % Need theorems from prim_rec.th % let INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ` and PRIM_REC_THM = theorem `prim_rec` `PRIM_REC_THM` and LESS_0 = theorem `prim_rec` `LESS_0` and LESS_SUC_REFL = theorem `prim_rec` `LESS_SUC_REFL` and LESS_THM = theorem `prim_rec` `LESS_THM` and LESS_SUC = theorem `prim_rec` `LESS_SUC` and NOT_LESS_0 = theorem `prim_rec` `NOT_LESS_0` and LESS_REFL = theorem `prim_rec` `LESS_REFL`;; % Need theorems from num.th % let NOT_SUC = theorem `num` `NOT_SUC` and INDUCTION = theorem `num` `INDUCTION`;; % --------------------------------------------------------------------- % % Load code needed % % --------------------------------------------------------------------- % % Load the axiom scheme for numerals (NB: uncompiled!). % loadt (concat ml_dir_pathname `numconv.ml`);; % We need to load in the induction tactic. It's in ml/ind.ml % % but it is part of hol rather than basic hol, so it's loaded % % in uncompiled. % % % % TFM 88.04.02 % loadt (concat ml_dir_pathname `ind.ml`);; % Note that prim_rec_ml.o must be recompiled if basic-hol has been. % % So we just load prim_rec.ml uncompiled. % % % % TFM 88.04.02 % loadt (concat ml_dir_pathname `prim_rec.ml`);; % Create an induction tactic for :num % let INDUCT_TAC = INDUCT_THEN (theorem `num` `INDUCTION`) ASSUME_TAC;; % Create a tactic for list induction. % let LIST_INDUCT_TAC = INDUCT_THEN list_INDUCT ASSUME_TAC;; % --------------------------------------------------------------------- % % Define a one-to-one coding function from (num)list -> num: % % % % The coding function used will be iteration of (2n + 1) (2 ^ p)... % % --------------------------------------------------------------------- % % First a few arithmetic lemmas: % let arith_lemma = TAC_PROOF( ([], "!p q n m. p < q ==> ~(((SUC(n + n)) * (2 EXP p)) = ((SUC(m + m)) * (2 EXP q)))"), REPEAT GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN CONV_TAC (REDEPTH_CONV num_CONV) THEN MAP_EVERY ONCE_REWRITE_TAC [[ADD_SYM];[EXP_ADD]] THEN REWRITE_TAC [MULT_ASSOC;MULT_EXP_MONO] THEN REWRITE_TAC [EXP_ADD;MULT_ASSOC;EXP] THEN REWRITE_TAC [MULT_CLAUSES;ADD_CLAUSES] THEN MATCH_ACCEPT_TAC NOT_ODD_EQ_EVEN);; % The next two theorems state that the function (2n + 1)(2 ^ p) is 1-1 % let fun_11_1 = TAC_PROOF( ([], "!p q n m. ((SUC(n + n)) * (2 EXP p) = (SUC(m + m)) * (2 EXP q)) ==> (p = q)"), REPEAT STRIP_TAC THEN FIRST_ASSUM (ASSUME_TAC o SYM) THEN IMP_RES_TAC (REWRITE_RULE [] ((CONV_RULE CONTRAPOS_CONV) (SPEC_ALL arith_lemma))) THEN STRIP_ASSUME_TAC (REWRITE_RULE [LESS_OR_EQ] (SPECL ["q:num";"p:num"] LESS_CASES)) THEN RES_TAC);; let fun_11_2 = TAC_PROOF( ([], "!p q n m. ((SUC(n + n)) * (2 EXP p) = (SUC(m + m)) * (2 EXP q)) ==> (n = m)"), REPEAT STRIP_TAC THEN IMP_RES_THEN SUBST_ALL_TAC fun_11_1 THEN POP_ASSUM (MP_TAC o (CONV_RULE (DEPTH_CONV num_CONV))) THEN REWRITE_TAC [MULT_EXP_MONO;INV_SUC_EQ] THEN MAP_EVERY SPEC_TAC ["m:num","m:num";"n:num","n:num"] THEN REPEAT (INDUCT_TAC THEN REWRITE_TAC [ADD_CLAUSES]) THENL [REWRITE_TAC [NOT_EQ_SYM(SPEC_ALL NOT_SUC)]; REWRITE_TAC [NOT_SUC]; ASM_REWRITE_TAC [INV_SUC_EQ]]);; % --------------------------------------------------------------------- % % Representation of trees ---- :num. % % --------------------------------------------------------------------- % % The representation type for trees is: ":num". % let ty = ":num";; % node_REP: makes a tree representation from a tree representation list.% % The idea is that the term "node [t1;t2;t3;t4...]" represents the tree % % with branches represented by t1, t2, ... etc. % % node_REP is defined using the coding function above... % let node_REP = new_recursive_definition false list_Axiom `node_REP` "(node_REP NIL = 0) /\ (node_REP (CONS h t) = ((SUC(h+h)) * (2 EXP (node_REP t))))";; % Prove that node_REP is one-to-one: % let node_REP_one_one = TAC_PROOF(([], "!l1 l2. (node_REP l1 = node_REP l2) = (l1 = l2)"), LIST_INDUCT_TAC THENL [LIST_INDUCT_TAC THEN REWRITE_TAC [node_REP;NOT_NIL_CONS] THEN CONV_TAC (DEPTH_CONV num_CONV) THEN REWRITE_TAC [REWRITE_RULE [MULT_CLAUSES] (SPECL ["p:num";"q:num";"0"] MULT_EXP_MONO)] THEN REWRITE_TAC [NOT_EQ_SYM (SPEC_ALL NOT_SUC)]; GEN_TAC THEN LIST_INDUCT_TAC THENL [REWRITE_TAC [node_REP;NOT_CONS_NIL] THEN CONV_TAC (DEPTH_CONV num_CONV) THEN REWRITE_TAC [REWRITE_RULE [MULT_CLAUSES] (SPECL ["p:num";"q:num";"n:num";"0"] MULT_EXP_MONO)] THEN REWRITE_TAC [NOT_SUC]; REWRITE_TAC [node_REP;CONS_11] THEN MAP_EVERY POP_ASSUM [K ALL_TAC; SUBST1_TAC o SYM o SPEC_ALL] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [IMP_RES_TAC fun_11_2; IMP_RES_TAC fun_11_1; ASM_REWRITE_TAC []]]]);; % --------------------------------------------------------------------- % % DEFINITION of the subset of ":num" that will represent trees... % % .... and related theorems. % % --------------------------------------------------------------------- % % Definition of valid tree representations. Is_tree_REP is true of % % anything constructed by "node_REP". % let Is_tree_REP = new_definition (`Is_tree_REP`, "Is_tree_REP = \t:^ty. !P. (!tl. ALL_EL P tl ==> P(node_REP tl)) ==> P t");; % A little lemma about ALL_EL and Is_tree_REP. % let ALL_EL_Is_tree_REP = TAC_PROOF( ([], "!trl. ALL_EL Is_tree_REP trl = !P. ALL_EL (\t.(!tl. ALL_EL P tl ==> P(node_REP tl)) ==> P t) trl"), REWRITE_TAC [Is_tree_REP] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ALL_EL] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC THEN ASM_REWRITE_TAC[]);; % Show that if ALL_EL Is_tree_REP trl then Is_tree_REP (node_REP v trl). % let Is_tree_lemma1 = TAC_PROOF (([], "!trl. ALL_EL Is_tree_REP trl ==> Is_tree_REP (node_REP trl)"), REWRITE_TAC [Is_tree_REP;ALL_EL_Is_tree_REP] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN GEN_TAC THEN DISCH_THEN (\thm. REPEAT STRIP_TAC THEN MP_TAC (SPEC_ALL thm)) THEN ASM_REWRITE_TAC [ETA_AX]);; % A little propositional tautology: % let taut1 = TAC_PROOF(([], "!a b. ~(a ==> b) = (a /\ ~b)"), REWRITE_TAC [IMP_DISJ_THM;DE_MORGAN_THM]);; % Show that if t is a tree then it must be of the form "node_REP tl" for% % some v:* and tl (where each object in tl staifies Is_tree_REP). % let Is_tree_lemma2 = TAC_PROOF( ([], "!t. Is_tree_REP t ==> ?trl. ALL_EL Is_tree_REP trl /\ (t = node_REP trl)"), GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN SUBST1_TAC (RIGHT_BETA (AP_THM Is_tree_REP "t:^ty")) THEN CONV_TAC (REDEPTH_CONV NOT_EXISTS_CONV) THEN CONV_TAC (DEPTH_CONV NOT_FORALL_CONV) THEN DISCH_TAC THEN EXISTS_TAC "\x:^ty. ?tl. ALL_EL Is_tree_REP tl /\ (x = node_REP tl)" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [taut1] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "tl:^ty list" THEN POP_ASSUM MP_TAC THEN POP_ASSUM (K ALL_TAC) THEN SPEC_TAC ("tl:^ty list","tl:^ty list") THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ALL_EL] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC Is_tree_lemma1 THEN RES_TAC THEN ASM_REWRITE_TAC[]; RES_TAC THEN FIRST_ASSUM ACCEPT_TAC]; RES_TAC]);; % Show that Is_tree_REP(node_REP tl) ==> ALL_EL Is_tree_REP tl % let Is_tree_lemma3 = let spec = SPEC "node_REP tl" Is_tree_lemma2 in let rew1 = REWRITE_RULE [node_REP_one_one] spec in let [t1;t2] = CONJUNCTS (SELECT_RULE (UNDISCH rew1)) in GEN_ALL(DISCH_ALL (SUBS [SYM t2] t1));; % Main result... of the past few lemmas. % % Show that !v tl. Is_tree_REP (node_REP v tl) = ALL_EL Is_tree_REP tl % let Is_tree_lemma4 = TAC_PROOF(([], "!tl. Is_tree_REP (node_REP tl) = ALL_EL Is_tree_REP tl"), REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [IMP_RES_TAC Is_tree_lemma3; IMP_RES_TAC Is_tree_lemma1 THEN POP_ASSUM MATCH_ACCEPT_TAC]);; % Show that a tree representation exists. % let Exists_tree_REP = TAC_PROOF(([], "?t:^ty. Is_tree_REP t"), EXISTS_TAC "node_REP NIL" THEN REWRITE_TAC [Is_tree_REP] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN GEN_TAC THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC [ALL_EL]);; % --------------------------------------------------------------------- % % Introduction of the new type of trees. % % --------------------------------------------------------------------- % % Define the new type. % let tree_TY_DEF = new_type_definition (`tree`, rator(snd(dest_exists(concl Exists_tree_REP))), Exists_tree_REP);; % --------------------------------------------------------------------- % % Define a representation function, REP_tree, from the type tree to % % the representing type, and the inverse abstraction % % function ABS_tree, and prove some trivial lemmas about them. % % --------------------------------------------------------------------- % let tree_ISO_DEF = define_new_type_bijections `tree_ISO_DEF` `ABS_tree` `REP_tree` tree_TY_DEF;; let R_11 = prove_rep_fn_one_one tree_ISO_DEF and R_ONTO = prove_rep_fn_onto tree_ISO_DEF and A_11 = prove_abs_fn_one_one tree_ISO_DEF and A_ONTO = prove_abs_fn_onto tree_ISO_DEF and A_R = CONJUNCT1 tree_ISO_DEF and R_A = CONJUNCT2 tree_ISO_DEF;; % Definition of node -- the constructor for trees. % let node = new_definition (`node`, "node tl = (ABS_tree (node_REP (MAP REP_tree tl)))");; % Definition of dest_node: inverse of node. % let dest_node = new_definition (`dest_node`, "!t. dest_node t = @p. t = node p");; % --------------------------------------------------------------------- % % Several lemmas about ABS and REP follow... % % --------------------------------------------------------------------- % let IS_REP_lemma = TAC_PROOF(([], "!tl.ALL_EL Is_tree_REP (MAP REP_tree (tl:(tree)list))"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;ALL_EL;R_ONTO] THEN STRIP_TAC THEN EXISTS_TAC "h:tree" THEN REFL_TAC);; % Prove that REP(ABS x) = x. % let REP_ABS_lemma = TAC_PROOF( ([], "!tl. REP_tree(node tl) = (node_REP (MAP REP_tree tl))"), REWRITE_TAC [node;SYM(SPEC_ALL R_A)] THEN REPEAT GEN_TAC THEN REWRITE_TAC [Is_tree_lemma4] THEN SPEC_TAC ("tl:(tree)list","tl:(tree)list") THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;ALL_EL;R_ONTO] THEN GEN_TAC THEN EXISTS_TAC "h:tree" THEN REFL_TAC);; let ABS_REP = TAC_PROOF( ([], "!tl. Is_tree_REP (node_REP (MAP REP_tree tl))"), REWRITE_TAC [Is_tree_lemma4] THEN MATCH_ACCEPT_TAC IS_REP_lemma);; let ABS_11_lemma = let a11 = SPECL ["node_REP (MAP REP_tree tl1)"; "node_REP (MAP REP_tree tl2)"] A_11 in REWRITE_RULE [ABS_REP] a11;; % Prove that node is one-to-one... save this theorem. % let node_11 = prove_thm (`node_11`, "!tl1 tl2. (node tl1 = node tl2) = (tl1 = tl2)", REWRITE_TAC [node;ABS_11_lemma;node_REP_one_one] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC [] THEN POP_ASSUM MP_TAC THEN MAP_EVERY SPEC_TAC [("tl1:(tree)list","tl1:(tree)list"); ("tl2:(tree)list","tl2:(tree)list")] THEN LIST_INDUCT_TAC THENL [LIST_INDUCT_TAC THEN REWRITE_TAC [MAP;NOT_CONS_NIL]; GEN_TAC THEN LIST_INDUCT_TAC THENL [REWRITE_TAC [MAP;NOT_EQ_SYM(SPEC_ALL NOT_CONS_NIL)]; ASM_REWRITE_TAC [MAP;CONS_11;R_11] THEN REPEAT STRIP_TAC THEN RES_TAC THEN FIRST_ASSUM ACCEPT_TAC]]);; % Some more lemmas about ABS and REP.... % let A_R_list = TAC_PROOF(([], "!tl:(tree)list. tl = MAP ABS_tree (MAP REP_tree tl)"), LIST_INDUCT_TAC THEN REWRITE_TAC [MAP;A_R;CONS_11] THEN POP_ASSUM ACCEPT_TAC);; let R_A_R = TAC_PROOF(([], "REP_tree(ABS_tree(REP_tree (t:tree))) = (REP_tree t)"), REWRITE_TAC [SYM(SPEC_ALL R_A)] THEN REWRITE_TAC [R_ONTO] THEN EXISTS_TAC "t:tree" THEN REFL_TAC);; let Is_R = TAC_PROOF(([], "Is_tree_REP (REP_tree (t:tree))"), REWRITE_TAC [R_ONTO] THEN EXISTS_TAC "t:tree" THEN REFL_TAC);; let R_A_R_list = TAC_PROOF( ([], "!tl:(tree)list. MAP REP_tree (MAP ABS_tree (MAP REP_tree tl)) = (MAP REP_tree tl)"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;R_A_R]);; let A_ONTO_list = TAC_PROOF(([], "!tl:(tree)list. ?trl. ((tl = MAP ABS_tree trl) /\ (ALL_EL Is_tree_REP trl))"), LIST_INDUCT_TAC THENL [EXISTS_TAC "NIL:(^ty)list" THEN REWRITE_TAC [MAP;ALL_EL]; POP_ASSUM STRIP_ASSUME_TAC THEN STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "h:tree" A_ONTO) THEN EXISTS_TAC "CONS (r:^ty) trl" THEN ASM_REWRITE_TAC [CONS_11;MAP;ALL_EL]]);; let R_ONTO_list = TAC_PROOF( ([], "!trl:(^ty)list. ALL_EL Is_tree_REP trl ==> ?tl. trl = MAP REP_tree tl"), LIST_INDUCT_TAC THENL [DISCH_TAC THEN EXISTS_TAC "NIL:(tree)list" THEN REWRITE_TAC [MAP]; REWRITE_TAC [ALL_EL;R_ONTO] THEN REPEAT STRIP_TAC THEN RES_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC "CONS (a:tree) tl" THEN ASM_REWRITE_TAC [MAP]]);; let R_A_list = TAC_PROOF( ([], "!trl. ALL_EL Is_tree_REP (trl:(^ty)list) ==> (MAP REP_tree (MAP ABS_tree trl) = trl)"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [ALL_EL;MAP;R_A] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; % Two lemmas showing how induction on trees relates to induction on % % tree representations.... % let induct_lemma1 = TAC_PROOF( ([], "(!tl. ALL_EL P tl ==> (P(node tl))) = (!trl. ALL_EL Is_tree_REP trl ==> ALL_EL (\x.P(ABS_tree x)) trl ==> ((\x.P(ABS_tree x)) (node_REP trl)))"), let ALL_EL_MAP = TAC_PROOF(([], "!l P f.ALL_EL P (MAP (f:*->**) (l:(*)list)) = ALL_EL (\x.P(f x)) l"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC) in EQ_TAC THENL [DISCH_TAC THEN GEN_TAC THEN DISCH_THEN ((STRIP_THM_THEN SUBST1_TAC) o (MATCH_MP R_ONTO_list)) THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [SYM(SPEC_ALL ALL_EL_MAP);SYM(SPEC_ALL A_R_list)] THEN ASM_REWRITE_TAC [SYM(SPEC_ALL node)]; DISCH_TAC THEN GEN_TAC THEN STRIP_ASSUME_TAC (SPEC_ALL A_ONTO_list) THEN FIRST_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC [node;ALL_EL_MAP] THEN IMP_RES_TAC R_A_list THEN REPEAT STRIP_TAC THEN RES_TAC THEN POP_ASSUM (MP_TAC o CONV_RULE BETA_CONV) THEN ASM_REWRITE_TAC []]);; let induct_lemma2 = TAC_PROOF( ([], "(!t:tree. P t:bool) = (!rep. Is_tree_REP rep ==> (\r. Is_tree_REP r /\ ((\x.P(ABS_tree x)) r)) rep)"), CONV_TAC (DEPTH_CONV BETA_CONV) THEN EQ_TAC THENL [CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [R_ONTO] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "a:tree" THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC [A_R]]; CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "t:tree" A_ONTO) THEN RES_TAC THEN ASM_REWRITE_TAC[]]);; % Induction on trees. % let tree_Induct = prove_thm (`tree_Induct`, "!P. (!tl. ALL_EL P tl ==> P (node tl)) ==> !t. P t", REWRITE_TAC [induct_lemma1;induct_lemma2] THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN let is_thm = RIGHT_BETA (AP_THM Is_tree_REP "trep:^ty") in DISCH_THEN (MATCH_MP_TAC o (REWRITE_RULE [is_thm])) THEN REWRITE_TAC [ALL_EL_CONJ] THEN REPEAT STRIP_TAC THEN CONV_TAC BETA_CONV THEN RES_TAC THEN ASM_REWRITE_TAC [Is_tree_lemma4]);; % --------------------------------------------------------------------- % % tree_INDUCT: thm -> thm % % % % A |- !tl. ALL_EL \t.P[t] tl ==> P[node tl] % % ======================================================= % % A |- !t. P[t] % % % % --------------------------------------------------------------------- % let tree_INDUCT th = (let (tl,body) = dest_forall(concl th) in let (asm,con) = (dest_imp body) in let ALL_EL,[P;tll] = strip_comb asm in let b = genvar bool_ty in let concth = SYM(RIGHT_BETA(REFL "^P(node ^tl)")) and IND = SPEC P tree_Induct and th' = (SPEC tl th) in let th1 = SUBST [concth,b] "^(concl th') = (ALL_EL ^P ^tl ==> ^b)" (REFL (concl th')) in let th2 = GEN tl (EQ_MP th1 th') in CONV_RULE (ONCE_DEPTH_CONV BETA_CONV) (MP IND th2)?failwith `tree_INDUCT`);; % --------------------------------------------------------------------- % % % % tree_INDUCT_TAC % % % % [A] !t.P[t] % % ================================ % % [A,ALL_EL \t.P[t] trl] |- P[node trl] % % % % --------------------------------------------------------------------- % let tree_INDUCT_TAC (A,term) = (let t,body = dest_forall term in let t' = variant ((frees term) @ (freesl A)) t in let body' = subst [t',t] body in let trl = variant ((frees body') @ (freesl A)) "trl:(tree)list" in let asm = "ALL_EL (\^t'.^body') trl" in ([ (asm.A, subst["node ^trl",t']body')], \[thm]. tree_INDUCT (GEN trl (DISCH asm thm))) ) ? failwith `tree_INDUCT_TAC`;; % --------------------------------------------------------------------- % % Definition of a height function on trees... % % % % --------------------------------------------------------------------- % % First, define a relation "bht n tr" which is true if tr has height % % bounded by n. I.e. bht n tr = height of tr <= n. % let bht = new_definition (`bht`, "bht = PRIM_REC (\tr. tr = node NIL) (\res n. \tr. ?trl. (tr = node trl) /\ ALL_EL res trl)");; % show that bht has the following recursive definition: % let bht_thm = TAC_PROOF( ([], "(bht 0 tr = (tr = node NIL)) /\ (bht (SUC n) tr = ?trl. (tr = node trl) /\ ALL_EL (bht n) trl)"), PURE_REWRITE_TAC [bht;PRIM_REC_THM] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN REFL_TAC);; % Show that if height t <= n then height t <= (SUC n) % let bht_lemma1 = TAC_PROOF(([], "!n. !tr:tree. bht n tr ==> bht (SUC n) tr"), INDUCT_TAC THENL [REWRITE_TAC [bht_thm] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "NIL:(tree)list" THEN ASM_REWRITE_TAC [ALL_EL]; ONCE_REWRITE_TAC [bht_thm] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "trl:(tree)list" THEN ASM_REWRITE_TAC [] THEN MAP_EVERY POP_ASSUM [MP_TAC;K ALL_TAC] THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN REPEAT STRIP_TAC THEN RES_TAC]);; % show that if height tr <= n then height tr <= n+m % let bht_lemma2 = (GEN_ALL o DISCH_ALL o GEN "m:num" o UNDISCH o SPEC_ALL) (TAC_PROOF(([], "!m n. !tr:tree. bht n tr ==> bht (n+m) tr"), INDUCT_TAC THEN REWRITE_TAC [ADD_CLAUSES] THEN REPEAT STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC bht_lemma1));; % show that height bounds for all the trees in a list implies a single % % bound for all the trees in the list. % let bht_lemma3 = TAC_PROOF( ([],"!trl.ALL_EL (\tr:tree.?n.bht n tr) trl ==> ?n. ALL_EL (bht n) trl"), LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN POP_ASSUM STRIP_ASSUME_TAC THEN EXISTS_TAC "n+n'" THEN STRIP_TAC THENL [IMP_RES_TAC bht_lemma2 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM MP_TAC THEN REPEAT (POP_ASSUM (K ALL_TAC)) THEN ONCE_REWRITE_TAC [ADD_SYM] THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN REPEAT STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC bht_lemma2 THEN POP_ASSUM MATCH_ACCEPT_TAC]);; % show that there always exists an n such that height tr <= n. % let exists_bht = TAC_PROOF(([], "!tr:tree. ?n. bht n tr"), tree_INDUCT_TAC THEN POP_ASSUM (STRIP_ASSUME_TAC o MATCH_MP bht_lemma3) THEN EXISTS_TAC "SUC n" THEN REWRITE_TAC [bht_thm] THEN EXISTS_TAC "trl:(tree)list" THEN ASM_REWRITE_TAC[]);; % Show that there is always a minimum bound on the height of a tree. % let min_bht = CONV_RULE (DEPTH_CONV BETA_CONV) (TAC_PROOF( ([], "!t:tree.?n.(\n. bht n t)n /\ (!m. m < n ==> ~((\n. bht n t)m))"), GEN_TAC THEN MATCH_MP_TAC WOP THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN MATCH_ACCEPT_TAC exists_bht));; % We can now define our hieght function as follows: % let HT = new_definition (`HT`, "HT (t:tree) = @n. bht n t /\ (!m. m < n ==> ~bht m t)");; % A number of theorems about HT follow: % % The main thing is to show that: % % 1) !tl. ALL_EL (\t. HT t < HT(node tl)) tl % % 2) !trl. (HT (node trl) = 0) = (trl = NIL) % let HT_thm1 = TAC_PROOF(([], "!tr:tree. bht (HT tr) tr"), REWRITE_TAC [HT] THEN GEN_TAC THEN STRIP_ASSUME_TAC (SELECT_RULE (SPEC "tr:tree" min_bht)));; let HT_thm2 = TAC_PROOF(([], "!tr:tree.!m. m < (HT tr) ==> ~bht m tr"), REWRITE_TAC [HT] THEN GEN_TAC THEN STRIP_ASSUME_TAC (SELECT_RULE (SPEC "tr:tree" min_bht)));; % A Key result about HT. % let HT_leaf = TAC_PROOF(([], "!trl. (HT (node trl) = 0) = (trl = NIL)"), REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN MP_TAC (SPEC "node trl" HT_thm1) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC [bht_thm;node_11] THEN STRIP_TAC; DISCH_THEN SUBST1_TAC THEN STRIP_ASSUME_TAC (SPEC "HT(node NIL)" num_CASES) THEN MP_TAC (SPEC "node NIL" HT_thm2) THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC [NOT_SUC] THEN CONV_TAC NOT_FORALL_CONV THEN REWRITE_TAC [taut1] THEN EXISTS_TAC "0" THEN REWRITE_TAC [bht_thm;LESS_0]]);; let HT_thm3 = TAC_PROOF(([], "!m. !tr:tree. (~bht m tr) ==> m < (HT tr)"), CONV_TAC (ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN REWRITE_TAC [NOT_LESS;LESS_OR_EQ] THEN REPEAT STRIP_TAC THENL [POP_ASSUM ((STRIP_THM_THEN SUBST1_TAC) o MATCH_MP LESS_ADD_1) THEN STRIP_ASSUME_TAC (SPEC "tr:tree" HT_thm1) THEN IMP_RES_TAC bht_lemma2 THEN POP_ASSUM MATCH_ACCEPT_TAC; POP_ASSUM (SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC HT_thm1]);; let HT_thm4 = TAC_PROOF(([], "!tr:tree. !m. m < (HT tr) = ~bht m tr"), REPEAT STRIP_TAC THEN EQ_TAC THENL (map MATCH_ACCEPT_TAC [HT_thm2;HT_thm3]));; % TFM: fixed error "tl" for "trl" after quantifier. 88.11.17 % let HT_thm5 = TAC_PROOF( ([], "!n tl h. ~bht n (node tl) ==> ~bht n (node (CONS h tl))"), CONV_TAC (ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "n:num" num_CASES) THEN ASM_REWRITE_TAC [bht_thm] THEN POP_ASSUM (K ALL_TAC) THENL [REWRITE_TAC [node_11] THEN REPEAT STRIP_TAC THEN POP_ASSUM (MP_TAC o (AP_TERM "NULL:(tree)list->bool")) THEN REWRITE_TAC [NULL]; REWRITE_TAC [node_11] THEN REPEAT STRIP_TAC THEN MAP_EVERY POP_ASSUM [MP_TAC;SUBST1_TAC o SYM] THEN REWRITE_TAC [ALL_EL] THEN STRIP_TAC THEN EXISTS_TAC "tl:tree list" THEN ASM_REWRITE_TAC []]);; let HT_thm6 = TAC_PROOF( ([], "!trl tl. !t:tree. ALL_EL (\t. ~bht (HT t) (node tl)) trl ==> ALL_EL (\t. ~bht (HT t) (node (CONS h tl))) trl"), LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC HT_thm5;RES_TAC]);; % A Key result about HT. % let HT_node = TAC_PROOF(([], "!tl. ALL_EL (\t. HT t < HT(node tl)) tl"), REWRITE_TAC [HT_thm4] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT GEN_TAC THEN STRIP_TAC THENL [STRIP_ASSUME_TAC (SPEC "HT (h:tree)" num_CASES) THENL [ASM_REWRITE_TAC [bht_thm;node_11;CONS_11] THEN DISCH_THEN (MP_TAC o AP_TERM "NULL:(tree)list->bool") THEN REWRITE_TAC [NULL]; MP_TAC (SPEC "h:tree" HT_thm2) THEN ASM_REWRITE_TAC [bht_thm;ALL_EL;node_11] THEN DISCH_TAC THEN CONV_TAC (REDEPTH_CONV NOT_EXISTS_CONV) THEN ONCE_REWRITE_TAC [DE_MORGAN_THM] THEN ONCE_REWRITE_TAC [SYM(SPEC_ALL IMP_DISJ_THM)] THEN REPEAT GEN_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC [ALL_EL;DE_MORGAN_THM] THEN DISJ1_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC LESS_SUC_REFL]; IMP_RES_THEN MATCH_ACCEPT_TAC HT_thm6]);; % The following lemmas are used in the proof of approx_lemma below: % let Less_lemma = TAC_PROOF(([], "!n m. (n < SUC m) = (n <= m)"), REWRITE_TAC [LESS_OR_EQ] THEN CONV_TAC (ONCE_DEPTH_CONV (REWR_CONV DISJ_SYM)) THEN MATCH_ACCEPT_TAC LESS_THM);; let less_HT = TAC_PROOF(([], "!trl m n. (m <= n) ==> ALL_EL (\t. HT t < m) trl ==> ALL_EL (\t:tree. HT t <= n) trl"), LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_TAC LESS_EQ_TRANS; RES_TAC]);; let less_HT2 = TAC_PROOF( ([], "!trl n. HT(node trl) < n ==> ALL_EL (\t. HT t < n) trl"), REPEAT GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN MP_TAC (SPEC "trl:(tree)list" HT_node) THEN SPEC_TAC ("HT(node trl)","n:num") THEN REWRITE_TAC [ADD_CLAUSES;num_CONV "1"] THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN STRIP_ASSUME_TAC (REWRITE_RULE [LESS_OR_EQ] (SPECL ["n:num";"p:num"] LESS_EQ_ADD)) THENL [IMP_RES_TAC LESS_TRANS; POP_ASSUM (SUBST1_TAC o SYM)] THEN IMP_RES_TAC LESS_SUC);; let less_HT3 = TAC_PROOF( ([],"!trl. (HT(node trl) <= HT(node (CONS (node trl) NIL)))"), REPEAT STRIP_TAC THEN MP_TAC (SPEC "CONS (node trl) NIL" HT_node) THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ);; % Following proof revised for version 1.12 resolution. [TFM 91.01.18] % let less_HT4 = TAC_PROOF (([], "!trl m n. (m <= n) ==> ALL_EL (\t. HT t < m) trl ==> ALL_EL (\t:tree. HT t < n) trl"), PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN REPEAT GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN (\th g. SUBST1_TAC th g ? MP_TAC th g)) THENL [MAP_EVERY (\t. SPEC_TAC(t,t)) ["n:num";"m:num";"trl:(tree)list"] THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC LESS_TRANS; RES_TAC]; DISCH_THEN ACCEPT_TAC]);; let less_HT5 = let spec = SPEC "CONS (h:tree) NIL" HT_node in let rew = CONV_RULE (DEPTH_CONV BETA_CONV) (REWRITE_RULE [ALL_EL] spec) in GEN_ALL rew;; let less_HT6 = let spec = SPEC "CONS (h:tree) trl" HT_node in let rew = CONV_RULE (DEPTH_CONV BETA_CONV) (REWRITE_RULE [ALL_EL] spec) in let less1 = CONJUNCT1(SPEC_ALL rew) in let spec2 = SPEC "node (CONS h trl)" (GEN_ALL less_HT5) in GEN_ALL(MATCH_MP LESS_TRANS (CONJ less1 spec2));; let less_HT7 = let less1 = (SPEC_ALL HT_node) in let less2 = (SPEC_ALL less_HT3) in (MATCH_MP (GEN_ALL(MATCH_MP less_HT4 less2)) less1);; let less_HT8 = let sp = REWRITE_RULE [ALL_EL] (SPEC "CONS (h:tree) trl" (GEN_ALL less_HT7)) in (CONJUNCT2 sp);; % Show that dest is the destructor for node. % let dest_node_thm = TAC_PROOF(([], "!tl. dest_node (node tl) = tl"), REWRITE_TAC [dest_node;node_11] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "tl:(tree)list" THEN REFL_TAC);; % we now show that for all n there is a recursive function that works % % as desired for trees of height <= n. % let approx_lemma = TAC_PROOF (([], "!f. !n. ?fn. !trl. (HT(node trl) <= n) ==> (fn (node trl) = f (MAP fn trl):**)"), GEN_TAC THEN INDUCT_TAC THENL [REWRITE_TAC [NOT_LESS_0;LESS_OR_EQ;HT_leaf] THEN EXISTS_TAC "\t:tree. f (NIL:(**)list):**" THEN REPEAT (STRIP_GOAL_THEN SUBST1_TAC) THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [MAP]; POP_ASSUM STRIP_ASSUME_TAC THEN REWRITE_TAC [LESS_OR_EQ] THEN REWRITE_TAC [Less_lemma] THEN EXISTS_TAC "\t:tree. ((HT t) <= n) => (fn t:**) | f(MAP fn (dest_node t))" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [dest_node_thm] THEN REPEAT STRIP_TAC THENL [RES_TAC THEN ASM_REWRITE_TAC [] THEN ASSUME_TAC (SPEC "trl:(tree)list" HT_node) THEN IMP_RES_TAC less_HT THEN POP_ASSUM MP_TAC THEN POP_ASSUM_LIST (K ALL_TAC) THEN DISCH_THEN (\th. AP_TERM_TAC THEN MP_TAC th) THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL;MAP] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]; MP_TAC (SPEC "trl:(tree)list" HT_node) THEN ASM_REWRITE_TAC [Less_lemma;SYM(SPEC_ALL LESS_EQ);LESS_REFL] THEN POP_ASSUM_LIST (K ALL_TAC) THEN DISCH_THEN (\th. AP_TERM_TAC THEN MP_TAC th) THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL;MAP] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]]]);; % Now, define tree_rec_fun n f to be the function that works for trees % % shorter than n. % let trf = new_definition (`trf`, "trf n f = @fn. !trl. (HT(node trl)) <= n ==> (fn(node trl):** = f(MAP fn trl))");; % Prove that trf has the appropriate property. % let trf_thm = TAC_PROOF(([], "!f n trl. (HT (node trl)) <= n ==> (trf n f (node trl):** = f(MAP (trf n f) trl))"), REWRITE_TAC [trf] THEN CONV_TAC (DEPTH_CONV SELECT_CONV) THEN MATCH_ACCEPT_TAC approx_lemma);; % show that trf n f = trf m f for trees shorter than n amd m. % let trf_EQ_thm = TAC_PROOF(([], "!t:tree. !n m f. HT(t) < n /\ HT(t) < m ==> (trf n f t:** = trf m f t)"), tree_INDUCT_TAC THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_IMP_LESS_OR_EQ THEN IMP_RES_THEN (SUBST1_TAC o SPEC_ALL) trf_thm THEN AP_TERM_TAC THEN MAP_EVERY POP_ASSUM [K ALL_TAC;K ALL_TAC] THEN REPEAT (POP_ASSUM (MP_TAC o MATCH_MP less_HT2)) THEN POP_ASSUM MP_TAC THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MAP;ALL_EL] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN GEN_TAC THEN CONV_TAC ANTE_CONJ_CONV THEN DISCH_THEN (\th. ASSUME_TAC th THEN REPEAT STRIP_TAC THEN MP_TAC (SPECL ["n:num";"m:num";"f:(**)list->**"] th)) THEN RES_TAC THEN POP_ASSUM SUBST1_TAC THEN REWRITE_TAC [CONS_11] THEN STRIP_TAC THEN RES_TAC THEN FIRST_ASSUM ACCEPT_TAC);; % extend the above result for lists of trees. % let trf_EQ_thm2 = TAC_PROOF( ([], "!trl:(tree)list. !n m f. (ALL_EL (\t. HT t < n) trl /\ ALL_EL (\t. HT t < m) trl) ==> (MAP (trf n f) trl:(**)list = MAP(trf m f) trl)"), LIST_INDUCT_TAC THEN REWRITE_TAC [MAP;ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN IMP_RES_THEN (ASSUME_TAC o SPEC_ALL) trf_EQ_thm THEN RES_TAC THEN REWRITE_TAC [CONS_11] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; % Now, by taking "\t. trf (HT (node [t])) f t" we have a function that % % works for all trees t. % let FN_EXISTS = TAC_PROOF( ([], "!f. ?fn. !trl. (fn (node trl):** = f (MAP fn trl))"), STRIP_TAC THEN EXISTS_TAC "\t. trf (HT(node (CONS t NIL))) (f:(**)list->**) t" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN ASSUME_TAC (SPEC "trl:(tree)list" less_HT3) THEN IMP_RES_THEN (SUBST1_TAC o SPEC_ALL) trf_thm THEN POP_ASSUM (K ALL_TAC) THEN AP_TERM_TAC THEN SPEC_TAC ("trl:(tree)list","trl:(tree)list") THEN LIST_INDUCT_TAC THEN REWRITE_TAC [ALL_EL;MAP] THEN REPEAT STRIP_TAC THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [CONS_11] THEN STRIP_TAC THENL [MATCH_MP_TAC trf_EQ_thm THEN STRIP_TAC THENL [MATCH_ACCEPT_TAC less_HT6; MATCH_ACCEPT_TAC less_HT5]; FIRST_ASSUM (SUBST1_TAC o SYM) THEN MATCH_MP_TAC trf_EQ_thm2 THEN STRIP_TAC THENL [ACCEPT_TAC less_HT8; MATCH_ACCEPT_TAC (GEN_ALL less_HT7)]]);; % Now show that there is a function that produces the desired tree % % recursive function, given f. % let FN_thm = TAC_PROOF (([], "?FN. !f. !trl. ((FN f) (node trl) = f (MAP (FN f) trl):**)"), EXISTS_TAC "\f. @fn. !trl. (fn(node trl):** = f(MAP fn trl))" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN CONV_TAC (DEPTH_CONV SELECT_CONV) THEN MATCH_ACCEPT_TAC FN_EXISTS);; % Prove the existence of a certain function AP. % let AP = prove_rec_fn_exists list_Axiom "(!l. AP NIL l = NIL) /\ (!h t l. AP (CONS h t) l = CONS (h (HD l:*):**) (AP t (TL l)))";; % Got to have the types just right for use of AP below. % let AP = INST_TYPE [":tree",":*"] AP;; let AP_DEF = conjuncts(snd(dest_exists(concl AP)));; % A lemma about AP and MAP. % let AP_MAP = TAC_PROOF((AP_DEF, "!l. AP (MAP (f:tree->tree->**) l) l = MAP (\x. f x x) l"), LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [MAP;HD;TL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN REFL_TAC);; % Now, prove the existence of the recursively defined functions. % let EXISTS_THM = TAC_PROOF( ([], "!f. ?fn. !tl. fn (node tl):** = f (MAP fn tl) tl"), STRIP_TAC THEN STRIP_ASSUME_TAC (INST_TYPE [":tree->**",":**"] FN_thm) THEN STRIP_ASSUME_TAC AP THEN let fn = "\n:tree. ((FN (\fnl:(tree->**)list.\n:tree. f (AP fnl (dest_node n):(**)list) (dest_node n):**)) (n:tree) (n:tree):**)" in EXISTS_TAC fn THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC [] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [dest_node_thm;AP_MAP]);; % A little lemma... % let lemma = TAC_PROOF(([],"!l. ALL_EL (\x:*. f x:** = g x) l ==> (MAP f l = MAP g l)"), LIST_INDUCT_TAC THEN REWRITE_TAC [MAP;ALL_EL] THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC[]);; % Finally, prove the theorem for trees! % let tree_Axiom = prove_thm (`tree_Axiom`, "!f. ?!fn. !tl. fn (node tl):** = f (MAP fn tl) tl", GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN STRIP_TAC THENL [MATCH_ACCEPT_TAC EXISTS_THM; CONV_TAC (DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN tree_INDUCT_TAC THEN IMP_RES_TAC lemma THEN ASM_REWRITE_TAC []]);; % Close the theory. % close_theory();; quit();; hol88-2.02.19940316/theories/mk_bool.ml0000640000212700021270000004053305134056676015543 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_bool.ml % % % % DESCRIPTION: Definition of HOL (Higher-Order Logic) in PPLAMBDA. % % HOL only has terms - formulae are not a separate type % % but just boolean terms. Load into hol-lcf after % % deleting bool.th. % % % % We represent an HOL theorem: % % % % t1, ... ,tn |- t % % % % as the PPLAMBDA theorem: % % % % HOL_ASSERT(t1), ... ,HOL_ASSERT(tn) |- HOL_ASSERT(t)% % % % where HOL_ASSERT is a predicate of type ":bool". % % % % We provide conventional syntactic sugar for various % % terms of HOL. The parser translates as follows: % % % % "!x.t" --> "!(\x.t)" % % "?x.t" --> "?(\x.t)" % % "@x.t" --> "@(\x.t)" % % "t1 /\ t2" --> "/\ t1 t2" % % "t1 \/ t2" --> "\/ t1 t2" % % "t1 ==> t2" --> "==> t1 t2" % % "t1 <=> t2" --> "<=> t1 t2" % % "t1 = t2" --> "= t1 t2" % % "~ t" --> "~ t" % % "t1,t2" --> ", t1 t2" % % "(t=>t1|t2)" --> "COND t t1 t2" % % % % Other terms are represented by themselves. Predicates % % are just functions with types of the form ":ty->bool".% % % % Note that the only reason we need the translation % % given above is to provide a nicer syntax. Thus, for % % example, instead of: % % % % "!x.?y. P(x,y)" % % % % we could use: % % % % "!(\x. ?(\y. P(x,y)))" % % % % In HOL things like "P(x, !x.Q x)" are allowed. This % % would be represented in PPLAMBDA by the formula: % % % % "HOL_ASSERT(P(x, !(\x.Q x)))" % % % % The function Q would have to be a predicate (i.e. % % have a type of the form ":ty->bool") for this to % % typecheck. % % % % Other syntactic sugar is: % % % % "let x=t1 in t2" --> "LET (\x.t2) t1" % % % % "\(x,y).t" --> "UNCURRY \x.\y.t" % % % % "\(x1,x2,...xn).t" --> "UNCURRY \x1.\(x2,...,xn).t" % % % % and in HOL88 (MJCG 26/1/89): % % % % "let f v1 ... vn = t1 in t2" % % --> "LET (\f.t2) (\v1 ... vn.t1)" % % % % "let (x1,...,xn) = t1 in t2" % % --> "LET (\(x1,...,xn).t2) t1" % % % % "let x1=t1 and ... and xn=tn in t" % % --> "LET ( ... (LET(LET (\x1...xn.t) % % t1)t2) ... ) tn" % % % % PARENTS: PPLAMB.th % % WRITES FILES: bool.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: University of Edinburgh % % COPYRIGHT: University of Cambridge % % COPYRIGHT: INRIA % % % % REVISION HISTORY: (none) % %=============================================================================% new_theory `bool`;; new_parent `PPLAMB`;; paired_new_type(0, `bool`);; new_infix(`=`, ":*->*->bool");; new_predicate(`HOL_ASSERT`, ":bool");; % The axiom below is a a hack to create an arbitrary theorem % % for use in the file ml/hol-syn.ml % new_open_axiom(`ARB_THM`, "HOL_ASSERT(($=:*->*->bool) = ($=:*->*->bool))");; % loads HOL parser and printer for inputting axioms % loadt (concat ml_dir_pathname `hol-in-out`);; new_infix(`==>` , ":bool->bool->bool");; new_predicate(`BINDERS`, ":*");; %Hack for storing binders% new_predicate(`HOL_DEFINITION`, ":bool");; new_binder(`@` , ":(*->bool)->*");; % Definitions % % MJCG for HOL88: Type of x changed to ":bool" to prevent unbound free type variable % % Very temporary hack to get the system to build whilst MJCG thinks about definitions. ? declared as a constant % % new_constant changed to new_binder [TFM 92.01.12] % % new_constant(`?`, ":(*->bool)->bool");; % new_binder(`?`, ":(*->bool)->bool");; new_definition(`T_DEF`, "T = ((\x:bool.x) = (\x:bool.x))");; lisp`(remprop forall-tok 'syn-const)`;; % make ! parse as a variable % new_binder_definition(`FORALL_DEF` , "$! = \P:*->bool. P=(\x.T)");; % Very temporary hack to get the system to build whilst MJCG thinks about definitions. Old code below commented out and replaced by a mk_thm horror. lisp`(remprop exists-tok 'syn-const)`;; make ? parse as a variable new_binder_definition(`EXISTS_DEF` , "$? = \P:*->bool. P($@ P)");; % store_definition(`EXISTS_DEF` , "$? = \P:*->bool. P($@ P)");; lisp`(remprop conj-tok 'syn-const)`;; % make /\ parse as a variable % new_infix_definition(`AND_DEF` , "$/\ = \t1 t2.!t. (t1==>t2==>t)==>t");; lisp`(remprop disj-tok 'syn-const)`;; % make \/ parse as a variable % new_infix_definition(`OR_DEF` , "$\/ = \t1 t2.!t. (t1==>t)==>(t2==>t)==>t");; % --------------------------------------------------------------------- % % IFF deleted: boolean = can be used instead. [TFM 91.01.20] % % % % lisp`(remprop iff-tok 'syn-const)`;; make <=> parse as a variable % % new_infix_definition(`IFF_DEF` , % % "$<=> = \t1 t2. (t1==>t2)/\(t2==>t1)");; % % --------------------------------------------------------------------- % new_definition(`F_DEF` , "F = !t.t");; lisp`(remprop neg-tok 'syn-const)`;; % make ~ parse as a variable % new_definition(`NOT_DEF` , "$~ = \t. t ==> F");; lisp`(remprop '|?!| 'syn-const)`;; % make ?! parse as a variable % new_binder_definition (`EXISTS_UNIQUE_DEF`, "$?! = \P:(*->bool). ($? P) /\ (!x y. ((P x) /\ (P y)) ==> (x=y))");; new_definition(`LET_DEF` , "LET = \f:*->**.\x:*. f x");; new_definition (`COND_DEF` , "COND = \t t1 t2.@x:*.((t=T)==>(x=t1))/\((t=F)==>(x=t2))");; % --------------------------------------------------------------------- % % Definitions to support restricted abstractions and quantifications % % --------------------------------------------------------------------- % new_definition (`RES_FORALL`, "RES_FORALL P B = !x:*. P x ==> B x");; new_definition (`RES_EXISTS`, "RES_EXISTS P B = ?x:*. P x /\ B x");; new_definition (`RES_SELECT`, "RES_SELECT P B = @x:*. P x /\ B x");; new_definition (`ARB`, "ARB = @x:*.T");; new_definition (`RES_ABSTRACT`, "RES_ABSTRACT P B = \x:*. (P x => B x | ARB:**)");; % --------------------------------------------------------------------- % % Relic from LCF_LSM. Deleted. [TFM 91.01.20] % % new_definition % % (`FCOND_DEF` , % % "FCOND = \f.\f1:*->**.\f2:*->**.\x. COND(f x)(f1 x)(f2 x)");; % % --------------------------------------------------------------------- % new_definition (`ONE_ONE_DEF`, "ONE_ONE(f:*->**) = !x1 x2. (f x1 = f x2) ==> (x1 = x2)");; new_definition (`ONTO_DEF`, "ONTO(f:*->**) = !y.?x. y = f x");; % Having "o" as a constant precludes it being used as a variable (e.g. for outputs) new_infix_definition (`o_DEF`, "$o (f:**->***) (g:*->**) x = f(g x)");; % % AXIOMS % map new_axiom [`BOOL_CASES_AX` , "!t:bool. (t=T) \/ (t=F)"; `IMP_ANTISYM_AX` , "!t1 t2. (t1 ==> t2) ==> (t2 ==> t1) ==> (t1 = t2)"; `ETA_AX` , "!t:*->**. (\x. t x) = t"; `SELECT_AX` , "!P:*->bool.!x. P x ==> P($@ P)"];; % --------------------------------------------------------------------- % % version of ==> for coding assumptions of theorems for storing in theories % % DELETED: TFM 90.12.01 % % RESTORED: TFM 90.04.27 % new_infix_definition (`IS_ASSUMPTION_OF`, "!t1 t2. $IS_ASSUMPTION_OF t1 t2 = (t1 ==> t2)");; % Now we set up the theory of pairs. Unfortunately we have to include pairs in the theory bool because new_theory and close_theory use pairing for writing out lists of binders % new_definition (`TYPE_DEFINITION`, "TYPE_DEFINITION (P:*->bool) (rep:**->*) = (!x' x''. (rep x' = rep x'') ==> (x' = x'')) /\ (!x. P x = (?x'. x = rep x'))");; % Definitions of abbrev_ty_def and new_type_definition used to be % % inserted here, but are no longer needed here (TFM 90.04.10) % let MK_PAIR_DEF = new_definition(`MK_PAIR_DEF`, "MK_PAIR(x:*)(y:**) = \a b.(a=x)/\(b=y)");; let IS_PAIR_DEF = new_definition(`IS_PAIR_DEF`, "IS_PAIR p = ?x:*.?y:**. p = MK_PAIR x y");; % We now load in theorem proving infrastructure (that was not already loaded via ml/hol-in-out.ml) as we need to prove that: |- ?p:*->**->bool. IS_PAIR p lisp (concat (concat `(load "` lisp_dir_pathname) `genmacs")`);; loadt (concat ml_dir_pathname `hol-rules`);; loadt (concat ml_dir_pathname `hol-drules`);; loadt (concat ml_dir_pathname `drul`);; loadt (concat ml_dir_pathname `hol-thyfns`);; loadt (concat ml_dir_pathname `tacticals`);; loadt (concat ml_dir_pathname `tacont`);; loadt (concat ml_dir_pathname `tactics`);; loadt (concat ml_dir_pathname `conv`);; loadt (concat ml_dir_pathname `hol-net`);; loadt (concat ml_dir_pathname `rewrite`);; loadt (concat ml_dir_pathname `resolve`);; loadt (concat ml_dir_pathname `goals`);; loadt (concat ml_dir_pathname `stack`);; let PAIR_EXISTS = prove_thm (`PAIR_EXISTS`, "?p:*->**->bool. IS_PAIR p", EXISTS_TAC "MK_PAIR (x:*) (y:**)" THEN REWRITE_TAC[MK_PAIR;IS_PAIR] THEN EXISTS_TAC "x:*" THEN EXISTS_TAC "y:**" THEN REWRITE_TAC[]);; % % Since the theorem proving infrastructure won't load (because "arb" gets bound into various things rather than "F") the following expedient is resorted to. I am working on cleaning this up ... % % save_open_thm renamed to save_thm [TFM 90.12.01] % let PAIR_EXISTS = save_thm(`PAIR_EXISTS`,mk_thm([], "?p:*->**->bool. IS_PAIR p"));; new_type_definition (`prod`, "IS_PAIR:(*->**->bool)->bool", PAIR_EXISTS);; % Added TFM 88.03.31 % % % % needs to be added because new_type_definition now does not define % % REP_prod. % new_definition (`REP_prod`, "REP_prod = @rep:(*,**)prod->(*->**->bool). (!p' p''. (rep p' = rep p'') ==> (p' = p'')) /\ (!p. IS_PAIR (p:*->**->bool) = (?p'. p = rep p'))");; lisp`(remprop pair-tok 'syn-const)`;; % make , parse as a variable % new_infix_definition (`COMMA_DEF`, "$, (x:*) (y:**) = @p. REP_prod p = MK_PAIR x y");; new_definition (`FST_DEF`, "FST(p:(*,**)prod) = @x.?y. MK_PAIR x y = REP_prod p");; new_definition (`SND_DEF`, "SND(p:(*,**)prod) = @y.?x. MK_PAIR x y = REP_prod p");; % --------------------------------------------------------------------- % % The following can be proved, but out of laziness we make them axioms % % save_open_thm renamed to save_thm [TFM 90.12.01] % % --------------------------------------------------------------------- % map (\(tok,t). save_thm(tok, mk_thm([],t))) [`PAIR` , "!x:*#**. (FST x, SND x) = x"; `FST` , "!x:*.!y:**. FST(x,y) = x"; `SND` , "!x:*.!y:**. SND(x,y) = y"];; % The following theorem follows from the above "axioms" for pairs, % % but it's not clear exactly where it ought to be proved. So it's % % added here as an axiom. The proof is: % % % % let PAIR_EQ = % % prove_thm % % (`PAIR_EQ`, % % "(x:*,(y:**) = a,b) = ((x=a) /\ (y=b))", % % EQ_TAC THENL % % [DISCH_THEN \th. % % REWRITE_TAC [REWRITE_RULE [FST] (AP_TERM "FST:*#**->*" th); % % REWRITE_RULE [SND] (AP_TERM "SND:*#**->**" th)]; % % STRIP_TAC THEN ASM_REWRITE_TAC[]]);; % % % % But, of course, a proof can't be run here since tactics etc are not % % yet defined. The whole "pairs" problem (i.e. when to define them) % % needs to be reconsidered. I have a sound definitional theory of % % pairs that can be added when this is done (TFM 88.03.31) % % % % Meanwhile, we just add a theorem. % % % % save_open_thm renamed to save_thm [TFM 90.12.01] % % --------------------------------------------------------------------- % let PAIR_EQ = save_thm (`PAIR_EQ`, (mk_thm([],"!x y a b.(x:*,(y:**) = a,b) = ((x=a) /\ (y=b))")));; % UNCURRY is needed for terms of the form "\(x,y).t" (see above) % new_definition (`UNCURRY_DEF`, "UNCURRY(f:* -> **->***)(x,y) = f x y");; new_definition (`CURRY_DEF`, "CURRY (f:*#** -> ***) x y = f(x,y)");; close_theory();; quit();; hol88-2.02.19940316/theories/mk_fun.ml0000640000212700021270000001005005512567036015364 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.02 % % % % FILE NAME: mk_fun.ml % % % % DESCRIPTION: Creates the theory "fun.th" containing some basic % % definitions of predicates about functions and % % theorems about them. % % % % AUTHOR: W. Wong (02 Jan 94) % % % % PARENTS: BASIC-HOL.th % % WRITES FILES: fun.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % REVISION HISTORY: (none) % %=============================================================================% % Create the new theory. % new_theory `fun`;; %----------------------------------------------------------------% %- Definitions about functions -% %----------------------------------------------------------------% let ASSOC_DEF = new_definition(`ASSOC_DEF`, "!f:*->*->*. ASSOC f = !x y z. f x (f y z) = f (f x y) z");; let COMM_DEF = new_definition(`COMM_DEF`, "!f:*->*->**. COMM f = ! x y. f x y = f y x");; let FCOMM_DEF = new_definition(`FCOMM_DEF`, "!(f:*->**->*) (g:***->*->*). FCOMM f g = !x y z. g x (f y z) = f (g x y) z");; let RIGHT_ID_DEF = new_definition(`RIGHT_ID_DEF`, "RIGHT_ID (f:*->**->*) e = (!x. f x e = x)");; let LEFT_ID_DEF = new_definition(`LEFT_ID_DEF`, "LEFT_ID (f:**->*->*) e = (!x. f e x = x)");; let MONOID_DEF = new_definition(`MONOID_DEF`, "MONOID (f:*->*->*) e = ASSOC f /\ RIGHT_ID f e /\ LEFT_ID f e");; % Close the theory. % close_theory ();; %----------------------------------------------------------------% %- Theorems about functions -% %----------------------------------------------------------------% let ASSOC_CONJ = prove_thm (`ASSOC_CONJ`, "ASSOC $/\", REWRITE_TAC[ASSOC_DEF;CONJ_ASSOC]);; let ASSOC_DISJ = prove_thm (`ASSOC_DISJ`, "ASSOC $\/", REWRITE_TAC[ASSOC_DEF;DISJ_ASSOC]);; let FCOMM_ASSOC = prove_thm (`FCOMM_ASSOC`, "!f:*->*->*. FCOMM f f = ASSOC f", REWRITE_TAC[ASSOC_DEF;FCOMM_DEF]);; %% let MONOID_CONJ_T = prove_thm (`MONOID_CONJ_T`, "MONOID $/\ T", REWRITE_TAC[MONOID_DEF;CONJ_ASSOC;LEFT_ID_DEF;ASSOC_DEF;RIGHT_ID_DEF]);; let MONOID_DISJ_F = prove_thm (`MONOID_DISJ_F`, "MONOID $\/ F", REWRITE_TAC[MONOID_DEF;DISJ_ASSOC;LEFT_ID_DEF;ASSOC_DEF;RIGHT_ID_DEF]);; quit();; hol88-2.02.19940316/theories/mk_list_defs.ml0000640000212700021270000006526505524424747016576 0ustar cammcamm%=============================================================================% % HOL 88 Version 2.0 % % % % FILE NAME: mk_list_defs.ml % % % % DESCRIPTION: Extends the theory list.th with some definitions of % % funstions on lists. % % Some of the definitions was in the file % % mk_list_thms.ml which contains only theorems now. % % % % AUTHORS: T. F. Melham (86.11.24 for the original definitions) % % W. Wong (2 Jan 94 for new definitons) % % % % WRITES FILES: list.th % % % % University of Cambridge % % Hardware Verification Group % % Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % % % COPYRIGHT: T. F. Melham 1987 % % W. Wong 1994 % % % % REVISION HISTORY: (none) % %=============================================================================% % --------------------------------------------------------------------- % % Reopen the theory % % --------------------------------------------------------------------- % extend_theory `list`;; new_parent `combin`;; % --------------------------------------------------------------------- % % fetch the axiom for lists. % % --------------------------------------------------------------------- % let list_Axiom = theorem `list` `list_Axiom`;; let num_Axiom = theorem `prim_rec` `num_Axiom`;; let PRE = theorem `prim_rec` `PRE`;; let UNCURRY_DEF = definition `bool` `UNCURRY_DEF`;; let o_DEF = definition `combin` `o_DEF`;; %< % --------------------------------------------------------------------- % % Fetch a few theorems from num.th % % --------------------------------------------------------------------- % let NOT_SUC = theorem `num` `NOT_SUC`;; let INV_SUC = theorem `num` `INV_SUC`;; % --------------------------------------------------------------------- % % Fetch a few theorems from prim_rec.th % % --------------------------------------------------------------------- % let num_Axiom = theorem `prim_rec` `num_Axiom`;; let NOT_LESS_0 = theorem `prim_rec` `NOT_LESS_0`;; let LESS_0 = theorem `prim_rec` `LESS_0`;; let LESS_MONO = theorem `prim_rec` `LESS_MONO`;; let INV_SUC_EQ = theorem `prim_rec` `INV_SUC_EQ`;; % --------------------------------------------------------------------- % % Fetch a few things from arithmetic.th % % --------------------------------------------------------------------- % let ADD_CLAUSES = theorem `arithmetic` `ADD_CLAUSES`;; let LESS_MONO_EQ = theorem `arithmetic` `LESS_MONO_EQ`;; let ADD_EQ_0 = theorem `arithmetic` `ADD_EQ_0`;; let SUC_NOT = theorem `arithmetic` `SUC_NOT`;; % WW % >% % --------------------------------------------------------------------- % % We need to load in the induction tactic. It's in ml/ind.ml, but it % % is part of hol rather than basic hol. So it's loaded in uncompiled % % (because it may not have been recompiled since basic-hol was last % % rebuilt. [TFM 88.04.02] % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `ind.ml`);; % --------------------------------------------------------------------- % % Create an induction tactic for :num % % --------------------------------------------------------------------- % let INDUCT_TAC = INDUCT_THEN (theorem `num` `INDUCTION`) ASSUME_TAC;; % --------------------------------------------------------------------- % % Load the code for primitive recursive definitions on arbitrary types. % % % % Note that prim_rec_ml.o must be recompiled if basic-hol has been % % rebuilt. The uncompiled version is therefore loaded here. % % % % TFM 88.04.02 % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `prim_rec.ml`);; % --------------------------------------------------------------------- % % Load the auxiliary code for recursive types. % % NOTE: uses things defined in prim_rec.ml (load uncompiled) % % --------------------------------------------------------------------- % loadt (concat ml_dir_pathname `tyfns.ml`);; let LIST_INDUCT_TAC = let list_INDUCT = prove_induction_thm list_Axiom in INDUCT_THEN list_INDUCT ASSUME_TAC;; loadt (concat ml_dir_pathname `numconv.ml`);; % --------------------------------------------------------------------- % % Definitions of NULL, HD and TL. % % --------------------------------------------------------------------- % let NULL_DEF = new_recursive_definition false list_Axiom `NULL_DEF` "(NULL NIL = T) /\ (NULL (CONS (h:*) t) = F)";; let HD = new_recursive_definition false list_Axiom `HD` "(HD (CONS (h:*) t) = h)";; let TL = new_recursive_definition false list_Axiom `TL` "(TL (CONS (h:*) t) = t)";; let new_list_rec_definition = \(name,tm). new_recursive_definition false list_Axiom name tm;; %----------------------------------------------------------------% %- Alternative list constructor---adding element to the tail end-% %----------------------------------------------------------------% let SNOC = new_list_rec_definition (`SNOC`, "(SNOC (x:*) ([]:(*)list) = [x]) /\ (SNOC x (CONS x' l) = CONS x' (SNOC x l))");; %----------------------------------------------------------------% %- Reductions -% %- Spec: -% %- FOLDR f [x0;x1;...;xn-1] e = f(x0,f(x1,...f(xn-1,e)...))-% %- FOLDL f e [x0;x1;...;xn-1] = f(...f(f(e,x0),x1),...xn-1)-% %----------------------------------------------------------------% let FOLDR = new_list_rec_definition(`FOLDR`, "(FOLDR (f:*->**->**) e [] = e) /\ (FOLDR f e (CONS x l) = f x (FOLDR f e l))");; let FOLDL = new_list_rec_definition(`FOLDL`, "(FOLDL (f:**->*->**) e [] = e) /\ (FOLDL f e (CONS x l) = FOLDL f (f e x) l)");; %----------------------------------------------------------------% %- Fitler -% %- Spec: -% %- FILTER P [x0; ...; xn-1] = [...;xi;...] -% %- where P xi holds for all xi in the resulting list -% %----------------------------------------------------------------% let FILTER = new_list_rec_definition(`FILTER`, "(!P. FILTER P [] = []) /\ (!(P:*->bool) x l. FILTER P (CONS x l) = (P x => CONS x (FILTER P l) | FILTER P l))");; %----------------------------------------------------------------% %- Cumulation -% %- Spec: -% %- SCANL * e [x0;x1;...xn] = -% %- [e; e * x0; (e * x0) * x1; ...; (e * x0)* ... * xn] -% %- SCANR * e [x0;x1;...xn] = -% %- [x0 * ... * (xn * e); ...; xn-1 * (xn * e); xn * e; e] -% %----------------------------------------------------------------% let SCANL = new_list_rec_definition(`SCANL`, "(SCANL (f:**->*->**) e [] = [e]) /\ (SCANL f e (CONS x l) = CONS e (SCANL f (f e x) l))");; let SCANR = new_list_rec_definition(`SCANR`, "(SCANR (f:*->**->**) e [] = [e]) /\ (SCANR (f:*->**->**) e (CONS x l) = CONS (f x (HD (SCANR f e l))) (SCANR f e l))");; %================================================================% %- Derived Functions -% %================================================================% %----------------------------------------------------------------% %- Reverse -% %----------------------------------------------------------------% let REVERSE = new_list_rec_definition (`REVERSE`, "(REVERSE [] = []) /\ (REVERSE (CONS (x:*) l) = SNOC x (REVERSE l))");; %----------------------------------------------------------------% %- Concatenation of two lists -% %- Spec: -% %- APPEND [x0;...;xn-1] [x'0;...;x'm-1] = -% %- [x0;...;xn-1;x'0;...;x'm-1] -% %----------------------------------------------------------------% let APPEND = new_recursive_definition false list_Axiom `APPEND` "(!l. APPEND NIL l = (l:(*)list)) /\ (!l1 l2 h. APPEND (CONS h l1) l2 = CONS h (APPEND l1 l2))";; %----------------------------------------------------------------% %- Concatenation of a list of lists -% %- Spec: -% %- FLAT [[x00;...;x0n-1];...;[xp-10;...;xp-1n-1]] = -% %- [x00;...;x0n-1;...;xp-10;...;xp-1n-1] -% %----------------------------------------------------------------% let FLAT = new_recursive_definition false list_Axiom `FLAT` "(FLAT NIL = NIL:(*)list) /\ (!h t. FLAT (CONS h t) = APPEND h (FLAT t))";; %----------------------------------------------------------------% %- Concatenation of a list of lists -% %- Spec: -% %- LENGTH [x0;...;xn-1] = n -% %----------------------------------------------------------------% let LENGTH = new_recursive_definition false list_Axiom `LENGTH` "(LENGTH NIL = 0) /\ (!h:*. !t. LENGTH (CONS h t) = SUC (LENGTH t))";; %----------------------------------------------------------------% %- Apply a function to all elements of a list -% %- Spec: -% %- MAP f [x0;...;xn-1] = [f x0;...; f xn-1] -% %----------------------------------------------------------------% let MAP = new_recursive_definition false list_Axiom `MAP` "(!f. MAP f NIL = NIL) /\ (!f h t. MAP f (CONS (h:*) t) = CONS (f h:**) (MAP f t))";; % --------------------------------------------------------------------- % % Definition of a function % % % % MAP2 : (*->**->***) -> (*)list -> (**)list -> (***)list % % % % for mapping a curried binary function down a pair of lists: % % % % |- (!f. MAP2 f[][] = []) /\ % % (!f h1 t1 h2 t2. % % MAP2 f(CONS h1 t1)(CONS h2 t2) = CONS(f h1 h2)(MAP2 f t1 t2)) % % % % [TFM 92.04.21] % % --------------------------------------------------------------------- % let MAP2 = let lemma = PROVE ("?fn. (!f:*->**->***. fn f [] [] = []) /\ (!f h1 t1 h2 t2. fn f (CONS h1 t1) (CONS h2 t2) = CONS (f h1 h2) (fn f t1 t2))", let th = prove_rec_fn_exists list_Axiom "(fn (f:*->**->***) [] l = []) /\ (fn f (CONS h t) l = CONS (f h (HD l)) (fn f t (TL l)))" in STRIP_ASSUME_TAC th THEN EXISTS_TAC "fn:(*->**->***)->(*)list->(**)list->(***)list" THEN ASM_REWRITE_TAC [HD;TL]) in new_specification `MAP2` [`constant`,`MAP2`] lemma;; % changed to ALL_EL let EVERY_DEF = new_recursive_definition false list_Axiom `EVERY_DEF` "(!P:*->bool. EVERY P NIL = T) /\ (!P h t. EVERY P (CONS h t) = (P(h) /\ EVERY P t))";; % %----------------------------------------------------------------% %- Predicates -% %- Spec: -% %- ALL_EL P [x0;...;xn-1] = T, iff P xi = T for i=0,...,n-1 -% %- F, otherwise -% %----------------------------------------------------------------% let ALL_EL = new_list_rec_definition(`ALL_EL`, "(!P. ALL_EL P [] = T) /\ (!(P:*->bool) x l. ALL_EL P (CONS x l) = P x /\ (ALL_EL P l))");; %----------------------------------------------------------------% %- Spec: -% %- SOME_EL P [x0;...;xn-1] = T, iff P xi = T for some i -% %- F, otherwise -% %----------------------------------------------------------------% let SOME_EL = new_list_rec_definition(`SOME_EL`, "(!P. SOME_EL P [] = F) /\ (!(P:*->bool) x l. SOME_EL P (CONS x l) = P x \/ (SOME_EL P l))");; %----------------------------------------------------------------% %- Spec: -% %- IS_EL x [x0;...;xn-1] = T, iff ?xi. x = xi for i=0,...,n-1 -% %- F, otherwise -% %----------------------------------------------------------------% let IS_EL_DEF = new_definition(`IS_EL_DEF`, "!(x:*) l. IS_EL x l = SOME_EL ($= x) l");; let AND_EL_DEF = new_definition(`AND_EL_DEF`, "AND_EL = ALL_EL I");; let OR_EL_DEF = new_definition(`OR_EL_DEF`, "OR_EL = SOME_EL I");; %----------------------------------------------------------------% %- Segments -% %- Spec: -% %- FIRSTN m [x0;...;xn-1] = [x0;...;xm-1] -% %- BUTFIRSTN m [x0;...;xn-1] = [xm;...;xn-1] -% %- LASTN m [x0;...;xn-1] = [xn-m;...;xn-1] -% %- BUTLASTN m [x0;...;xn-1] = [x0;...;xn-m] -% %- BUTLAST [x0;...;xn-1] = [x0;...;xn-2] -% %- LAST [x0;...;xn-1] = [xn-1] -% %----------------------------------------------------------------% let FIRSTN = let thm1 = prove_rec_fn_exists num_Axiom "(firstn 0 (l:* list) = []) /\ (firstn (SUC k) l = CONS (HD l) (firstn k (TL l)))" in let thm = PROVE( "?firstn. (!l:* list. firstn 0 l = []) /\ (!n x (l:* list). firstn (SUC n) (CONS x l) = CONS x (firstn n l))", STRIP_ASSUME_TAC thm1 THEN EXISTS_TAC "firstn:num->(*)list->(*)list" THEN ASM_REWRITE_TAC[HD;TL]) in new_specification `FIRSTN` [`constant`,`FIRSTN`] thm;; let BUTFIRSTN = let thm2 = prove_rec_fn_exists num_Axiom "(butfirstn 0 (l:* list) = l) /\ (butfirstn (SUC k) l = butfirstn k (TL l))" in let thm = PROVE( "?butfirstn. (!l:* list. butfirstn 0 l = l) /\ (!n x (l:* list). butfirstn (SUC n) (CONS x l) = butfirstn n l)", STRIP_ASSUME_TAC thm2 THEN EXISTS_TAC "butfirstn:num->(*)list->(*)list" THEN ASM_REWRITE_TAC[HD;TL]) in new_specification `BUTFIRSTN` [`constant`,`BUTFIRSTN`] thm;; %----------------------------------------------------------------% %- Segment -% %- Spec: -% %- SEG m k [x0;...xk;...xk+m-1;...;xn] = [xk;...;xk+m-1] -% %----------------------------------------------------------------% let SEG = let SEG_exists = PROVE( "?SEG. (!k (l:* list). SEG 0 k l = []) /\ (!m x l. SEG (SUC m) 0 (CONS x l) = CONS x (SEG m 0 l)) /\ (!m k x l. SEG (SUC m) (SUC k) (CONS x l) = SEG (SUC m) k l)", EXISTS_TAC "\m k (l:* list). (FIRSTN:num -> * list -> * list) m ((BUTFIRSTN:num -> * list -> * list) k l)" THEN BETA_TAC THEN REWRITE_TAC[FIRSTN;BUTFIRSTN]) in new_specification `SEG` [(`constant`,`SEG`)] SEG_exists;; %----------------------------------------------------------------% %- LAST and BUTLAST is analogous to HD and TL at the end of list-% %----------------------------------------------------------------% let LAST_DEF = new_definition(`LAST_DEF`, "!l:* list. LAST l = HD (SEG 1 (PRE(LENGTH l)) l)");; let BUTLAST_DEF = new_definition(`BUTLAST_DEF`, "!l:* list. BUTLAST l = SEG (PRE(LENGTH l)) 0 l");; let LENGTH_SNOC = PROVE( "!(x:*) l. LENGTH (SNOC x l) = SUC (LENGTH l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH;SNOC]);; let LAST = % "!(x:*) l. LAST (SNOC x l) = x", % let lem = PROVE( "!x (l:* list). (SEG 1 (PRE(LENGTH (SNOC x l))) (SNOC x l)) = [x]", GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH_SNOC] THEN PURE_ONCE_REWRITE_TAC[PRE] THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN REWRITE_TAC[SNOC;SEG] THEN FIRST_ASSUM ACCEPT_TAC) in GEN_ALL(REWRITE_RULE[lem;HD](SPEC "SNOC (x:*) l" LAST_DEF));; let BUTLAST = % "!x l. BUTLAST (SNOC x l) = l", % let lem = PROVE( "!x:*. !l. SEG (PRE(LENGTH (SNOC x l))) 0 (SNOC x l) = l", GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH_SNOC] THEN PURE_ONCE_REWRITE_TAC[PRE] THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN ASM_REWRITE_TAC[SNOC;SEG]) in GEN_ALL(REWRITE_RULE[lem](SPEC "SNOC (x:*) l" BUTLAST_DEF));; let LASTN = let thm1 = prove_rec_fn_exists num_Axiom "(lastn 0 (l:(*)list) = []) /\ (lastn (SUC n) l = SNOC (LAST l) (lastn n (BUTLAST l)))" in let thm = PROVE( "?lastn. (!l:* list. lastn 0 l = []) /\ (!n (x:*) l. lastn (SUC n) (SNOC x l) = SNOC x (lastn n l))", STRIP_ASSUME_TAC thm1 THEN EXISTS_TAC "lastn:num->(*)list->(*)list" THEN ASM_REWRITE_TAC[LAST;BUTLAST]) in new_specification `LASTN` [`constant`,`LASTN`] thm;; let BUTLASTN = let thm1 = prove_rec_fn_exists num_Axiom "(butlastn 0 l = (l:(*)list)) /\ (butlastn (SUC n) l = butlastn n (BUTLAST l))" in let thm = PROVE( "?butlastn. (!l:* list. butlastn 0 l = l) /\ (!n (x:*) l. butlastn (SUC n) (SNOC x l) = butlastn n l)", STRIP_ASSUME_TAC thm1 THEN EXISTS_TAC "butlastn:num->(*)list->(*)list" THEN ASM_REWRITE_TAC[BUTLAST]) in new_specification `BUTLASTN` [`constant`,`BUTLASTN`] thm;; %----------------------------------------------------------------% %- Index of elements -% %- Spec: -% %- EL k [x0;...xk;...;xn-1] = xk -% %- ELL k [xn-1;...xk;...;x0] = xk -% %----------------------------------------------------------------% let EL = new_recursive_definition false num_Axiom `EL` "(!l. EL 0 l = (HD l:*)) /\ (!l:(*)list. !n. EL (SUC n) l = EL n (TL l))";; let ELL = new_recursive_definition false num_Axiom `ELL` "(!l:* list. ELL 0 (l:* list) = LAST l) /\ (!l:* list. ELL (SUC n) l = ELL n (BUTLAST l))";; %----------------------------------------------------------------% %- Predicates between lists -% %- Spec: -% %- IS_PREFIX l1 l2 = T, iff ?l. l1 = APPEND l2 l -% %- IS_SUFFIX l1 l2 = T, iff ?l. l1 = APPEND l l2 -% %- IS_SUBLIST l1 l2 = T, -% %- iff ?l l'. l1 = APPEND l (APPEND l2 l') -% %- -% %- SPLITP P [x0;...xk;...;xn-1] = -% %- ([x0;...;x(k-1)],[xk;...;xn-1]) -% %- where P xi = F for all i < k and P xk = T -% %- -% %- PREFIX P [x0;...xk;...;xn-1] = [x0;...xk-1] -% %- where P xk = F and P xi = T for i = 0,...,k-1 -% %- SUFFIX P [x0;...xk;...;xn-1] = [xk+1;...xn-1] -% %- where P xk = F and P xi = T for i = k+1,...,n-1 -% %----------------------------------------------------------------% let IS_PREFIX = let lemma = PROVE( "?fn. (!l:* list. fn l [] = T) /\ (!x (l:* list). fn [] (CONS x l) = F) /\ (!(x1:*) l1 (x2:*) l2. fn (CONS x1 l1) (CONS x2 l2) = (x1 = x2) /\ (fn l1 l2))", let th = prove_rec_fn_exists list_Axiom "(fn l [] = T) /\ (fn (l:* list) (CONS x t) = (NULL l) => F | (((HD l) = x) /\ (fn (TL l) t)))" in STRIP_ASSUME_TAC th THEN EXISTS_TAC "fn:* list -> * list -> bool" THEN ASM_REWRITE_TAC[HD;TL;NULL_DEF]) in new_specification `IS_PREFIX` [(`constant`,`IS_PREFIX`)] lemma;; %---------------------------------------------------------------% let REVERSE_SNOC = PROVE("!(x:*) l. REVERSE (SNOC x l) = CONS x (REVERSE l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[SNOC;REVERSE]);; let REVERSE_REVERSE = PROVE("!l:(*)list. REVERSE (REVERSE l) = l", LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE;REVERSE_SNOC]);; let forall_REVERSE = TAC_PROOF(([], "!P. (!l:(*)list. P(REVERSE l)) = (!l. P l)"), GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN POP_ASSUM (ACCEPT_TAC o (REWRITE_RULE[REVERSE_REVERSE] o (SPEC "REVERSE l:(*)list"))));; let f_REVERSE_lemma = TAC_PROOF (([], "!f1 f2. ((\x. (f1:(*)list->**) (REVERSE x)) = (\x. f2 (REVERSE x))) = (f1 = f2)"), REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL[ POP_ASSUM (\x.ACCEPT_TAC (EXT (REWRITE_RULE[REVERSE_REVERSE] (GEN "x:(*)list" (BETA_RULE (AP_THM x "REVERSE (x:(*)list)")))))); ASM_REWRITE_TAC[]]);; let SNOC_Axiom = PROVE( "!(e:**) (f:** -> (* -> ((*)list -> **))). ?! fn. (fn[] = e) /\ (!x l. fn(SNOC x l) = f(fn l)x l)", let lemma = CONV_RULE (EXISTS_UNIQUE_CONV) (REWRITE_RULE[REVERSE_REVERSE] (BETA_RULE (SPECL ["e:**";"(\ft h t. f ft h (REVERSE t)):** -> (* -> ((*)list -> **))"] (PURE_ONCE_REWRITE_RULE [SYM (CONJUNCT1 REVERSE); PURE_ONCE_REWRITE_RULE[SYM (SPEC_ALL REVERSE_SNOC)] (BETA_RULE (SPEC "\l:(*)list.fn(CONS x l) = (f:** -> (* -> ((*)list -> **)))(fn l)x l" (CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) forall_REVERSE)))] list_Axiom)))) in REPEAT GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN STRIP_ASSUME_TAC lemma THEN CONJ_TAC THENL[ EXISTS_TAC "(fn:(*)list->**) o REVERSE" THEN REWRITE_TAC[o_DEF] THEN BETA_TAC THEN ASM_REWRITE_TAC[]; REPEAT GEN_TAC THEN POP_ASSUM (ACCEPT_TAC o SPEC_ALL o REWRITE_RULE[REVERSE_REVERSE;f_REVERSE_lemma] o BETA_RULE o REWRITE_RULE[o_DEF] o SPECL ["(fn' o REVERSE):(*)list->**";"(fn'' o REVERSE):(*)list->**"]) ]);; let IS_SUFFIX = let LENGTH_SNOC = PROVE("!(x:*) l. LENGTH (SNOC x l) = SUC (LENGTH l)", GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC [LENGTH;SNOC]) in let NOT_NULL_SNOC = PROVE("!(x:*) l. ~NULL(SNOC x l)", GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[SNOC;NULL_DEF]) in let LAST = % "!(x:*) l. LAST (SNOC x l) = x", % let lem = PROVE( "!x (l:* list). (SEG 1 (PRE(LENGTH (SNOC x l))) (SNOC x l)) = [x]", GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH_SNOC] THEN PURE_ONCE_REWRITE_TAC[PRE] THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN REWRITE_TAC[SNOC;SEG] THEN FIRST_ASSUM ACCEPT_TAC) in GEN_ALL(REWRITE_RULE[lem;HD](SPEC "SNOC (x:*) l" LAST_DEF)) in let BUTLAST = % "!x l. BUTLAST (SNOC x l) = l", % let lem = PROVE( "!x:*. !l. SEG (PRE(LENGTH (SNOC x l))) 0 (SNOC x l) = l", GEN_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH_SNOC] THEN PURE_ONCE_REWRITE_TAC[PRE] THEN LIST_INDUCT_TAC THEN PURE_ONCE_REWRITE_TAC[LENGTH] THEN ASM_REWRITE_TAC[SNOC;SEG]) in GEN_ALL(REWRITE_RULE[lem](SPEC "SNOC (x:*) l" BUTLAST_DEF)) in let lemma = PROVE( "?fn. (!l. fn l [] = T) /\ (!(x:*) l. fn [] (SNOC x l) = F) /\ (!(x1:*) l1 (x2:*) l2. fn (SNOC x1 l1) (SNOC x2 l2) = (x1 = x2) /\ (fn l1 l2))", let th = prove_rec_fn_exists SNOC_Axiom "(fn l [] = T) /\ (fn l (SNOC (x:*) t) = (NULL l) => F | ((LAST l) = x) /\ (fn (BUTLAST l) t))" in STRIP_ASSUME_TAC th THEN EXISTS_TAC "fn:* list -> * list -> bool" THEN ASM_REWRITE_TAC[BUTLAST;LAST;NULL_DEF;NOT_NULL_SNOC]) in new_specification `IS_SUFFIX` [(`constant`,`IS_SUFFIX`)] lemma;; let IS_SUBLIST = let lemma = PROVE( "?fn. (!l:* list. fn l [] = T) /\ (!(x:*) l. fn [] (CONS x l) = F) /\ (!x1 l1 x2 l2. fn (CONS x1 l1) (CONS x2 l2) = ((x1 = x2) /\ (IS_PREFIX l1 l2)) \/ (fn l1 (CONS x2 l2)))", let th = prove_rec_fn_exists list_Axiom "(fn [] (l:* list) = NULL l => T | F) /\ (fn (CONS x t) l = (NULL l) => T | (((x = (HD l)) /\ (IS_PREFIX t (TL l))) \/ (fn t l)))" in STRIP_ASSUME_TAC th THEN EXISTS_TAC "fn:* list -> * list -> bool" THEN ASM_REWRITE_TAC[HD;TL;NULL_DEF] THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[HD;TL;NULL_DEF]) in new_specification `IS_SUBLIST` [(`constant`,`IS_SUBLIST`)] lemma;; let SPLITP = new_list_rec_definition(`SPLITP`, "(SPLITP P [] = ([],[])) /\ (SPLITP P (CONS (x:*) l) = P x => ([], CONS x l) | ((CONS x (FST(SPLITP P l))), (SND (SPLITP P l))))");; let PREFIX_DEF = new_definition(`PREFIX_DEF`, "PREFIX P (l:* list) = FST (SPLITP ($~ o P) l)");; let SUFFIX_DEF = new_definition(`SUFFIX_DEF`, "!P (l:* list). SUFFIX P l = FOLDL (\l' x. P x => SNOC x l' | []) [] l");; %----------------------------------------------------------------% %- List of pairs -% %- Spec: -% %- ZIP([x0;...;xn-1],[y0;...;yn-1]) = [(x0,y0;...;(xn-1,yn-1)] -% %- UNZIP[(x0,y0;...;(xn-1,yn-1)]=([x0;...;xn-1],[y0;...;yn-1]) -% %- UNZIP_FST [(x0,y0;...;(xn-1,yn-1)] = [x0;...;xn-1] -% %- UNZIP_SND [(x0,y0;...;(xn-1,yn-1)] = [y0;...;yn-1] -% %----------------------------------------------------------------% let ZIP = let lemma = PROVE( "?ZIP. (ZIP ([],[]) = []) /\ (!(x1:*) l1 (x2:**) l2. ZIP ((CONS x1 l1),(CONS x2 l2)) = CONS (x1,x2)(ZIP (l1,l2)))", let th = prove_rec_fn_exists list_Axiom "(fn [] l = []) /\ (fn (CONS (h:*) t) (l:** list) = CONS (h, (HD l)) (fn t (TL l)))" in STRIP_ASSUME_TAC th THEN EXISTS_TAC "UNCURRY (fn:(*)list -> ((**)list -> (* # **)list))" THEN ASM_REWRITE_TAC[UNCURRY_DEF;HD;TL]) in new_specification `ZIP` [(`constant`,`ZIP`)] lemma;; let UNZIP = new_list_rec_definition(`UNZIP`, "(UNZIP [] = ([], [])) /\ (UNZIP (CONS (x:* # **) l) = ((CONS (FST x) (FST(UNZIP l))), (CONS (SND x) (SND(UNZIP l)))))");; let UNZIP_FST_DEF = new_definition(`UNZIP_FST_DEF`, "!l:(*#**)list. UNZIP_FST l = FST(UNZIP l)");; let UNZIP_SND_DEF = new_definition(`UNZIP_SND_DEF`, "!l:(*#**)list. UNZIP_SND l = SND(UNZIP l)");; %----------------------------------------------------------------% %- List of natural numbers -% %- Spec: -% %- SUM [x0;...;xn-1] = x0 + ... + xn-1 -% %----------------------------------------------------------------% let SUM = new_recursive_definition false list_Axiom `SUM` "(SUM NIL = 0) /\ (!h t. SUM (CONS h t) = h + (SUM t))";; %----------------------------------------------------------------% %- List generator -% %- Spec: -% %- GENLIST f n = [f 0;...; f(n-1)] -% %- REPLICATE n x = [x;....;x] (n repeate elements) -% %----------------------------------------------------------------% let GENLIST = new_recursive_definition false num_Axiom `GENLIST` "(GENLIST (f:num->*) 0 = []) /\ (GENLIST f (SUC n) = SNOC (f n) (GENLIST f n))";; let REPLICATE = new_recursive_definition false num_Axiom `REPLICATE` "(REPLICATE 0 (x:*) = []) /\ (REPLICATE (SUC n) x = CONS x (REPLICATE n x))";; close_theory();; quit();; hol88-2.02.19940316/Library/0000750000212700021270000000000005536604336013341 5ustar cammcammhol88-2.02.19940316/Library/unwind/0000750000212700021270000000000005533117164014640 5ustar cammcammhol88-2.02.19940316/Library/unwind/old/0000750000212700021270000000000005227265675015431 5ustar cammcammhol88-2.02.19940316/Library/unwind/old/CHANGES0000640000212700021270000001537705061403264016422 0ustar cammcamm Changes to unwind library ------------------------- This file describes the changes that have taken place in the unwind library. Listed below are each of the identifiers declared in the file `des-unwind.ml' in the old version of the library. For each identifier an explanation is given of what has happened to the identifier, or an alternative expression is given that may be used to obtain roughly the same functionality in the new library. I hope that the differences in functionality do not cause people much difficulty. The library badly needed tidying-up and no longer uses mk_thm. Hopefully the new functions will perform at a reasonable speed. While giving the library an overhaul, I have taken the opportunity to rationalize the naming of the functions, and to add a more automated unwinding facility. The additions are listed at the end of this file. Comments and bug reports are welcome. RJB, 5th September 1991. ------------------------- MK_CONJL : proof Deleted. Considered to be an internal function. UNFOLD : (thm list -> conv) Use UNFOLD_CONV. UNFOLD_CONV does not flatten the conjunction, and it should be applied beneath any existential quantifiers. Unlike UNFOLD, it does not fail if some of the conjuncts cannot be rewritten. UNFOLD_RULE : (thm list -> thm -> thm) Use UNFOLD_RIGHT_RULE. UNFOLD_RIGHT_RULE does not flatten the conjunction. Unlike UNFOLD_RULE, it does not fail if some of the conjuncts cannot be rewritten. OLD_UNWIND_ONCE_CONV : conv Use UNWIND_ONCE_CONV. UNWIND_EQS : conv Use UNWIND_CONV. UNWIND : conv Use (DEPTH_EXISTS_CONV UNWIND_CONV) or the safer (won't loop) UNWIND_AUTO_CONV. OLD_UNWIND_RULE : (thm -> thm) Use the safer (won't loop) UNWIND_AUTO_RIGHT_RULE instead. dest_andl : (term -> (term # term list)) Deleted. Considered to be an internal function. AND_FORALL_CONV : conv Use CONJ_FORALL_ONCE_CONV. Unlike AND_FORALL_CONV, CONJ_FORALL_ONCE_CONV does not flatten the tree of conjunctions. To flatten the conjunction use FLATTEN_CONJ_CONV. FORALL_AND_CONV : conv Use FORALL_CONJ_ONCE_CONV. UNWINDF : conv Use (DEPTH_EXISTS_CONV UNWIND_CONV) or the safer (won't loop) UNWIND_AUTO_CONV. UNWINDF_RULE : (thm -> thm) Use the safer (won't loop) UNWIND_AUTO_RIGHT_RULE instead. EXISTS_AND_LEFT : conv EXISTS_AND_RIGHT : conv EXISTS_AND_BOTH : conv EXISTS_AND : conv These functions are no longer used by other functions in the library, and their functionality is captured by the main system function EXISTS_AND_CONV. Hence, the functions have been deleted. Note, however, that EXISTS_AND_CONV "?x. P /\ Q" returns: |- (?x. P /\ Q) = (?x. P) /\ (?x. Q) when x is free in neither P nor Q. EXISTS_AND_BOTH used to return: |- (?x. P /\ Q) = P /\ Q EXISTS_DEL1_CONV can be used in conjunction with EXISTS_AND_CONV to obtain the functionality of EXISTS_AND_BOTH. EXISTS_PERM : (thm -> thm) Deleted. Use (CONV_RULE SWAP_EXISTS_CONV). EXISTS_PERM_CONV : conv Deleted. Use SWAP_EXISTS_CONV. EXISTS_EQN : conv Use EXISTS_EQN_CONV. EXISTS_EQN_CONV has the functionality of both EXISTS_EQN and EXISTS_EQNF. EXISTS_EQNF : conv Use EXISTS_EQN_CONV. EXISTS_EQN_CONV has the functionality of both EXISTS_EQN and EXISTS_EQNF. EXISTS_DEL1 : conv Renamed EXISTS_DEL1_CONV. EXISTS_DEL : conv Renamed EXISTS_DEL_CONV. PRUNE1SINGLE : (term -> conv) Deleted. Considered to be an internal function to PRUNE1. PRUNE1 : (term -> conv) Use PRUNE_ONCE_CONV. This is more general than PRUNE1 in that it handles lines with arguments (as PRUNE1F used to). PRUNE_ONCE_CONV takes the existential term as a single argument. PRUNE1F : (term -> conv) Use PRUNE_ONCE_CONV. This takes the existential term as a single argument. PRUNEL : (term list -> conv) Use PRUNE_SOME_CONV. This is more general then PRUNEL in that it can handle any ordering of the variables. PRUNE : conv Use PRUNE_CONV. PRUNE_RULE : (thm -> thm) Use PRUNE_RIGHT_RULE. PRUNELF : (term list -> conv) Use PRUNE_SOME_CONV. This is more general then PRUNELF in that it can handle any ordering of the variables. PRUNEF : conv Use PRUNE_CONV. PRUNEF_RULE : (thm -> thm) Use PRUNE_RIGHT_RULE. EXPAND : (thm list -> thm -> thm) Use EXPAND_AUTO_RIGHT_RULE. EXPANDF : (thm list -> thm -> thm) Use EXPAND_AUTO_RIGHT_RULE. line_var : (term -> term) No change. var_name : (term -> string) Deleted. Considered to be an internal function. line_name : (term -> string) No change. UNWIND_ONCE_CONV : ((term -> bool) -> conv) No change. UNWIND_CONV : ((term -> bool) -> conv) No change. UNWIND_ONCE_RULE : ((term -> bool) -> thm -> thm) Deleted. If its functionality is required, apply UNWIND_ONCE_CONV using CONV_RULE, DEPTH_FORALL_CONV, DEPTH_EXISTS_CONV, RAND_CONV, etc. UNWIND_RULE : ((term -> bool) -> thm -> thm) Deleted. Use the safer (won't loop) UNWIND_AUTO_RIGHT_RULE instead. UNWIND_ALL_RULE : (string list -> thm -> thm) Renamed UNWIND_ALL_BUT_RIGHT_RULE. NEW_EXPANDF : (string list -> thm list -> thm -> thm) Use EXPAND_ALL_BUT_RIGHT_RULE. ------------------------- ADDITIONS: ---------- DEPTH_FORALL_CONV : (conv -> conv) Function for applying a conversion beneath nested universal quantifiers. DEPTH_EXISTS_CONV : (conv -> conv) Function for applying a conversion beneath nested existential quantifiers. FLATTEN_CONJ_CONV : conv Conversion for flattening a tree of conjunctions. CONJ_FORALL_CONV : conv Like AND_FORALL_CONV but moves multiple universal quantifiers. FORALL_CONJ_CONV : conv Like FORALL_AND_CONV but moves multiple universal quantifiers. CONJ_FORALL_RIGHT_RULE : (thm -> thm) A rule that uses CONJ_FORALL_CONV. FORALL_CONJ_RIGHT_RULE : (thm -> thm) A rule that uses FORALL_CONJ_CONV. UNWIND_ALL_BUT_CONV : (string list -> conv) Conversion that forms the basis of UNWIND_ALL_RULE (which is now called UNWIND_ALL_BUT_RIGHT_RULE). UNWIND_AUTO_CONV : conv UNWIND_AUTO_RIGHT_RULE : (thm -> thm) Conversion and rule for unwinding as far as possible without the risk of getting into an infinite loop. PRUNE_ONE_CONV : (string -> conv) Conversion for pruning a selected internal line. PRUNE_SOME_CONV : (string list -> conv) PRUNE_SOME_RIGHT_RULE : (string list -> thm -> thm) Conversion and rule for pruning selected internal lines. EXPAND_ALL_BUT_CONV : (string list -> thm list -> conv) EXPAND_AUTO_CONV : (thm list -> conv) EXPAND_ALL_BUT_RIGHT_RULE : (string list -> thm list -> thm -> thm) EXPAND_AUTO_RIGHT_RULE : (thm list -> thm -> thm) Conversions and rules for doing unfolding, unwinding and pruning. ------------------------- hol88-2.02.19940316/Library/unwind/old/Makefile0000640000212700021270000000325004730451263017056 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: unwind # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o *_ml.l @echo "===> library unwind: all object code deleted" clobber: rm -f *_ml.o *_ml.l @echo "===> library unwind: all object code deleted" # ===================================================================== # Entries for individual files. # ===================================================================== mjcg-unwind_ml.o: mjcg-unwind.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `mjcg-unwind`;;'\ 'quit();;' | ${Hol} des-unwind_ml.o: des-unwind.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `des-unwind`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: mjcg-unwind_ml.o des-unwind_ml.o @echo "===> library unwind rebuilt" hol88-2.02.19940316/Library/unwind/old/unwind.ml0000640000212700021270000000112404746330720017253 0ustar cammcamm% ===================================================================== % % FILE : unwind.ml % % DESCRIPTION : loads the library "unwind" into hol. % % % % AUTHOR : T. Melham % % DATE : 90.12.01 % % ===================================================================== % % --------------------------------------------------------------------- % % Load the compiled code into ml. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/unwind/mjcg-unwind` in load(path, get_flag_value `print_lib`);; hol88-2.02.19940316/Library/unwind/old/READ-ME0000640000212700021270000000231204546647622016364 0ustar cammcamm+ ===================================================================== + | | | LIBRARY : unwind | | | | DESCRIPTION : derived inference rules for expanding and simplifying | | hardware structural specifications. | | | | WARNING : uses mk_thm. | | | + ===================================================================== + + --------------------------------------------------------------------- + | | | FILES: | | | + --------------------------------------------------------------------- + unwind.ml definitions of derived rules (from old HOL) des-unwind.ml improved version of unwind.ml + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clean" 3) type "make all" + --------------------------------------------------------------------- + | | | TO USE THE LIBRARY: | | | + --------------------------------------------------------------------- + Load unwind.ml hol88-2.02.19940316/Library/unwind/old/des-unwind.ml0000640000212700021270000005350304771121037020031 0ustar cammcamm% ===================================================================== % % FILE : des-unwind.ml % % DESCRIPTION : Rules for unfolding, unwinding, pruning etc. % % Des version. % % % % REVISED : 90.10.27 (melham) % % ===================================================================== % %----------------------------------------------------------------------------% % This files is a version of unwind.ml containing various bugfixes due % % to David Shepherd (DES) of INMOS. Eventually it is hoped to clean up and % % rationalize the unwind library. When this happens DES's improvements % % will be incorporated. To see the changes search for "[DES]". % %----------------------------------------------------------------------------% let REWRITES_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm;; % Rules for unfolding, unwinding, pruning etc. % % Rules for unfolding % % A1 |- t1 = t1' , ... , An |- tn = tn' --------------------------------------------------------- A1 u ... u An |- (t1 /\ ... /\ tn) = (t1' /\ ... /\ tn') % letrec MK_CONJL thl = (if null thl then fail if null(tl thl) then hd thl else (let th = MK_CONJL(tl thl) in let t1,() = dest_eq(concl(hd thl)) and (),t2' = dest_eq(concl th) in (AP_TERM "$/\ ^t1" th) TRANS (AP_THM (AP_TERM "$/\" (hd thl)) t2')) ) ? failwith `MK_CONJL`;; % A1 |- t1 = t1' , ... , An |- tn = tn' -------------------------------------------------- A1 u ... u An |- ?l1 ... lm. t1 /\ ... /\ tn = ?l1 ... lm. t1' /\ ... /\ tn' % let UNFOLD thl = let net = mk_conv_net thl in \t. ((let vars, eqs = strip_exists t and rewrite = REWRITES_CONV net in LIST_MK_EXISTS vars (MK_CONJL(map rewrite (conjuncts eqs))) ) ? failwith `UNFOLD`);; % A1 |- t1 = t1' , ... , An |- tn = tn' A |- t = (?l1 ... lm. t1 /\ ... /\ tn) ------------------------------------------ A |- t = (?l1 ... lm. t1' /\ ... /\ tn') % let UNFOLD_RULE thl th = RIGHT_CONV_RULE (UNFOLD(map SPEC_ALL thl)) (SPEC_ALL th) ? failwith`UNFOLD_RULE`;; % |- (x1 = t1) /\ ... (xm = tm) /\ ... /\ (xn = tn) = (x1 = t1') /\ ... /\ (x[m-1] = t[m-1]') /\ (xm = tm) /\ ... /\ (xn = tn) where: 1. ti' = ti[tm,...,tn/xm,...,xn] 2. none of x1,...,xn are free in any of tm,...,tn (the xi's need not be variables) 3. not all of the terms in the conjunction have to be equations (only the equations are used in unwinding) In fact, the equations (xi = ti) (where i is between m and n) can occur anywhere - they don't have to be bunched up at the right hand end. let OLD_UNWIND_ONCE_CONV t = (let eqns = conjuncts t in letrec check_frees l t = (if null l then false if free_in(hd l)t then true else check_frees (tl l) t) in let lefts = mapfilter lhs eqns in let l1,l2 = partition (\t. check_frees lefts (rhs t) ? true) eqns in if null l1 then REFL(list_mk_conj l2) else (let th1 = end_itlist CONJ (map ASSUME l2) in let subs_list = map (\th. (th, genvar(type_of(lhs(concl th))))) (CONJUNCTS th1) in let rn_list = map (\(th,v).(v,lhs(concl th))) subs_list in let subs_fn t = (mk_eq o (I # subst rn_list) o dest_eq) t ? subst rn_list t in let th2 = SUBST_CONV subs_list (list_mk_conj (map subs_fn l1)) (list_mk_conj l1) in let th3 = CONJ_DISCHL l2 th2 in let th4 = CONJUNCTS_CONV(t, lhs(concl th3)) in (th4 TRANS th3)) ) ? failwith `OLD_UNWIND_ONCE_CONV`;; % let OLD_UNWIND_ONCE_CONV t = (let eqns = conjuncts t in letrec check_frees l t = %any member of l free in t?% (if null l then false if free_in(hd l)t then true else check_frees (tl l) t) in let lefts = mapfilter lhs eqns in let l1,l2 = partition (\t. check_frees lefts (rhs t) ? true) eqns in if null l1 then REFL(list_mk_conj eqns) else (let subs_fun = subst(map((\(x,y).(y,x)) o dest_eq)l2) in let f l = ((mk_eq o (I # subs_fun) o dest_eq) l ? subs_fun l) in let l1' = map f l1 in mk_thm([], mk_eq(t, list_mk_conj(l1'@l2)))) ) ? failwith `OLD_UNWIND_ONCE_CONV`;; % Unwind until no change - may loop! letrec UNWIND_EQS eqs = let th = OLD_UNWIND_ONCE_CONV eqs in if lhs(concl th)=rhs(concl th) then th else th TRANS (UNWIND_EQS(rhs(concl th)));; % letrec UNWIND_EQS eqs = (let th = OLD_UNWIND_ONCE_CONV eqs in let t1,t2 = dest_eq(concl th) in if t1 = t2 then th else mk_thm([],mk_eq(t1, rhs(concl(UNWIND_EQS t2)))) ) ? failwith`UNWIND_EQS`;; % |- (?l1 ... lm. x1 = t1 /\ ... /\ xn = tn) = (?l1 ... lm. x1 = t1' /\ ... /\ xn = tn') Where t1',...,tn' are got from t1,...,tn by unwinding using the equations % let UNWIND t = let l,eqs = strip_exists t in LIST_MK_EXISTS l (UNWIND_EQS eqs);; let OLD_UNWIND_RULE th = RIGHT_CONV_RULE UNWIND th ? failwith `OLD_UNWIND_RULE`;; % "(!x. t1) /\ ... /\ (!x. tn)" ---> |- (!x. t1) /\ ... /\ (!x. tn) = !x. t1 /\ ... /\ tn let AND_FORALL_CONV t = (let xt1,xt2 = dest_conj t in let x = fst(dest_forall xt1) in let thl1 = CONJUNCTS(ASSUME t) in let th1 = DISCH_ALL(GEN x (LIST_CONJ(map(SPEC x)thl1))) in let thl2 = CONJUNCTS (SPEC x (ASSUME (mk_forall(x,(list_mk_conj(map(snd o dest_forall o concl)thl1)))))) in let th2 = DISCH_ALL(LIST_CONJ(map (GEN x) thl2)) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `AND_FORALL_CONV`;; % % "(!x. t1) /\ ... /\ (!x. tn)" ---> ("x", ["t1"; ... ;"tn"]) % letrec dest_andl t = ((let x1,t1 = dest_forall t in (x1,[t1]) ) ? (let first,rest = dest_conj t in let x1,l1 = dest_andl first and x2,l2 = dest_andl rest in if x1=x2 then (x1, l1@l2) else fail) ) ? failwith `dest_andl`;; % Version of AND_FORALL_CONV below will pull quantifiers out and flatten an arbitrary tree of /\s, not just a linear list. % let AND_FORALL_CONV t = (let x,l = dest_andl t in mk_thm([], mk_eq(t,mk_forall(x,list_mk_conj l))) ) ? failwith `AND_FORALL_CONV`;; % "!x. t1 /\ ... /\ tn" ---> |- !x. t1 /\ ... /\ tn = (!x. t1) /\ ... /\ (!x. tn) let FORALL_AND_CONV t = (let x,l = ((I # conjuncts) o dest_forall) t in SYM(AND_FORALL_CONV(list_mk_conj(map(curry mk_forall x)l))) ) ? failwith `AND_FORALL_CONV`;; % let FORALL_AND_CONV t = (let x,l = ((I # conjuncts) o dest_forall) t in mk_thm([],mk_eq(t, list_mk_conj(map(curry mk_forall x)l))) ) ? failwith `FORALL_AND_CONV`;; % |- (?l1 ... lm. (!x. x1 = t1) /\ ... /\ (!x. xn = tn)) = (?l1 ... lm. (!x. x1 = t1') /\ ... /\ (!x. xn = tn')) Where t1',...,tn' are got from t1,...,tn by unwinding using the equations: x1 = t1 /\ ... /\ xn = tn % let UNWINDF t = (let l,body = strip_exists t in let th1 = AND_FORALL_CONV body in let x,eqs = dest_forall(rhs(concl th1)) in let th2 = FORALL_EQ x (UNWIND_EQS eqs) in let th3 = FORALL_AND_CONV(rhs(concl th2)) in LIST_MK_EXISTS l (th1 TRANS th2 TRANS th3) ) ? failwith `UNWINDF`;; let UNWINDF_RULE th = RIGHT_CONV_RULE UNWINDF th ? failwith `UNWINDF_RULE`;; % A |- t1 = t2 -------------- (t2' got from t2 by unwinding) A |- t1 = t2' % % The next lot of rules are for pruning % % EXISTS_AND_LEFT: term -> thm "?x.t1/\t2" | - ?x. t1 /\ t2 = t1 /\ (?x. t2)" (If x not free in t1) % let EXISTS_AND_LEFT t = (let x,t1,t2 = ((I # dest_conj) o dest_exists) t in let t1_frees, t2_frees = frees t1, frees t2 in % if not(mem x t2_frees & not(mem x t1_frees)) -- modification 10mar88 [DES] -- weaken condition from x free in t2 and not free in t1 to x not free in t1 -- as this may fix PRUNE problem % if (mem x t1_frees) then fail else (let th1 = ASSUME "^t1 /\ ^t2" and t' = "^t1 /\ (?^x.^t2)" in let th2 = ASSUME t' in let th3 = DISCH t (CHOOSE (x, ASSUME t) (CONJ(CONJUNCT1 th1)(EXISTS("?^x.^t2",x)(CONJUNCT2 th1)))) % th3 = |-"?x. t1 /\ t2 ==> t1 /\ (?x. t2)" % and th4 = DISCH t' (CHOOSE (x, CONJUNCT2 th2) (EXISTS(t,x)(CONJ(CONJUNCT1 th2)(ASSUME t2)))) % th4 = |-"t1 /\ (?x. t2) ==> ?x. t1 /\ t2" % in IMP_ANTISYM_RULE th3 th4) ) ? failwith `EXISTS_AND_LEFT`;; % EXISTS_AND_RIGHT: term -> thm ?x.t1/\t2 |- ?x. t1 /\ t2 = (?x. t1) /\ t2" (If x not free in t2) % let EXISTS_AND_RIGHT t = (let x,t1,t2 = ((I # dest_conj) o dest_exists) t in let t1_frees, t2_frees = frees t1, frees t2 and th1 = ASSUME "^t1 /\ ^t2" in % if not(mem x t1_frees & not(mem x t2_frees)) -- modification 10mar88 [DES] -- weaken condition from x free in t1 and not free in t2 to x not free in t2 -- as this may fix PRUNE problem % if (mem x t2_frees) then fail else (let t' = "(?^x.^t1) /\ ^t2" in let th2 = ASSUME t' in let th3 = DISCH t (CHOOSE (x, ASSUME t) (CONJ(EXISTS("?^x.^t1",x)(CONJUNCT1 th1))(CONJUNCT2 th1))) % th3 = |-"?x. t1 /\ t2 ==> (?x.t1) /\ t2" % and th4 = DISCH t' (CHOOSE (x, CONJUNCT1 th2) (EXISTS(t,x)(CONJ(ASSUME t1)(CONJUNCT2 th2)))) % th4 = |-"(?x.t1) /\ t2 ==> ?x. t1 /\ t2" % in IMP_ANTISYM_RULE th3 th4) ) ? failwith `EXISTS_AND_RIGHT`;; % EXISTS_AND_BOTH: term -> thm ?x.t1/\t2 |- ?x. t1 /\ t2 = t1 /\ t2" (If x not free in t1 or t2) % let EXISTS_AND_BOTH t = (let x,t1,t2 = ((I # dest_conj) o dest_exists) t in let t1_frees, t2_frees = frees t1, frees t2 and th1 = ASSUME "^t1 /\ ^t2" in if (mem x t2_frees) or (mem x t1_frees) then fail else (let t' = "^t1 /\ ^t2" in let th3 = DISCH t (CHOOSE (x, ASSUME t) (ASSUME t')) % th3 = |-"?x. t1 /\ t2 ==> t1 /\ t2" % and th4 = DISCH t' (EXISTS(t, x)(ASSUME t')) % th4 = |-"t1 /\ t2 ==> ?x. t1 /\ t2" % in IMP_ANTISYM_RULE th3 th4) ) ? failwith `EXISTS_AND_BOTH`;; % EXISTS_AND: term -> thm ?x.t1/\t2 |- ?x. t1 /\ t2 = t1 /\ (?x. t2)" (If x not free in t1) |- ?x. t1 /\ t2 = (?x. t1) /\ t2" (If x not free in t2) |- ?x. t1 /\ t2 = t1 /\ t2" (If x not free in t1 or t2) % let EXISTS_AND t = EXISTS_AND_BOTH t ? % altered order 10mar88 [DES] as LEFT and RIGHT now % EXISTS_AND_LEFT t ? % handle cases that previously fell through to BOTH % EXISTS_AND_RIGHT t ? failwith`EXISTS_AND`;; % A |- ?x.?y.t ------------ A |- ?y.?x.t" % let EXISTS_PERM th = let x,y,t = ((I # dest_exists) o dest_exists o concl) th in CHOOSE (x,th) (CHOOSE (y, ASSUME "?^y.^t") (EXISTS("?^y^x.^t",y)(EXISTS("?^x.^t",x)(ASSUME t))));; % |- (?x y. t) = (?y x.t) % let EXISTS_PERM_CONV t = (let th1 = EXISTS_PERM(ASSUME t) in let t' = concl th1 in IMP_ANTISYM_RULE (DISCH t th1) (DISCH t' (EXISTS_PERM(ASSUME t'))) ) ? failwith`EXISTS_PERM_CONV`;; % EXISTS_EQN "?l. l x1 ... xn = t" --> |- (?l.l x1 ... xn = t) = T (if l not free in t) % let EXISTS_EQN t = (let l,t1,t2 = ((I # dest_eq) o dest_exists) t in let l',xs = strip_comb t1 in let t3 = list_mk_abs(xs,t2) in let th1 = RIGHT_CONV_RULE LIST_BETA_CONV (REFL(list_mk_comb(t3,xs))) in EQT_INTRO(EXISTS("?^l.^(list_mk_comb(l,xs))=^(rhs(concl th1))",t3)th1) ) ? failwith `EXISTS_EQN`;; % EXISTS_EQNF "?l. !x1 ... xn. l x1 ... xn = t" --> |- (?l. !x1 ... xn. l x1 ... xn = t) = T (if l not free in t) % let EXISTS_EQNF t = (let l,vars,t1,t2 = ((I # (I # dest_eq)) o (I # strip_forall) o dest_exists) t in let l',xs = strip_comb t1 in let t3 = list_mk_abs(xs,t2) in let th1 = GENL vars (RIGHT_CONV_RULE LIST_BETA_CONV (REFL(list_mk_comb(t3,xs)))) in EQT_INTRO (EXISTS ((mk_exists (l, list_mk_forall (xs, (mk_eq(list_mk_comb(l,xs), rhs(snd(strip_forall(concl th1)))))))), t3) th1) ) ? failwith `EXISTS_EQNF`;; % |- (?x.t) = t if x not free in t let EXISTS_DEL1 tm = (let x,t = dest_exists tm in let th1 = DISCH tm (CHOOSE (x, ASSUME tm) (ASSUME t)) and th2 = DISCH t (EXISTS(tm,x)(ASSUME t)) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `EXISTS_DEL`;; % % |- (?x1 ... xn.t) = t if x1,...,xn not free in t letrec EXISTS_DEL tm = (if is_exists tm then (let th1 = EXISTS_DEL1 tm in let th2 = EXISTS_DEL(rhs(concl th1)) in th1 TRANS th2) else REFL tm ) ? failwith`EXISTS_DEL`;; % let EXISTS_DEL1 tm = % delete one ? % (let l,t = dest_exists tm in let l' = frees t % bug fix [DES] 24mar88 -- frees t NOT frees tm !! so need an extra let % in if not(mem l l') then mk_thm([], mk_eq(tm,t)) else fail ) ? failwith`EXISTS_DEL`;; let EXISTS_DEL tm = (let l,t = strip_exists tm in let l' = frees t % bug fix [DES] 24mar88 -- frees t NOT frees tm !! so need an extra let % in if intersect l l' = [] then mk_thm([], mk_eq(tm,t)) else fail ) ? failwith`EXISTS_DEL`;; % The pruning rule below will need to be made more complicated. |- (?l1 ... lm. t1 /\ ... /\ tn) = (u1 /\ ... /\ up) where each ti is an equation "xi = ti'" and the uis are those tis for which xi is not one of l1, ... ,lm. The rule below assumes that for each li there is exactly one ti with xi=li. This will have to be relaxed later. % % PRUNE1SINGLE is the special case where there is only 1 conjunct % let PRUNE1SINGLE x eq = (if free_in x eq then let v,t=dest_eq eq in EQT_INTRO(EXISTS(mk_exists(x,eq),t) (REFL t)) else EXISTS_DEL1 (mk_exists(x,eq)) ) ? failwith `PRUNE1SINGLE`;; % PRUNE1 prunes one hidden variable % % modified 11mar88 [DES] to handle case ?x.P where x is free in P EXISTS_AND will remove the ?x so rest is not needed % let PRUNE1 x eqs = (let conjs = conjuncts eqs in if length conjs = 1 then PRUNE1SINGLE x (hd conjs) else let l1,l2 = partition(free_in x) conjs in let th1 = LIST_MK_EXISTS [x] (CONJ_SET_CONV conjs (l1@l2)) in let th2 = th1 TRANS EXISTS_AND(rhs(concl th1)) % try AND_BOTH as well % in let tm = rhs(concl th2) in if is_conj tm % check we've actually got a conjunction % then let t1,t2 = dest_conj(tm) in if is_exists t1 % still more to do % then let th3 = th2 TRANS (AP_THM(AP_TERM "$/\" (EXISTS_EQN t1))t2) and th4 = CONJUNCT1 (SPEC t2 AND_CLAUSES) in th3 TRANS th4 else th2 else th2 ) ? failwith`PRUNE1`;; % |- (?l1 ... lm. t1 /\ ... /\ tn) = (u1 /\ ... /\ up) where each ti has the form "!x. xi x = ti'" and the uis are those tis for which xi is not one of l1, ... ,lm. The rule below assumes that for each li there is exactly one ti with xi=li. This will have to be relaxed later. % % PRUNE1F prunes one hidden variable % let PRUNE1F x eqs = (let l1,l2 = partition(free_in x)(conjuncts eqs) in let th1 = LIST_MK_EXISTS [x] (CONJ_SET_CONV (conjuncts eqs) (l1@l2)) in let th2 = th1 TRANS EXISTS_AND_RIGHT(rhs(concl th1)) in let t1,t2 = dest_conj(rhs(concl th2)) in let th3 = th2 TRANS (AP_THM(AP_TERM "$/\" (EXISTS_EQNF t1))t2) and th4 = CONJUNCT1 (SPEC t2 AND_CLAUSES) in th3 TRANS th4 ) ? failwith`PRUNE1F`;; letrec PRUNEL vars eqs = (if null vars then REFL eqs if null(tl vars) then PRUNE1 (hd vars) eqs else (let th1 = PRUNEL (tl vars) eqs in let th2 = PRUNE1 (hd vars) (rhs(concl th1)) in (LIST_MK_EXISTS [hd vars] th1) TRANS th2) ) ? failwith`PRUNEL`;; let PRUNE t = (let vars,eqs = strip_exists t in PRUNEL vars eqs) ? failwith`PRUNE`;; let PRUNE_RULE th = RIGHT_CONV_RULE PRUNE th ? failwith `PRUNE_RULE`;; letrec PRUNELF vars eqs = (if null vars then REFL eqs if null(tl vars) then PRUNE1F (hd vars) eqs else (let th1 = PRUNELF (tl vars) eqs in let th2 = PRUNE1F (hd vars) (rhs(concl th1)) in (LIST_MK_EXISTS [hd vars] th1) TRANS th2) ) ? failwith`PRUNELF`;; let PRUNEF t = (let vars,eqs = strip_exists t in PRUNELF vars eqs) ? failwith`PRUNEF`;; let PRUNEF_RULE th = RIGHT_CONV_RULE PRUNEF th ? failwith `PRUNEF_RULE`;; % EXPAND below is like EXPAND_IMP of LCF_LSM; it unfolds, unwinds and prunes % let EXPAND thl th = let th1 = UNFOLD_RULE thl th in let th2 = OLD_UNWIND_RULE th1 in PRUNE_RULE th2;; let EXPANDF thl th = let th1 = UNFOLD_RULE thl th in let th2 = UNWINDF_RULE th1 in PRUNEF_RULE th2;; % The stuff below superceeds some of the stuff above. Some cleaning % % up is needed ... % % New HOL Inference rules for unwinding device implementations. % % % % DATE 85.05.21 % % AUTHOR T. Melham % % AUXILIARY FUNCTION DEFINITIONS -------------------------------------- % % line_var "!v1 ... vn. f v1 ... vn = t" ====> "f" % let line_var tm = fst(strip_comb(lhs(snd(strip_forall tm))));; % var_name "var" ====> `var` % let var_name = fst o dest_var;; % line_name "!v1 ... vn. f v1 ... vn = t" ====> `f` % let line_name = var_name o line_var;; % UNWIND CONVERSIONS -------------------------------------------------- % % UNWIND_ONCE_CONV - Basic conversion for parallel unwinding of lines. % % % % DESCRIPTION: tm should be a conjunction, t1 /\ t2 ... /\ tn. % % p:term->bool is a function which is used to partition the% % terms (ti) into two sets. Those ti which p is true of % % are then used as a set of rewrite rules (thus they must % % be equations) to do a top-down one-step parallel rewrite % % of the conjunction of the remaining terms. I.e. % % % % t1 /\ ... /\ eqn1 /\ ... /\ eqni /\ ... /\ tn % % --------------------------------------------- % % |- t1 /\ ... /\ eqn1 /\ ... /\ eqni /\ ... /\ tn % % = % % eqn1 /\ ... /\ eqni /\ ... /\ t1' /\ ... /\ tn' % % % % where tj' is tj rewritten with the equations eqnx % let UNWIND_ONCE_CONV p tm = let eqns = conjuncts tm in let eq1,eq2 = partition (\tm. ((p tm) ? false)) eqns in if (null eq1) or (null eq2) then REFL tm else let thm = CONJ_DISCHL eq1 (ONCE_DEPTH_CONV (REWRITES_CONV (mk_conv_net (map ASSUME eq1))) (list_mk_conj eq2)) in let re = CONJUNCTS_CONV(tm,(lhs(concl thm))) in re TRANS thm;; % Unwind until no change using equations selected by p. % % WARNING -- MAY LOOP! % letrec UNWIND_CONV p tm = let th = UNWIND_ONCE_CONV p tm in if lhs(concl th)=rhs(concl th) then th else th TRANS (UNWIND_CONV p (rhs(concl th)));; % UNWIND CONVERSIONS -------------------------------------------------- % % One-step unwinding of device behaviour with hidden lines using line % % equations selected by p. % let UNWIND_ONCE_RULE p th = let rhs_conv = \rhs. (let lines,eqs = strip_exists rhs in LIST_MK_EXISTS lines (UNWIND_ONCE_CONV p eqs)) in RIGHT_CONV_RULE rhs_conv th ? failwith `UNWIND_ONCE_RULE`;; % Unwind device behaviour using line equations selected by p until no % % change. WARNING --- MAY LOOP! % let UNWIND_RULE p th = let rhs_conv = \rhs. (let lines,eqs = strip_exists rhs in LIST_MK_EXISTS lines (UNWIND_CONV p eqs)) in RIGHT_CONV_RULE rhs_conv th ? failwith `UNWIND_RULE`;; % Unwind all lines (except those in the list l) as much as possible. % let UNWIND_ALL_RULE l th = let rhs_conv = \rh. (let lines,eqs = strip_exists rh in let eqns = filter (can line_name) (conjuncts eqs) in let line_names = subtract (map line_name eqns) l in let p = \line. \tm. (line_name tm) = line in let itfn = \line. \th. th TRANS UNWIND_CONV (p line) (rhs(concl th)) in LIST_MK_EXISTS lines (itlist itfn line_names (REFL eqs))) in RIGHT_CONV_RULE rhs_conv th ? failwith `UNWIND_ALL_RULE`;; let NEW_EXPANDF l thl th = let th1 = UNFOLD_RULE thl th in let th2 = UNWIND_ALL_RULE l th1 in PRUNEF_RULE th2;; % TEST CASES ---------------- let imp = ASSUME "IMP(f,g,h) = ?l3 l2 l1. (!x:num. f x = (l1 (x+1)) + (l2 (x+2)) + (l3 (x+3))) /\ (!x. g x = (l3 (l3 (l3 x)))) /\ (!x. l2 x = (l3 x) - 1) /\ (!x. h x = l3 x) /\ (!x. l1 x = (l2 x) + 1) /\ (!x. l3 x = 7) /\ notanequation:bool";; let tm = "(!x:num. f x = (l1 (x+1)) + (l2 (x+2)) + (l3 (x+3))) /\ (!x. l1 x = (l2 x) + 1) /\ (!x. g x = (l3 (l3 (l3 x)))) /\ (!x. l2 x = (l3 x) - 1) /\ (!x. h x = l3 x) /\ (!x. l3 x = 7) /\ notanequation:bool";; UNWIND_ONCE_CONV (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) tm;; UNWIND_CONV (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) tm;; UNWIND_ONCE_RULE (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) imp;; UNWIND_RULE (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) imp;; UNWIND_ALL_RULE [] imp;; UNWIND_ALL_RULE [`l3`] imp;; % hol88-2.02.19940316/Library/unwind/old/mjcg-unwind.ml0000640000212700021270000004557004771121052020200 0ustar cammcamm% ===================================================================== % % FILE : mjcg-unwind.ml % % DESCRIPTION : Rules for unfolding, unwinding, pruning etc. % % Original HOL version. % % % % REVISED : 90.10.27 (melham) % % ===================================================================== % let REWRITES_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm;; % Rules for unfolding, unwinding, pruning etc. % % Rules for unfolding % % A1 |- t1 = t1' , ... , An |- tn = tn' --------------------------------------------------------- A1 u ... u An |- (t1 /\ ... /\ tn) = (t1' /\ ... /\ tn') % letrec MK_CONJL thl = (if null thl then fail if null(tl thl) then hd thl else (let th = MK_CONJL(tl thl) in let t1,() = dest_eq(concl(hd thl)) and (),t2' = dest_eq(concl th) in (AP_TERM "$/\ ^t1" th) TRANS (AP_THM (AP_TERM "$/\" (hd thl)) t2')) ) ? failwith `MK_CONJL`;; % A1 |- t1 = t1' , ... , An |- tn = tn' -------------------------------------------------- A1 u ... u An |- ?l1 ... lm. t1 /\ ... /\ tn = ?l1 ... lm. t1' /\ ... /\ tn' % let UNFOLD thl = let net = mk_conv_net thl in \t. ((let vars, eqs = strip_exists t and rewrite = REWRITES_CONV net in LIST_MK_EXISTS vars (MK_CONJL(map rewrite (conjuncts eqs))) ) ? failwith `UNFOLD`);; % A1 |- t1 = t1' , ... , An |- tn = tn' A |- t = (?l1 ... lm. t1 /\ ... /\ tn) ------------------------------------------ A |- t = (?l1 ... lm. t1' /\ ... /\ tn') % let UNFOLD_RULE thl th = RIGHT_CONV_RULE (UNFOLD(map SPEC_ALL thl)) (SPEC_ALL th) ? failwith`UNFOLD_RULE`;; % |- (x1 = t1) /\ ... (xm = tm) /\ ... /\ (xn = tn) = (x1 = t1') /\ ... /\ (x[m-1] = t[m-1]') /\ (xm = tm) /\ ... /\ (xn = tn) where: 1. ti' = ti[tm,...,tn/xm,...,xn] 2. none of x1,...,xn are free in any of tm,...,tn (the xi's need not be variables) 3. not all of the terms in the conjunction have to be equations (only the equations are used in unwinding) In fact, the equations (xi = ti) (where i is between m and n) can occur anywhere - they don't have to be bunched up at the right hand end. let OLD_UNWIND_ONCE_CONV t = (let eqns = conjuncts t in letrec check_frees l t = (if null l then false if free_in(hd l)t then true else check_frees (tl l) t) in let lefts = mapfilter lhs eqns in let l1,l2 = partition (\t. check_frees lefts (rhs t) ? true) eqns in if null l1 then REFL(list_mk_conj l2) else (let th1 = end_itlist CONJ (map ASSUME l2) in let subs_list = map (\th. (th, genvar(type_of(lhs(concl th))))) (CONJUNCTS th1) in let rn_list = map (\(th,v).(v,lhs(concl th))) subs_list in let subs_fn t = (mk_eq o (I # subst rn_list) o dest_eq) t ? subst rn_list t in let th2 = SUBST_CONV subs_list (list_mk_conj (map subs_fn l1)) (list_mk_conj l1) in let th3 = CONJ_DISCHL l2 th2 in let th4 = CONJUNCTS_CONV(t, lhs(concl th3)) in (th4 TRANS th3)) ) ? failwith `OLD_UNWIND_ONCE_CONV`;; % let OLD_UNWIND_ONCE_CONV t = (let eqns = conjuncts t in letrec check_frees l t = %any member of l free in t?% (if null l then false if free_in(hd l)t then true else check_frees (tl l) t) in let lefts = mapfilter lhs eqns in let l1,l2 = partition (\t. check_frees lefts (rhs t) ? true) eqns in if null l1 then REFL(list_mk_conj eqns) else (let subs_fun = subst(map((\(x,y).(y,x)) o dest_eq)l2) in let f l = (mk_eq o (I # subs_fun) o dest_eq) l ? subs_fun l in let l1' = map f l1 in mk_thm([], mk_eq(t, list_mk_conj(l1'@l2)))) ) ? failwith `OLD_UNWIND_ONCE_CONV`;; % Unwind until no change - may loop! letrec UNWIND_EQS eqs = let th = OLD_UNWIND_ONCE_CONV eqs in if lhs(concl th)=rhs(concl th) then th else th TRANS (UNWIND_EQS(rhs(concl th)));; % letrec UNWIND_EQS eqs = (let th = OLD_UNWIND_ONCE_CONV eqs in let t1,t2 = dest_eq(concl th) in if t1 = t2 then th else mk_thm([],mk_eq(t1, rhs(concl(UNWIND_EQS t2)))) ) ? failwith`UNWIND_EQS`;; % |- (?l1 ... lm. x1 = t1 /\ ... /\ xn = tn) = (?l1 ... lm. x1 = t1' /\ ... /\ xn = tn') Where t1',...,tn' are got from t1,...,tn by unwinding using the equations % let UNWIND t = let l,eqs = strip_exists t in LIST_MK_EXISTS l (UNWIND_EQS eqs);; let OLD_UNWIND_RULE th = RIGHT_CONV_RULE UNWIND th ? failwith `OLD_UNWIND_RULE`;; % "(!x. t1) /\ ... /\ (!x. tn)" ---> |- (!x. t1) /\ ... /\ (!x. tn) = !x. t1 /\ ... /\ tn let AND_FORALL_CONV t = (let xt1,xt2 = dest_conj t in let x = fst(dest_forall xt1) in let thl1 = CONJUNCTS(ASSUME t) in let th1 = DISCH_ALL(GEN x (LIST_CONJ(map(SPEC x)thl1))) in let thl2 = CONJUNCTS (SPEC x (ASSUME (mk_forall(x,(list_mk_conj(map(snd o dest_forall o concl)thl1)))))) in let th2 = DISCH_ALL(LIST_CONJ(map (GEN x) thl2)) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `AND_FORALL_CONV`;; % % "(!x. t1) /\ ... /\ (!x. tn)" ---> ("x", ["t1"; ... ;"tn"]) % letrec dest_andl t = ((let x1,t1 = dest_forall t in (x1,[t1]) ) ? (let first,rest = dest_conj t in let x1,l1 = dest_andl first and x2,l2 = dest_andl rest in if x1=x2 then (x1, l1@l2) else fail) ) ? failwith `dest_andl`;; % Version of AND_FORALL_CONV below will pull quantifiers out and flatten an arbitrary tree of /\s, not just a linear list. % let AND_FORALL_CONV t = (let x,l = dest_andl t in mk_thm([], mk_eq(t,mk_forall(x,list_mk_conj l))) ) ? failwith `AND_FORALL_CONV`;; % "!x. t1 /\ ... /\ tn" ---> |- !x. t1 /\ ... /\ tn = (!x. t1) /\ ... /\ (!x. tn) let FORALL_AND_CONV t = (let x,l = ((I # conjuncts) o dest_forall) t in SYM(AND_FORALL_CONV(list_mk_conj(map(curry mk_forall x)l))) ) ? failwith `AND_FORALL_CONV`;; % let FORALL_AND_CONV t = (let x,l = ((I # conjuncts) o dest_forall) t in mk_thm([],mk_eq(t, list_mk_conj(map(curry mk_forall x)l))) ) ? failwith `FORALL_AND_CONV`;; % |- (?l1 ... lm. (!x. x1 = t1) /\ ... /\ (!x. xn = tn)) = (?l1 ... lm. (!x. x1 = t1') /\ ... /\ (!x. xn = tn')) Where t1',...,tn' are got from t1,...,tn by unwinding using the equations: x1 = t1 /\ ... /\ xn = tn % let UNWINDF t = (let l,body = strip_exists t in let th1 = AND_FORALL_CONV body in let x,eqs = dest_forall(rhs(concl th1)) in let th2 = FORALL_EQ x (UNWIND_EQS eqs) in let th3 = FORALL_AND_CONV(rhs(concl th2)) in LIST_MK_EXISTS l (th1 TRANS th2 TRANS th3) ) ? failwith `UNWINDF`;; let UNWINDF_RULE th = RIGHT_CONV_RULE UNWINDF th ? failwith `UNWINDF_RULE`;; % A |- t1 = t2 -------------- (t2' got from t2 by unwinding) A |- t1 = t2' % % The next lot of rules are for pruning % % EXISTS_AND_LEFT: term -> thm "?x.t1/\t2" | - ?x. t1 /\ t2 = t1 /\ (?x. t2)" (If x not free in t1) % let EXISTS_AND_LEFT t = (let x,t1,t2 = ((I # dest_conj) o dest_exists) t in let t1_frees, t2_frees = frees t1, frees t2 in if not(mem x t2_frees & not(mem x t1_frees)) then fail else (let th1 = ASSUME "^t1 /\ ^t2" and t' = "^t1 /\ (?^x.^t2)" in let th2 = ASSUME t' in let th3 = DISCH t (CHOOSE (x, ASSUME t) (CONJ(CONJUNCT1 th1)(EXISTS("?^x.^t2",x)(CONJUNCT2 th1)))) % th3 = |-"?x. t1 /\ t2 ==> t1 /\ (?x. t2)" % and th4 = DISCH t' (CHOOSE (x, CONJUNCT2 th2) (EXISTS(t,x)(CONJ(CONJUNCT1 th2)(ASSUME t2)))) % th4 = |-"t1 /\ (?x. t2) ==> ?x. t1 /\ t2" % in IMP_ANTISYM_RULE th3 th4) ) ? failwith `EXISTS_AND_LEFT`;; % EXISTS_AND_RIGHT: term -> thm ?x.t1/\t2 |- ?x. t1 /\ t2 = (?x. t1) /\ t2" (If x not free in t2) % let EXISTS_AND_RIGHT t = (let x,t1,t2 = ((I # dest_conj) o dest_exists) t in let t1_frees, t2_frees = frees t1, frees t2 and th1 = ASSUME "^t1 /\ ^t2" in if not(mem x t1_frees & not(mem x t2_frees)) then fail else (let t' = "(?^x.^t1) /\ ^t2" in let th2 = ASSUME t' in let th3 = DISCH t (CHOOSE (x, ASSUME t) (CONJ(EXISTS("?^x.^t1",x)(CONJUNCT1 th1))(CONJUNCT2 th1))) % th3 = |-"?x. t1 /\ t2 ==> (?x.t1) /\ t2" % and th4 = DISCH t' (CHOOSE (x, CONJUNCT1 th2) (EXISTS(t,x)(CONJ(ASSUME t1)(CONJUNCT2 th2)))) % th4 = |-"(?x.t1) /\ t2 ==> ?x. t1 /\ t2" % in IMP_ANTISYM_RULE th3 th4) ) ? failwith `EXISTS_AND_RIGHT`;; % EXISTS_AND_BOTH: term -> thm ?x.t1/\t2 |- ?x. t1 /\ t2 = t1 /\ t2" (If x not free in t1 or t2) % let EXISTS_AND_BOTH t = (let x,t1,t2 = ((I # dest_conj) o dest_exists) t in let t1_frees, t2_frees = frees t1, frees t2 and th1 = ASSUME "^t1 /\ ^t2" in if (mem x t2_frees) or (mem x t1_frees) then fail else (let t' = "^t1 /\ ^t2" in let th3 = DISCH t (CHOOSE (x, ASSUME t) (ASSUME t')) % th3 = |-"?x. t1 /\ t2 ==> t1 /\ t2" % and th4 = DISCH t' (EXISTS(t, x)(ASSUME t')) % th4 = |-"t1 /\ t2 ==> ?x. t1 /\ t2" % in IMP_ANTISYM_RULE th3 th4) ) ? failwith `EXISTS_AND_BOTH`;; % EXISTS_AND: term -> thm ?x.t1/\t2 |- ?x. t1 /\ t2 = t1 /\ (?x. t2)" (If x not free in t1) |- ?x. t1 /\ t2 = (?x. t1) /\ t2" (If x not free in t2) |- ?x. t1 /\ t2 = t1 /\ t2" (If x not free in t1 or t2) % let EXISTS_AND t = EXISTS_AND_LEFT t ? EXISTS_AND_RIGHT t ? EXISTS_AND_BOTH t ? failwith`EXISTS_AND`;; % A |- ?x.?y.t ------------ A |- ?y.?x.t" % let EXISTS_PERM th = let x,y,t = ((I # dest_exists) o dest_exists o concl) th in CHOOSE (x,th) (CHOOSE (y, ASSUME "?^y.^t") (EXISTS("?^y^x.^t",y)(EXISTS("?^x.^t",x)(ASSUME t))));; % |- (?x y. t) = (?y x.t) % let EXISTS_PERM_CONV t = (let th1 = EXISTS_PERM(ASSUME t) in let t' = concl th1 in IMP_ANTISYM_RULE (DISCH t th1) (DISCH t' (EXISTS_PERM(ASSUME t'))) ) ? failwith`EXISTS_PERM_CONV`;; % EXISTS_EQN "?l. l x1 ... xn = t" --> |- (?l.l x1 ... xn = t) = T (if l not free in t) % let EXISTS_EQN t = (let l,t1,t2 = ((I # dest_eq) o dest_exists) t in let l',xs = strip_comb t1 in let t3 = list_mk_abs(xs,t2) in let th1 = RIGHT_CONV_RULE LIST_BETA_CONV (REFL(list_mk_comb(t3,xs))) in EQT_INTRO(EXISTS("?^l.^(list_mk_comb(l,xs))=^(rhs(concl th1))",t3)th1) ) ? failwith `EXISTS_EQN`;; % EXISTS_EQNF "?l. !x1 ... xn. l x1 ... xn = t" --> |- (?l. !x1 ... xn. l x1 ... xn = t) = T (if l not free in t) % let EXISTS_EQNF t = (let l,vars,t1,t2 = ((I # (I # dest_eq)) o (I # strip_forall) o dest_exists) t in let l',xs = strip_comb t1 in let t3 = list_mk_abs(xs,t2) in let th1 = GENL vars (RIGHT_CONV_RULE LIST_BETA_CONV (REFL(list_mk_comb(t3,xs)))) in EQT_INTRO (EXISTS ((mk_exists (l, list_mk_forall (xs, (mk_eq(list_mk_comb(l,xs), rhs(snd(strip_forall(concl th1)))))))), t3) th1) ) ? failwith `EXISTS_EQNF`;; % |- (?x.t) = t if x not free in t let EXISTS_DEL1 tm = (let x,t = dest_exists tm in let th1 = DISCH tm (CHOOSE (x, ASSUME tm) (ASSUME t)) and th2 = DISCH t (EXISTS(tm,x)(ASSUME t)) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `EXISTS_DEL`;; % % |- (?x1 ... xn.t) = t if x1,...,xn not free in t letrec EXISTS_DEL tm = (if is_exists tm then (let th1 = EXISTS_DEL1 tm in let th2 = EXISTS_DEL(rhs(concl th1)) in th1 TRANS th2) else REFL tm ) ? failwith`EXISTS_DEL`;; % let EXISTS_DEL tm = (let l,t = strip_exists tm and l' = frees tm in if intersect l l' = [] then mk_thm([], mk_eq(tm,t)) else fail ) ? failwith`EXISTS_DEL`;; % The pruning rule below will need to be made more complicated. |- (?l1 ... lm. t1 /\ ... /\ tn) = (u1 /\ ... /\ up) where each ti is an equation "xi = ti'" and the uis are those tis for which xi is not one of l1, ... ,lm. The rule below assumes that for each li there is exactly one ti with xi=li. This will have to be relaxed later. % % PRUNE1 prunes one hidden variable % let PRUNE1 x eqs = (let l1,l2 = partition(free_in x)(conjuncts eqs) in let th1 = LIST_MK_EXISTS [x] (CONJ_SET_CONV (conjuncts eqs) (l1@l2)) in let th2 = th1 TRANS EXISTS_AND_RIGHT(rhs(concl th1)) in let t1,t2 = dest_conj(rhs(concl th2)) in let th3 = th2 TRANS (AP_THM(AP_TERM "$/\" (EXISTS_EQN t1))t2) and th4 = CONJUNCT1 (SPEC t2 AND_CLAUSES) in th3 TRANS th4 ) ? failwith`PRUNE1`;; % |- (?l1 ... lm. t1 /\ ... /\ tn) = (u1 /\ ... /\ up) where each ti has the form "!x. xi x = ti'" and the uis are those tis for which xi is not one of l1, ... ,lm. The rule below assumes that for each li there is exactly one ti with xi=li. This will have to be relaxed later. % % PRUNE1F prunes one hidden variable % let PRUNE1F x eqs = (let l1,l2 = partition(free_in x)(conjuncts eqs) in let th1 = LIST_MK_EXISTS [x] (CONJ_SET_CONV (conjuncts eqs) (l1@l2)) in let th2 = th1 TRANS EXISTS_AND_RIGHT(rhs(concl th1)) in let t1,t2 = dest_conj(rhs(concl th2)) in let th3 = th2 TRANS (AP_THM(AP_TERM "$/\" (EXISTS_EQNF t1))t2) and th4 = CONJUNCT1 (SPEC t2 AND_CLAUSES) in th3 TRANS th4 ) ? failwith`PRUNE1F`;; letrec PRUNEL vars eqs = (if null vars then REFL eqs if null(tl vars) then PRUNE1 (hd vars) eqs else (let th1 = PRUNEL (tl vars) eqs in let th2 = PRUNE1 (hd vars) (rhs(concl th1)) in (LIST_MK_EXISTS [hd vars] th1) TRANS th2) ) ? failwith`PRUNEL`;; let PRUNE t = (let vars,eqs = strip_exists t in PRUNEL vars eqs) ? failwith`PRUNE`;; let PRUNE_RULE th = RIGHT_CONV_RULE PRUNE th ? failwith `PRUNE_RULE`;; letrec PRUNELF vars eqs = (if null vars then REFL eqs if null(tl vars) then PRUNE1F (hd vars) eqs else (let th1 = PRUNELF (tl vars) eqs in let th2 = PRUNE1F (hd vars) (rhs(concl th1)) in (LIST_MK_EXISTS [hd vars] th1) TRANS th2) ) ? failwith`PRUNELF`;; let PRUNEF t = (let vars,eqs = strip_exists t in PRUNELF vars eqs) ? failwith`PRUNEF`;; let PRUNEF_RULE th = RIGHT_CONV_RULE PRUNEF th ? failwith `PRUNEF_RULE`;; % EXPAND below is like EXPAND_IMP of LCF_LSM; it unfolds, unwinds and prunes % let EXPAND thl th = let th1 = UNFOLD_RULE thl th in let th2 = OLD_UNWIND_RULE th1 in PRUNE_RULE th2;; let EXPANDF thl th = let th1 = UNFOLD_RULE thl th in let th2 = UNWINDF_RULE th1 in PRUNEF_RULE th2;; % The stuff below superceeds some of the stuff above. Some cleaning % % up is needed ... % % New HOL Inference rules for unwinding device implementations. % % % % DATE 85.05.21 % % AUTHOR T. Melham % % AUXILIARY FUNCTION DEFINITIONS -------------------------------------- % % line_var "!v1 ... vn. f v1 ... vn = t" ====> "f" % let line_var tm = fst(strip_comb(lhs(snd(strip_forall tm))));; % var_name "var" ====> `var` % let var_name = fst o dest_var;; % line_name "!v1 ... vn. f v1 ... vn = t" ====> `f` % let line_name = var_name o line_var;; % UNWIND CONVERSIONS -------------------------------------------------- % % UNWIND_ONCE_CONV - Basic conversion for parallel unwinding of lines. % % % % DESCRIPTION: tm should be a conjunction, t1 /\ t2 ... /\ tn. % % p:term->bool is a function which is used to partition the% % terms (ti) into two sets. Those ti which p is true of % % are then used as a set of rewrite rules (thus they must % % be equations) to do a top-down one-step parallel rewrite % % of the conjunction of the remaining terms. I.e. % % % % t1 /\ ... /\ eqn1 /\ ... /\ eqni /\ ... /\ tn % % --------------------------------------------- % % |- t1 /\ ... /\ eqn1 /\ ... /\ eqni /\ ... /\ tn % % = % % eqn1 /\ ... /\ eqni /\ ... /\ t1' /\ ... /\ tn' % % % % where tj' is tj rewritten with the equations eqnx % let UNWIND_ONCE_CONV p tm = let eqns = conjuncts tm in let eq1,eq2 = partition (\tm. ((p tm) ? false)) eqns in if (null eq1) or (null eq2) then REFL tm else let thm = CONJ_DISCHL eq1 (ONCE_DEPTH_CONV (REWRITES_CONV (mk_conv_net (map ASSUME eq1))) (list_mk_conj eq2)) in let re = CONJUNCTS_CONV(tm,(lhs(concl thm))) in re TRANS thm;; % Unwind until no change using equations selected by p. % % WARNING -- MAY LOOP! % letrec UNWIND_CONV p tm = let th = UNWIND_ONCE_CONV p tm in if lhs(concl th)=rhs(concl th) then th else th TRANS (UNWIND_CONV p (rhs(concl th)));; % UNWIND CONVERSIONS -------------------------------------------------- % % One-step unwinding of device behaviour with hidden lines using line % % equations selected by p. % let UNWIND_ONCE_RULE p th = let rhs_conv = \rhs. (let lines,eqs = strip_exists rhs in LIST_MK_EXISTS lines (UNWIND_ONCE_CONV p eqs)) in RIGHT_CONV_RULE rhs_conv th ? failwith `UNWIND_ONCE_RULE`;; % Unwind device behaviour using line equations selected by p until no % % change. WARNING --- MAY LOOP! % let UNWIND_RULE p th = let rhs_conv = \rhs. (let lines,eqs = strip_exists rhs in LIST_MK_EXISTS lines (UNWIND_CONV p eqs)) in RIGHT_CONV_RULE rhs_conv th ? failwith `UNWIND_RULE`;; % Unwind all lines (except those in the list l) as much as possible. % let UNWIND_ALL_RULE l th = let rhs_conv = \rh. (let lines,eqs = strip_exists rh in let eqns = filter (can line_name) (conjuncts eqs) in let line_names = subtract (map line_name eqns) l in let p = \line. \tm. (line_name tm) = line in let itfn = \line. \th. th TRANS UNWIND_CONV (p line) (rhs(concl th)) in LIST_MK_EXISTS lines (itlist itfn line_names (REFL eqs))) in RIGHT_CONV_RULE rhs_conv th ? failwith `UNWIND_ALL_RULE`;; let NEW_EXPANDF l thl th = let th1 = UNFOLD_RULE thl th in let th2 = UNWIND_ALL_RULE l th1 in PRUNEF_RULE th2;; % TEST CASES ---------------- let imp = ASSUME "IMP(f,g,h) = ?l3 l2 l1. (!x:num. f x = (l1 (x+1)) + (l2 (x+2)) + (l3 (x+3))) /\ (!x. g x = (l3 (l3 (l3 x)))) /\ (!x. l2 x = (l3 x) - 1) /\ (!x. h x = l3 x) /\ (!x. l1 x = (l2 x) + 1) /\ (!x. l3 x = 7) /\ notanequation:bool";; let tm = "(!x:num. f x = (l1 (x+1)) + (l2 (x+2)) + (l3 (x+3))) /\ (!x. l1 x = (l2 x) + 1) /\ (!x. g x = (l3 (l3 (l3 x)))) /\ (!x. l2 x = (l3 x) - 1) /\ (!x. h x = l3 x) /\ (!x. l3 x = 7) /\ notanequation:bool";; UNWIND_ONCE_CONV (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) tm;; UNWIND_CONV (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) tm;; UNWIND_ONCE_RULE (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) imp;; UNWIND_RULE (\tm. mem (line_name tm) [`l1`;`l2`;`l3`]) imp;; UNWIND_ALL_RULE [] imp;; UNWIND_ALL_RULE [`l3`] imp;; % hol88-2.02.19940316/Library/unwind/Manual/0000750000212700021270000000000005535606430016056 5ustar cammcammhol88-2.02.19940316/Library/unwind/Manual/description.tex0000640000212700021270000003731205104515600021120 0ustar cammcamm\chapter{The unwind Library} This document describes the facilities provided by the \ml{unwind} library for the HOL system~\cite{description}. The library provides conversions and rules for unfolding, unwinding and pruning device implementations (logical representations of hardware). For a detailed description of these techniques, see~\cite{HVusingHOL}. Most of the functions fall into one of five groups. The first group consists of conversions and inference rules for moving universal quantifiers up and down through conjunctions; they have names beginning with either \ml{CONJ\_FORALL} or \ml{FORALL\_CONJ}. The second group of functions are for unfolding, that is expanding sub-components using their definitions. The names of these begin with \ml{UNFOLD}. The functions in the third group perform unwinding and have names beginning with \ml{UNWIND}. The fourth group of functions prune internal lines that have been unwound. Their names begin with \ml{PRUNE}. The final group of functions combine unfolding, unwinding and pruning. They have names beginning with \ml{EXPAND}. I have tried to make the behaviour of the functions uniform. The conversions apply to the smallest term possible, to provide maximum flexibility. The inference rules, on the other hand, are designed to apply to the definition of a hardware component. They expect to be given a theorem of the form: \begin{small}\begin{verbatim} |- !x1 ... xn. DEVICE (x1,...,xn) = ?l1 ... lm. t1 /\ ... /\ tp \end{verbatim}\end{small} \section{Using the library} The \ml{unwind} library can be loaded into a \HOL\ session using the function \ml{load\_library}\index{load\_library@{\ptt load\_library}} (see the \HOL\ manual for a general description of library loading). The first action in the load sequence initiated by \ml{load\_library} is to update the \HOL\ help\index{help!updating search path} search path. The help search path is updated with a pathname to online help files for the \ML\ functions in the library. After updating the help search path, the \ML\ functions in the library are loaded into \HOL. The following session shows how the \ml{unwind} library may be loaded using \ml{load\_library}: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #load_library `unwind`;; Loading library `unwind` ... Updating help search path .................................. Library `unwind` loaded. () : void \end{verbatim}\end{session} We now illustrate the use of the library on the parity-checker example. Firstly, we begin a new theory: \begin{session}\begin{verbatim} #new_theory `PARITY`;; () : void \end{verbatim}\end{session} \vfill \noindent We define the sub-components used: \vfill \begin{session}\begin{verbatim} #let ONE_DEF = # new_definition # (`ONE_DEF`, "ONE(out:num->bool) = !t. out t = T");; ONE_DEF = |- !out. ONE out = (!t. out t = T) \end{verbatim}\end{session} \vfill \begin{session}\begin{verbatim} #let NOT_DEF = # new_definition # (`NOT_DEF`, "NOT(in,out:num->bool) = !t. out t = ~(in t)");; NOT_DEF = |- !in out. NOT(in,out) = (!t. out t = ~in t) \end{verbatim}\end{session} \vfill \begin{session}\begin{verbatim} #let MUX_DEF = # new_definition # (`MUX_DEF`, # "MUX(sw,in1,in2,out:num->bool) = # !t. out t = (sw t => in1 t | in2 t)");; MUX_DEF = |- !sw in1 in2 out. MUX(sw,in1,in2,out) = (!t. out t = (sw t => in1 t | in2 t)) \end{verbatim}\end{session} \vfill \begin{session}\begin{verbatim} #let REG_DEF = # new_definition # (`REG_DEF`, "REG(in,out:num->bool) = # !t. out t = ((t=0) => F | in(t-1))");; REG_DEF = |- !in out. REG(in,out) = (!t. out t = ((t = 0) => F | in(t - 1))) \end{verbatim}\end{session} \vfill \noindent Now we define the parity-checker implementation: \begin{session}\begin{verbatim} #let PARITY_IMP_DEF = # new_definition # (`PARITY_IMP_DEF`, # "PARITY_IMP(in,out) = # ?l1 l2 l3 l4 l5. # NOT(l2,l1) /\ MUX(in,l1,l2,l3) /\ REG(out,l2) /\ # ONE l4 /\ REG(l4,l5) /\ MUX(l5,l3,l4,out)");; PARITY_IMP_DEF = |- !in out. PARITY_IMP(in,out) = (?l1 l2 l3 l4 l5. NOT(l2,l1) /\ MUX(in,l1,l2,l3) /\ REG(out,l2) /\ ONE l4 /\ REG(l4,l5) /\ MUX(l5,l3,l4,out)) \end{verbatim}\end{session} \noindent The function \ml{EXPAND\_AUTO\_RIGHT\_RULE} can be used to unfold, unwind and prune the body of this definition: \begin{session}\begin{verbatim} #EXPAND_AUTO_RIGHT_RULE [ONE_DEF;NOT_DEF;MUX_DEF;REG_DEF] PARITY_IMP_DEF;; |- !in out. PARITY_IMP(in,out) = (!t. out t = (((t = 0) => F | T) => (in t => ~((t = 0) => F | out(t - 1)) | ((t = 0) => F | out(t - 1))) | T)) \end{verbatim}\end{session} \section{Automatic unwinding} \def\putbox(#1,#2){\put(#1,#2){\framebox(2,2){}}} Hardware implementations often contain feedbacks. This presents a problem when trying to unwind and prune the internal lines in the logical representation. The mutual dependencies between lines can cause a brute-force unwind to loop indefinitely. To avoid this one has to be selective about which lines to unwind. The tools in the \ml{unwind} library allow the user to be selective in this way. However, it is possible for the machine itself to be selective. The function \ml{UNWIND\_AUTO\_CONV} attempts to analyze the dependencies between lines and unwind as far as possible without looping. Consider the following term which arises in the parity-checker example: \begin{small}\begin{verbatim} "?l1 l2 l3 l4 l5. (!t. l1 (t:num) = ~l2 t) /\ (!t. l3 t = (in t => l1 t | l2 t)) /\ (!t. l2 t = ((t = 0) => F | out (t - 1))) /\ (!t. l4 t = T) /\ (!t. l5 t = ((t = 0) => F | l4 (t - 1))) /\ (!t. out t = (l5 t => l3 t | l4 t))" \end{verbatim}\end{small} \noindent We can represent the dependencies of the lines using a directed graph: {\setlength{\unitlength}{4mm} \begin{center} \begin{picture}(14,10)(0,0) \put(0,2){\makebox(2,2){\small{\tt l2}}} \put(4,2){\makebox(2,2){\small{\tt l1}}} \put(8,4){\makebox(2,2){\small{\tt l3}}} \put(12,6){\makebox(2,2){\small{\tt out}}} \put(2,8){\makebox(2,2){\small{\tt l4}}} \put(6,8){\makebox(2,2){\small{\tt l5}}} \put(2,3){\vector(1,0){2}} \put(2,3){\vector(3,1){6}} \put(6,3){\vector(1,1){2}} \put(10,5){\vector(1,1){2}} \put(4,9){\vector(1,0){2}} \put(4,9){\vector(4,-1){8}} \put(8,9){\vector(2,-1){4}} \put(13,6){\line(0,-1){6}} \put(13,0){\line(-1,0){12}} \put(1,0){\vector(0,1){2}} \end{picture} \end{center}} \noindent which can in turn be represented by the following list: \begin{small}\begin{verbatim} l1, [l2] l3, [l1;l2] l2, [out] l4, [] l5, [l4] out,[l5;l3;l4] \end{verbatim}\end{small} Since we wish to eliminate the internal lines, we want to be left with a recursive equation for {\small\verb%out%} in terms of itself. We can do this be `breaking the loop' at {\small\verb%out%}, giving the following structure: \begin{small}\begin{verbatim} l1, [l2] l3, [l1;l2] l2, [] l4, [] l5, [l4] \end{verbatim}\end{small} \noindent Note that {\small\verb%out%} has been removed from the structure. From the graph we can see that {\small\verb%l2%} and {\small\verb%l4%} do not depend on any internal lines. They can therefore be used to unwind without any risk of looping. They can be recognized in the datastructure by the fact that their corresponding dependency lists are empty. Once we have unwound with {\small\verb%l2%} and {\small\verb%l4%} they can be removed from the datastructure: \begin{small}\begin{verbatim} l1, [] l3, [l1] l5, [] \end{verbatim}\end{small} \noindent We now see that {\small\verb%l1%} and {\small\verb%l5%} can be unwound to give: \begin{small}\begin{verbatim} l3, [] \end{verbatim}\end{small} \noindent Unwinding {\small\verb%l3%} then leaves us with the required recursive equation for {\small\verb%out%}. The problem with the approach just described is that it only unwinds fully if there is at most one loop in the circuit, and the output is in that loop. We can be a bit more general. Consider the circuit: \vfill {\setlength{\unitlength}{4mm} \begin{center} \begin{picture}(4,18)(0,0) \put(1,0){\makebox(2,2){\small{\tt out}}} \putbox(1,4) \put(0,6){\makebox(2,2){\small{\tt l2}}} \putbox(1,8) \put(0,10){\makebox(2,2){\small{\tt l1}}} \putbox(1,12) \put(1,16){\makebox(2,2){\small{\tt in}}} \put(2,16){\vector(0,-1){2}} \put(2,12){\vector(0,-1){2}} \put(2,8){\vector(0,-1){2}} \put(2,4){\vector(0,-1){2}} \put(2,7){\circle*{0.2}} \put(2,7){\line(1,0){2}} \put(4,7){\line(0,1){8}} \put(4,15){\line(-1,0){1}} \put(3,15){\vector(0,-1){1}} \end{picture} \end{center}} \vfill \noindent represented by the graph: \vfill \begin{small}\begin{verbatim} l1, [l2] l2, [l1] out,[l2] \end{verbatim}\end{small} \vfill \noindent There are no lines with an empty dependency list, and eliminating {\small\verb%out%} will not help because it is not in the loop. However, if we break the loop at {\small\verb%l2%} we can unwind {\small\verb%l1%}. This will leave us with a recursive equation for {\small\verb%l2%} and an equation for {\small\verb%out%} in terms of {\small\verb%l2%}. This is the best that we can do, and it is now up to the user to deal with the recursive equation. Now let's consider an example with more than one loop: {\setlength{\unitlength}{4mm} \begin{center} \begin{picture}(12,30)(0,0) \put(1,0){\makebox(2,2){\small{\tt out}}} \putbox(1,4) \put(0,6){\makebox(2,2){\small{\tt l5}}} \putbox(1,8) \put(0,10){\makebox(2,2){\small{\tt l4}}} \putbox(1,12) \put(0,14){\makebox(2,2){\small{\tt l3}}} \putbox(1,16) \putbox(5,16) \put(0,18){\makebox(2,2){\small{\tt l2}}} \put(6,18){\makebox(2,2){\small{\tt l6}}} \putbox(1,20) \putbox(9,20) \put(0,22){\makebox(2,2){\small{\tt l1}}} \put(10,22){\makebox(2,2){\small{\tt l7}}} \putbox(1,24) \put(1,28){\makebox(2,2){\small{\tt in}}} \put(2,28){\vector(0,-1){2}} \put(2,24){\vector(0,-1){2}} \put(2,20){\vector(0,-1){2}} \put(2,16){\vector(0,-1){2}} \put(2,12){\vector(0,-1){2}} \put(2,8){\vector(0,-1){2}} \put(2,4){\vector(0,-1){2}} \put(2,11){\circle*{0.2}} \put(2,11){\line(1,0){4}} \put(6,11){\vector(0,1){5}} \put(6,18){\line(0,1){1}} \put(6,19){\line(-1,0){3}} \put(3,19){\vector(0,-1){1}} \put(2,7){\circle*{0.2}} \put(2,7){\line(1,0){8}} \put(10,7){\vector(0,1){13}} \put(10,22){\line(0,1){1}} \put(10,23){\line(-1,0){7}} \put(3,23){\vector(0,-1){1}} \end{picture} \end{center}} \noindent We could unwind {\small\verb%l1%} but then we would get stuck. If we break at {\small\verb%l2%} or {\small\verb%l7%} we will still get stuck because of the inner loop. If we break at {\small\verb%l5%} we can unwind {\small\verb%l7%}, but then get stuck. If we break at {\small\verb%l6%} we get stuck because of the outer loop. However, if we break at {\small\verb%l3%} or {\small\verb%l4%} both loops are broken and we can unwind fully to leave a recursive equation for either {\small\verb%l3%} or {\small\verb%l4%} and an equation for {\small\verb%out%} in terms of that line. So, the choice of where to break a loop may determine how far the unwinding can go. \ml{UNWIND\_AUTO\_CONV} attempts to break every loop in the circuit using the minimum number of breaks, so that there are as few equations left as possible. The function also gives priority to non-internal lines when determining where to break, so that if possible the recursive equations are in terms of these lines. The algorithm used determines from the term a list of line variables. Each line variable has a right-hand side of an equation associated with it. The free variables in each right-hand side are computed and those that are also line variables are placed in the dependency list for the corresponding line. From the dependency structure, the loops are determined. Lines are then eliminated so that all loops are broken. A study of the following circuit reveals why {\em all\/} loops have to be broken. If not all loops are broken, then a remaining loop can make the breaking of other loops fruitless. {\setlength{\unitlength}{4mm} \begin{center} \begin{picture}(12,30)(0,0) \put(1,0){\makebox(2,2){\small{\tt out}}} \putbox(1,4) \put(0,6){\makebox(2,2){\small{\tt l5}}} \putbox(1,8) \put(0,10){\makebox(2,2){\small{\tt l4}}} \putbox(1,12) \putbox(9,12) \put(0,14){\makebox(2,2){\small{\tt l3}}} \put(10,14){\makebox(2,2){\small{\tt l7}}} \putbox(1,16) \putbox(5,16) \put(0,18){\makebox(2,2){\small{\tt l2}}} \put(6,18){\makebox(2,2){\small{\tt l6}}} \putbox(1,20) \put(0,22){\makebox(2,2){\small{\tt l1}}} \putbox(1,24) \put(1,28){\makebox(2,2){\small{\tt in}}} \put(2,28){\vector(0,-1){2}} \put(2,24){\vector(0,-1){2}} \put(2,20){\vector(0,-1){2}} \put(2,16){\vector(0,-1){2}} \put(2,12){\vector(0,-1){2}} \put(2,8){\vector(0,-1){2}} \put(2,4){\vector(0,-1){2}} \put(2,11){\circle*{0.2}} \put(2,11){\line(1,0){4}} \put(6,11){\vector(0,1){5}} \put(6,18){\line(0,1){1}} \put(6,19){\line(-1,0){3}} \put(3,19){\vector(0,-1){1}} \put(2,7){\circle*{0.2}} \put(2,7){\line(1,0){8}} \put(10,7){\vector(0,1){5}} \put(10,14){\line(0,1){1}} \put(10,15){\line(-1,0){7}} \put(3,15){\vector(0,-1){1}} \end{picture} \end{center}} \noindent The dependency structure for the circuit is: \begin{small}\begin{verbatim} l1, [] l2, [l1] l3, [l2;l6] l4, [l3;l7] l5, [l4] l6, [l4] l7, [l5] out,[l5] \end{verbatim}\end{small} \noindent The loops for the circuit are: \begin{small}\begin{verbatim} [l3;l4;l6] [l4;l5;l7] \end{verbatim}\end{small} \noindent Both loops can be broken by eliminating {\small\verb%l4%}: \begin{small}\begin{verbatim} l1, [] l2, [l1] l3, [l2;l6] l5, [] l6, [] l7, [l5] out,[l5] \end{verbatim}\end{small} \noindent We can now unwind {\small\verb%l1%}, {\small\verb%l5%} and {\small\verb%l6%}: \begin{small}\begin{verbatim} l2, [] l3, [l2] l7, [] out,[] \end{verbatim}\end{small} \noindent and then unwind {\small\verb%l2%}, {\small\verb%l7%} and {\small\verb%out%}, followed by unwinding with {\small\verb%l3%} to yield a recursive equation for {\small\verb%l4%} and all other equations in terms of {\small\verb%l4%}. All the internal lines except for {\small\verb%l4%} can be pruned. This leaves equations for {\small\verb%l4%} and {\small\verb%out%} only. The technique does not always yield a single recursive equation. Mutual recursion is also possible. This is illustrated by the following example: {\setlength{\unitlength}{4mm} \begin{center} \begin{picture}(10,30)(0,0) \put(1,0){\makebox(2,2){\small{\tt out}}} \putbox(1,4) \put(0,6){\makebox(2,2){\small{\tt l5}}} \putbox(1,8) \put(0,10){\makebox(2,2){\small{\tt l4}}} \putbox(1,12) \putbox(5,10) \put(0,14){\makebox(2,2){\small{\tt l3}}} \put(6,12){\makebox(2,2){\small{\tt l7}}} \putbox(1,16) \put(0,18){\makebox(2,2){\small{\tt l2}}} \putbox(1,20) \putbox(5,18) \put(0,22){\makebox(2,2){\small{\tt l1}}} \put(6,20){\makebox(2,2){\small{\tt l6}}} \putbox(1,24) \put(1,28){\makebox(2,2){\small{\tt in}}} \put(2,28){\vector(0,-1){2}} \put(2,24){\vector(0,-1){2}} \put(2,20){\vector(0,-1){2}} \put(2,16){\vector(0,-1){2}} \put(2,12){\vector(0,-1){2}} \put(2,8){\vector(0,-1){2}} \put(2,4){\vector(0,-1){2}} \put(2,15){\circle*{0.2}} \put(2,15){\line(1,0){4}} \put(6,15){\vector(0,1){3}} \put(6,20){\line(0,1){2}} \put(6,22){\vector(-1,0){3}} \put(2,7){\circle*{0.2}} \put(2,7){\line(1,0){4}} \put(6,7){\vector(0,1){3}} \put(6,12){\line(0,1){2}} \put(6,14){\vector(-1,0){3}} \put(6,7){\circle*{0.2}} \put(6,7){\line(1,0){4}} \put(10,7){\line(0,1){16}} \put(10,23){\line(-1,0){7}} \put(3,23){\vector(0,-1){1}} \end{picture} \end{center}} There are three loops, but breaking at {\small\verb%l2%} and {\small\verb%l4%} is sufficient to break all the loops. The result is three equations: an equation for {\small\verb%l2%} in terms of itself and {\small\verb%l4%}, an equation for {\small\verb%l4%} in terms of itself and {\small\verb%l2%}, and an equation for {\small\verb%out%} in terms of {\small\verb%l4%}. So, it can be seen that the loop analysis technique used by \ml{UNWIND\_AUTO\_CONV} does not eliminate loops; it simply `shrinks' them. hol88-2.02.19940316/Library/unwind/Manual/unwind.tex0000640000212700021270000000443505104515641020106 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: unwind library (standard latex style) % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{description} % --------------------------------------------------------------------- % Reference manual entries for functions % --------------------------------------------------------------------- \include{entries} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/unwind/Manual/unwind.log0000640000212700021270000000535605535606457020110 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:27 **unwind.tex (unwind.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file unwind.idx (unwind.aux (title.aux) (description.aux) (entries.aux) (references.aux) (index.aux)) (title.tex [1 ] [2]) (unwind.toc) \tf@toc=\write4 [3 ] [4 ] (description.tex Chapter 1. [1 ] [2] [3] [4] [5] [6] [7]) [8] [9] (entries.tex [10 ] Chapter 2. (entries-intro.tex) Underfull \vbox (badness 1314) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.36276 .\write2{\@writefile{toc}{\string\contentsline\space {chapter}{\string\numberl\ ETC.} .\mark{{{Chapter\ 2. \ ML Functions in the unwind Library}}{}} .\write2{\@writefile{lof}{\string\addvspace\space {10\p@ }}} .\write2{\@writefile{lot}{\string\addvspace\space {10\p@ }}} .\glue(\topskip) 2.00002 .etc. [11] [12] [13] [14] [15] [16] [17] Underfull \vbox (badness 10000) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 4.55931 .\mark{{{Chapter\ 2. \ ML Functions in the unwind Library}}{{\small \pbf EXP\ET C.} .\glue(\topskip) 12.0 .\hbox(0.0+0.0)x455.24408, glue set 455.24408fil ..\hbox(0.0+0.0)x0.0 ..\glue 0.0 ..\hbox(0.0+0.0)x0.0 ...\glue 0.0 ...\glue 0.0 ...\glue -5.87494 ...\hbox(0.0+0.0)x0.0 ...\glue 5.87494 ..\penalty 0 ..\glue(\rightskip) 0.0 plus 1.0fil .\penalty 10300 .\glue(\lineskip) 1.0 .etc. [18] [19] [20] [21] [22] [23] [24] [25] [26] [27] [28] [29] [30] [31] [32] [33] [34] [35] [36] [37] [38]) [39] (references.tex [40 ]) [41] (index.tex [42 ]) (unwind.aux (title.aux) (description.aux) (entries.aux) (references.aux) (index.aux)) ) Here is how much of TeX's memory you used: 445 strings out of 11977 3711 string characters out of 87025 39536 words of memory out of 262141 2288 multiletter control sequences out of 9500 19472 words of font info for 74 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 17i,12n,17p,178b,458s stack positions out of 300i,100n,60p,3000b,4000s Output written on unwind.dvi (46 pages, 75704 bytes). hol88-2.02.19940316/Library/unwind/Manual/unwind.idx0000640000212700021270000000415105535606457020103 0ustar cammcamm\indexentry{load\_library@{\ptt load\_library}}{1} \indexentry{help!updating search path}{1} \indexentry{CONJ\_FORALL\_CONV@{\ptt CONJ\_FORALL\_CONV}}{11} \indexentry{CONJ\_FORALL\_ONCE\_CONV@{\ptt CONJ\_FORALL\_ONCE\_CONV}}{12} \indexentry{CONJ\_FORALL\_RIGHT\_RULE@{\ptt CONJ\_FORALL\_RIGHT\_RULE}}{13} \indexentry{DEPTH\_EXISTS\_CONV@{\ptt DEPTH\_EXISTS\_CONV}}{14} \indexentry{DEPTH\_FORALL\_CONV@{\ptt DEPTH\_FORALL\_CONV}}{14} \indexentry{EXISTS\_DEL1\_CONV@{\ptt EXISTS\_DEL1\_CONV}}{15} \indexentry{EXISTS\_DEL\_CONV@{\ptt EXISTS\_DEL\_CONV}}{15} \indexentry{EXISTS\_EQN\_CONV@{\ptt EXISTS\_EQN\_CONV}}{16} \indexentry{EXPAND\_ALL\_BUT\_CONV@{\ptt EXPAND\_ALL\_BUT\_CONV}}{16} \indexentry{EXPAND\_ALL\_BUT\_RIGHT\_RULE@{\ptt EXPAND\_ALL\_BUT\_RIGHT\_RULE}}{18} \indexentry{EXPAND\_AUTO\_CONV@{\ptt EXPAND\_AUTO\_CONV}}{19} \indexentry{EXPAND\_AUTO\_RIGHT\_RULE@{\ptt EXPAND\_AUTO\_RIGHT\_RULE}}{20} \indexentry{FLATTEN\_CONJ\_CONV@{\ptt FLATTEN\_CONJ\_CONV}}{21} \indexentry{FORALL\_CONJ\_CONV@{\ptt FORALL\_CONJ\_CONV}}{22} \indexentry{FORALL\_CONJ\_ONCE\_CONV@{\ptt FORALL\_CONJ\_ONCE\_CONV}}{23} \indexentry{FORALL\_CONJ\_RIGHT\_RULE@{\ptt FORALL\_CONJ\_RIGHT\_RULE}}{24} \indexentry{line\_name@{\ptt line\_name}}{25} \indexentry{line\_var@{\ptt line\_var}}{25} \indexentry{PRUNE\_CONV@{\ptt PRUNE\_CONV}}{25} \indexentry{PRUNE\_ONCE\_CONV@{\ptt PRUNE\_ONCE\_CONV}}{26} \indexentry{PRUNE\_ONE\_CONV@{\ptt PRUNE\_ONE\_CONV}}{27} \indexentry{PRUNE\_RIGHT\_RULE@{\ptt PRUNE\_RIGHT\_RULE}}{28} \indexentry{PRUNE\_SOME\_CONV@{\ptt PRUNE\_SOME\_CONV}}{29} \indexentry{PRUNE\_SOME\_RIGHT\_RULE@{\ptt PRUNE\_SOME\_RIGHT\_RULE}}{30} \indexentry{UNFOLD\_CONV@{\ptt UNFOLD\_CONV}}{32} \indexentry{UNFOLD\_RIGHT\_RULE@{\ptt UNFOLD\_RIGHT\_RULE}}{32} \indexentry{UNWIND\_ALL\_BUT\_CONV@{\ptt UNWIND\_ALL\_BUT\_CONV}}{33} \indexentry{UNWIND\_ALL\_BUT\_RIGHT\_RULE@{\ptt UNWIND\_ALL\_BUT\_RIGHT\_RULE}}{34} \indexentry{UNWIND\_AUTO\_CONV@{\ptt UNWIND\_AUTO\_CONV}}{35} \indexentry{UNWIND\_AUTO\_RIGHT\_RULE@{\ptt UNWIND\_AUTO\_RIGHT\_RULE}}{36} \indexentry{UNWIND\_CONV@{\ptt UNWIND\_CONV}}{37} \indexentry{UNWIND\_ONCE\_CONV@{\ptt UNWIND\_ONCE\_CONV}}{38} hol88-2.02.19940316/Library/unwind/Manual/unwind.aux0000640000212700021270000000016405535606457020114 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{references.aux} \@input{index.aux} hol88-2.02.19940316/Library/unwind/Manual/title.aux0000640000212700021270000000077305535606435017733 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/unwind/Manual/unwind.dvi0000640000212700021270000022367005535606457020112 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1027‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘T”óHò"VáG cmbx10ëHThe– ‰‹HOL“un‘ÿ4‰wind“LibraryŽŸI­Û’– éó7ò"Vff cmbx10âDouÂcumenšŠ=tation–…written“b˜yŽŸ’Äæ¶R.–…J.“BoultonŽ lÃÒ‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’Ñd"August‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’™I¨ž£hó+X«Q cmr12ÖcŽŽŽ’•æó-!",š cmsy10Ø ŽŽŽŽ’¥ÐÁÖR.–ê¨J.“Boulton“1991ŽŽŽŒ‹ý ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFLÛ1Ž‘ŸôThe–€un wind“Library’7žˆ1ŽŽ¤‘ŸôÖ1.1Ž‘,¦JUsing–ê¨the“library‘ÆC‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ߎŒ‹? ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸGëHThe– ‰‹un‘ÿ4‰wind“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–§ìdošSŽcumen¬rt“describ˜es“the“facilities“proš¬rvided“b˜y“the“ó(ßêþÓ|-–¿ª!x1“...“xn.“DEVICE“(x1,...,xn)“=“?l1“...“lm.“t1“/\“...“/\“tpŽŸ'¾ó<ò"VG® cmbx10ç1.1Ž‘-C„Using–Ÿ¼the“libraryŽŸâ#ÖThe‘ýaÓunwindŽ‘,x¾Ölibrary–ýacan“bSŽe“loaded“in¬rto“a“ó"Kñ`y ó3 cmr10ÍHOL“Ösession“using“the“function“Óload_libraryŽŽ¡Ö(see–Ó:the“ÍHOL“Öman¬rual“for“a“general“description“of“library“loading).‘1The“ rst“action“in“theŽ¡load–^msequence“initiated“bš¬ry“Óload_libraryŽ‘K¸ÒÖis“to“upSŽdate“the“ÍHOL“Öhelp“searc˜h“path.‘ "The“helpŽ¡searc¬rh–?°path“is“upSŽdated“with“a“pathname“to“online“help“ les“for“the“ÍML“Öfunctions“in“theŽ¡library‘ÿV.‘ü¶After–+ïupSŽdating“the“help“searc¬rh“path,‘|ŽŽŽ ”/ß ý‹Ð!‘öSzÖW‘ÿVe–knoš¬rw“illustrate“the“use“of“the“library“on“the“parit˜y-c˜hec˜k˜er“example.‘ðvFirstly‘ÿV,‘<Þw˜e“bSŽeginŽŸ‘êñëa–ê¨new“theory:ŽŸ!©‘êñëŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#new_theory‘¿ª`PARITY`;;ŽŸ ‘ÌÍ()–¿ª:“voidŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ6Ãé‘êñëÖW‘ÿVe–ê¨de ne“the“sub-compSŽonen¬rts“used:ŽŸCÔv‘êñëŸâ)‰ffÇ IŸ1¢ÌÍŸYœ„5û­ffŸÔ[a’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªONE_DEF“=Ž¤ ‘ÌÍ#‘¿ªnew_definitionŽ¡‘ÌÍ#‘ T(`ONE_DEF`,–¿ª"ONE(out:num->bool)“=“!t.“out“t“=“T");;Ž¡‘ÌÍONE_DEF–¿ª=“|-“!out.“ONE“out“=“(!t.“out“t“=“T)ŽŽ’Æq°„5û­ffŽŽŸÀ‰ffÇ IŽŽŽŸg °‘êñëŸáÄ׉ffÇ IŸ2¶ÌÍŸYœ„6vRffŸÓ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ4ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªNOT_DEF“=Ž¤ ‘ÌÍ#‘¿ªnew_definitionŽ¡‘ÌÍ#‘ T(`NOT_DEF`,–¿ª"NOT(in,out:num->bool)“=“!t.“out“t“=“~(in“t)");;Ž¡‘ÌÍNOT_DEF–¿ª=“|-“!in“out.“NOT(in,out)“=“(!t.“out“t“=“~in“t)ŽŽ’Æq°„6vRffŽŽŸÀ‰ffÇ IŽŽŽ ^‘êñëŸÇÄ׉ffÇ IŸf¶ÌÍŸYœ„jvRffŸŸà¼’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ5ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªMUX_DEF“=Ž¤ ‘ÌÍ#‘¿ªnew_definitionŽ¡‘ÌÍ#‘ T(`MUX_DEF`,Ž¡‘ÌÍ#‘>þ"MUX(sw,in1,in2,out:num->bool)‘¿ª=Ž¡‘ÌÍ#‘¾R!t.–¿ªout“t“=“(sw“t“=>“in1“t“|“in2“t)");;Ž¡‘ÌÍMUX_DEF‘¿ª=Ž¡‘ÌÍ|-–¿ª!sw“in1“in2“out.Ž¡‘ËuMUX(sw,in1,in2,out)–¿ª=“(!t.“out“t“=“(sw“t“=>“in1“t“|“in2“t))ŽŽ’Æq°„jvRffŽŽŸÀ‰ffÇ IŽŽŽ Ž^‘êñëŸÔÄ׉ffÇ IŸL¶ÌÍŸYœ„PvRffŸ¹à¼’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ6ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªREG_DEF“=Ž¤ ‘ÌÍ#‘¿ªnew_definitionŽ¡‘ÌÍ#–¿ª(`REG_DEF`,“"REG(in,out:num->bool)“=Ž¡‘ÌÍ#‘P{L!t.–¿ªout“t“=“((t=0)“=>“F“|“in(t-1))");;Ž¡‘ÌÍREG_DEF‘¿ª=Ž¡‘ÌÍ|-–¿ª!in“out.“REG(in,out)“=“(!t.“out“t“=“((t“=“0)“=>“F“|“in(t“-“1)))ŽŽ’Æq°„PvRffŽŽŸÀ‰ffÇ IŽŽŽŸQÈ‘êñëÖNo•¬rw›ê¨w“e˜de ne˜the˜parit“y-c“hec“k“er˜implemen“tation:ŽŽŽŒ‹v ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ Automatic‘€un winding’"\µ3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýòñ°‘ÇaŸD׉ffÇ I Û¶ÌÍŸYœ„ßvRff ÿ*༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ7ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªPARITY_IMP_DEF“=Ž¤ ‘ÌÍ#‘¿ªnew_definitionŽ¡‘ÌÍ#‘ T(`PARITY_IMP_DEF`,Ž¡‘ÌÍ#‘>þ"PARITY_IMP(in,out)‘¿ª=Ž¡‘ÌÍ#‘þ¨?l1–¿ªl2“l3“l4“l5.Ž¡‘ÌÍ#‘¾RNOT(l2,l1)–¿ª/\“MUX(in,l1,l2,l3)“/\“REG(out,l2)“/\Ž¡‘ÌÍ#–¾RONE›¿ªl4“/\˜REG(l4,l5)‘(=¦/\˜MUX(l5,l3,l4,out)");;Ž¡‘ÌÍPARITY_IMP_DEF‘¿ª=Ž¡‘ÌÍ|-–¿ª!in“out.Ž¡‘ËuPARITY_IMP(in,out)‘¿ª=Ž¡‘Ëu(?l1–¿ªl2“l3“l4“l5.Ž¡‘(JÉNOT(l2,l1)‘¿ª/\Ž¡‘(JÉMUX(in,l1,l2,l3)‘¿ª/\Ž¡‘(JÉREG(out,l2)‘¿ª/\Ž¡‘(JÉONE–¿ªl4“/\Ž¡‘(JÉREG(l4,l5)‘¿ª/\Ž¡‘(JÉMUX(l5,l3,l4,out))ŽŽ’Æq°„ßvRffŽŽŸÀ‰ffÇ IŽŽŽ „ÎQ‘ÇaÖThe–O°function“ÓEXPAND_AUTO_RIGHT_RULEŽ’…üÖcan“bšSŽe“used“to“unfold,‘n¯un¬rwind“and“prune“the“b˜o˜dyŽ¤‘Çaof–ê¨this“de nition:ŽŸTÜ/‘ÇaŸ»µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ8ŽŽŽŽŸÿ@T‘ÌÍÓ#EXPAND_AUTO_RIGHT_RULE–¿ª[ONE_DEF;NOT_DEF;MUX_DEF;REG_DEF]“PARITY_IMP_DEF;;Ž¤ ‘ÌÍ|-–¿ª!in“out.Ž¡‘ËuPARITY_IMP(in,out)‘¿ª=Ž¡‘Ëu(!t.Ž¡‘(JÉout–¿ªt“=Ž¡‘(JÉ(((t–¿ª=“0)“=>“F“|“T)“=>Ž¡‘. s(in–¿ªt“=>Ž¡‘3Ê~((t–¿ª=“0)“=>“F“|“out(t“-“1))“|Ž¡‘3Ê((t–¿ª=“0)“=>“F“|“out(t“-“1)))“|Ž¡‘. sT))ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ_—’‘Çaç1.2Ž‘@ åAutomatic‘Ÿ¼un‘ÿr°windingŽŸEå‘ÇaÖHardw•¬rare›k±implemen“tations˜often˜con“tain˜feedbac“ks.‘ŽThis˜presen“ts˜a˜problem˜when˜tryingŽ¡‘Çato–çunš¬rwind“and“prune“the“in˜ternal“lines“in“the“logical“represen˜tation.‘´žThe“m˜utual“depSŽen-Ž¡‘Çadencies›ZbSŽet•¬rw“een˜lines˜can˜cause˜a˜brute-force˜un“wind˜to˜loSŽop˜inde nitely–ÿV.‘‡-T“o˜a•¬rv“oid˜thisŽ¡‘Çaone–d3has“to“bšSŽe“selectiv¬re“ab˜out“whicš¬rh“lines“to“un˜wind.‘ The“toSŽols“in“the“ÓunwindŽ‘)FbÖlibrary“allo˜wŽ¡‘Çathe–ˆºuser“to“bSŽe“selectivš¬re“in“this“w˜a˜y‘ÿV.‘Ho˜w˜ev˜er,‘°?it“is“pSŽossible“for“the“mac˜hine“itself“to“bSŽeŽ¡‘Çaselectiv¬re.‘3‚The–ÚŽfunction“ÓUNWIND_AUTO_CONVŽ‘c¯¼Öattempts“to“analyze“the“depšSŽendencies“b˜et•¬rw“eenŽ¡‘Çalines–ê¨and“un¬rwind“as“far“as“pšSŽossible“without“lo˜oping.ŽŸ1‘(ðConsider–ê¨the“folloš¬rwing“term“whic˜h“arises“in“the“parit˜y-c˜hec˜k˜er“example:ŽŸ"‘$_Ó"?l1–¿ªl2“l3“l4“l5.Ž¤ ™š‘/…³(!t.–¿ªl1“(t:num)“=“~l2“t)“/\Ž¡‘/…³(!t.–¿ªl3“t“=“(in“t“=>“l1“t“|“l2“t))“/\ŽŽŽŒ‹› ÌU ýFÓŸú™š‘êñëÛ4’ÿ‚ Chapter–€1.‘ €The“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘°=Ó(!t.–¿ªl2“t“=“((t“=“0)“=>“F“|“out“(t“-“1)))“/\Ž¤ ™š‘°=(!t.–¿ªl4“t“=“T)“/\Ž¡‘°=(!t.–¿ªl5“t“=“((t“=“0)“=>“F“|“l4“(t“-“1)))“/\Ž¡‘°=(!t.–¿ªout“t“=“(l5“t“=>“l3“t“|“l4“t))"Ž¤‰¿‘êñëÖW‘ÿVe–ê¨can“represen¬rt“the“depSŽendencies“of“the“lines“using“a“directed“graph:Ž €®©Ÿá3Ü’„ˆ%Ól2ŽŽŽŸá3Ü’²al1ŽŽŽŸÊp¾’ß”l3ŽŽŽŸ³\û’ ;outŽŽŽŸœê‚’›KCl4ŽŽŽŸœê‚’ÈÑl5ŽŽŽ’•©^ŸÞ…„fdÑöžÌÎóDäO£ line10ëD-ŽŽ’•©^ŸÝÛSŽ’Ÿ©^ŸÚ…þŽ’©©^Ÿ×0©Ž’³©^ŸÓÛTŽ’½©^ŸÐ…ÿŽ’Ç©^ŸÍ0ªŽ’Ïò¸ŸÊnŽ’Ïò¸ŸÊn1ŽŽ’Ã/šŸÝÛSŽ’Í/šŸÓÛSŽ’Ïò¸ŸÑÄŽ’Ïò¸ŸÑÄŽŽ’ðµÖŸÇ5Ž’úµÖŸ½5Ž’ýxôŸºU¦Ž’ýxôŸºU¦ŽŽ’¬l|Ÿ™Å+„fdÑöžÌÎ-ŽŽ’¬l|ŸœùXŽ’¶l|Ÿž‘ùXŽ’Àl|Ÿ¡ùXŽ’Êl|Ÿ£‘ùXŽ’Ôl|Ÿ¦ùXŽ’Þl|Ÿ¨‘ùXŽ’èl|Ÿ«ùXŽ’òl|Ÿ­‘ùXŽ’ül|Ÿ°ùXŽ’ýxôŸ°TˆXŽ’ýxôŸ°TˆzŽŽ’Ùò¸Ÿž‘ùHŽ’ãò¸Ÿ£‘ùHŽ’íò¸Ÿ¨‘ùHŽ’÷ò¸Ÿ­‘ùHŽ’ýxôŸ°TˆHŽ’ýxôŸ°TˆjŽŽ’§Q„DIZfeŽŽ’ŠGÏž32„fdˆ’´Ž’Š„ÃfeŽ’ŠGÏŸó<â6ŽŽŽŽŽŽŽ¡‘êñëÖwhicš¬rh–ê¨can“in“turn“bSŽe“represen˜ted“b˜y“the“follo˜wing“list:Ž©#Y‘ü0éÓl1,‘¿ª[l2]Ž¤ ™š‘ü0él3,‘¿ª[l1;l2]Ž¡‘ü0él2,‘¿ª[out]Ž¡‘ü0él4,‘¿ª[]Ž¡‘ü0él5,‘¿ª[l4]Ž¡‘ü0éout,[l5;l3;l4]ŽŸ‰¿‘öSzÖSince–Þºwš¬re“wish“to“eliminate“the“in˜ternal“lines,‘Pw˜e“w˜an˜t“to“bSŽe“left“with“a“recursiv˜e“equationŽ¤‘êñëfor–•Óout“Öin“terms“of“itself.‘óÚW‘ÿVe“can“do“this“bšSŽe“`breaking“the“lo˜op'“at“ÓoutÖ,‘Dÿgiving“the“follo¬rwingŽ¡‘êñëstructure:Ž¦‘ü0éÓl1,‘¿ª[l2]Ž¤ ™š‘ü0él3,‘¿ª[l1;l2]Ž¡‘ü0él2,‘¿ª[]Ž¡‘ü0él4,‘¿ª[]Ž¡‘ü0él5,‘¿ª[l4]ŽŸ‰¿‘êñëÖNote–ýTthat“Óout“Öhas“bSŽeen“remo•¬rv“ed–ýTfrom“the“structure.‘pãF‘ÿVrom“the“graph“w¬re“can“see“thatŽ¤‘êñëÓl2–¶®Öand“Ól4“Ödo“not“depSŽend“on“anš¬ry“in˜ternal“lines.‘œñThey“can“therefore“bSŽe“used“to“un˜windŽ¡‘êñëwithout–xnan¬ry“risk“of“lošSŽoping.‘ÍThey“can“b˜e“recognized“in“the“datastructure“b¬ry“the“fact“thatŽ¡‘êñëtheir–ê¨correspšSŽonding“dep˜endency“lists“are“empt¬ry‘ÿV.Ž¡‘öSzOnce–ê¨wš¬re“ha˜v˜e“un˜w˜ound“with“Ól2“Öand“Ól4“Öthey“can“bSŽe“remo˜v˜ed“from“the“datastructure:Ž¦‘ü0éÓl1,‘¿ª[]Ž¤ ™š‘ü0él3,‘¿ª[l1]Ž¡‘ü0él5,‘¿ª[]ŽŸ‰¿‘êñëÖW‘ÿVe–ê¨noš¬rw“see“that“Ól1“Öand“Ól5“Öcan“bSŽe“un˜w˜ound“to“giv˜e:ŽŽŽŒ‹$ ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Automatic‘€un winding’ ܵ5Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘$_Ól3,‘¿ª[]ŽŸ‘ÇaÖUnš¬rwinding–ê¨Ól3“Öthen“lea˜v˜es“us“with“the“required“recursiv˜e“equation“for“ÓoutÖ.Ž¤‘(ðThe–=Ùproblem“with“the“approacš¬rh“just“describSŽed“is“that“it“only“un˜winds“fully“if“there“isŽ¡‘Çaat–´Ômost“one“lošSŽop“in“the“circuit,‘ç_and“the“output“is“in“that“lo˜op.‘—eW‘ÿVe“can“b˜e“a“bit“moreŽ¡‘Çageneral.‘8àConsider–ê¨the“circuit:Ž ÿ½ÎŸ÷¦U’íÇ ÓoutŽŽŽ’êž«Ÿ»ƒs‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ³­ ’åEfl2ŽŽŽ’êž«Ÿý7‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ†'d’åEfl1ŽŽŽ’êž« ÿ`vû‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿAÞ ’ð¦õinŽŽŽ’ö3m ÿ`ª.„ÃfeŽ’öfŸ ÿ`ª.ëD?ŽŽ’ö3mŸŽ0j„ÃfeŽ’öfŸŸŽ0j?ŽŽ’ö3mŸ»¶¦„ÃfeŽ’öfŸŸ»¶¦?ŽŽ’ö3mŸé<â„ÃfeŽ’öfŸŸé<â?ŽŽ’öfŸŸ°UóFü<˜ lcircle10ëFqŽ’öfŸŸ°ˆI„fdÃŽ’ ö‹Ÿ°U„[ xfeŽŽ’È. ÿU{Ñ„fd aŽ’”ü ÿ`ª.„ afeŽ’È. ÿ`ª.ëD?ŽŽŽŽŽŽ©?Œl‘ÇaÖrepresen•¬rted›ê¨b“y˜the˜graph:ŽŸ=&‘$_Ól1,‘¿ª[l2]Ž¤ ™š‘$_l2,‘¿ª[l1]Ž¡‘$_out,[l2]Ž¦‘ÇaÖThere–‚are“no“lines“with“an“empt¬ry“depSŽendency“list,‘è†and“eliminating“Óout“Öwill“not“helpŽ¤‘ÇabšSŽecause–ö¶it“is“not“in“the“lo˜op.‘] Ho•¬rw“ev“er,‘9ºif›ö¶w“e˜break˜the˜loSŽop˜at˜Ól2˜Öw“e˜can˜un“wind˜Ól1Ö.Ž¡‘ÇaThis–šiwill“lea•¬rv“e–šius“with“a“recursiv¬re“equation“for“Ól2“Öand“an“equation“for“Óout“Öin“terms“of“Ól2Ö.Ž¡‘ÇaThis–Xois“the“bSŽest“that“wš¬re“can“do,‘sàand“it“is“no˜w“up“to“the“user“to“deal“with“the“recursiv˜eŽ¡‘Çaequation.Ž¡‘(ðNo¬rw–ê¨let's“consider“an“example“with“more“than“one“loSŽop:ŽŽŽŒ‹- ÌU ýFÓŸú™š‘êñëÛ6’ÿ‚ Chapter–€1.‘ €The“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß þÕ>ãŸ÷¦U’˜knÓoutŽŽŽ’•BùŸ»ƒs‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ³­ ’é´l5ŽŽŽ’•BùŸý7‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ†'d’é´l4ŽŽŽ’•Bù ÿ`vû‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿX¡(’é´l3ŽŽŽ’•Bù ÿ2ð¿‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž’ÂÉ5 ÿ2ð¿‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿ+ì’é´l2ŽŽŽ ÿ+ì’Ô3l6ŽŽŽ’•Bù ÿjƒ‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž’ðOq ÿjƒ‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž þý”°’é´l1ŽŽŽ þý”°’¹Jl7ŽŽŽ’•Bù þ×äG‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž þ¹KV’›KCinŽŽŽ’ ×» þØz„ÃfeŽ’¡ í þØzëD?ŽŽ’ ×» ÿ¶„ÃfeŽ’¡ í ÿ¶?ŽŽ’ ×» ÿ3#ò„ÃfeŽ’¡ í ÿ3#ò?ŽŽ’ ×» ÿ`ª.„ÃfeŽ’¡ í ÿ`ª.?ŽŽ’ ×»ŸŽ0j„ÃfeŽ’¡ ퟎ0j?ŽŽ’ ×»Ÿ»¶¦„ÃfeŽ’¡ ퟻ¶¦?ŽŽ’ ×»Ÿé<â„ÃfeŽ’¡ íŸé<â?ŽŽ’¡ ퟂÎÛëFqŽ’¡ ퟃ „fd-†<Ž’Î]÷Ÿ‚ÎÛ„8çËfeŽ’Α) ÿSçëD6ŽŽŽ’Î]÷ ÿ3#ò„ afeŽŽ’¬l| ÿ'õ•„fd"$­Ž’¬9J ÿ3#ò„ afeŽ’¬l| ÿ3#ò?ŽŽ’¡ ퟰUëFqŽ’¡ ퟰˆI„fd[ xŽ’ûä3Ÿ°U„“ôCfeŽ’üe ÿ&`ÔëD6ŽŽŽ’ûä3 ÿ¶„ afeŽŽ’¬l| þúoY„fdOªéŽ’¬9J ÿ¶„ afeŽ’¬l| ÿ¶?ŽŽŽŽŽŽŸ& È‘êñëÖW‘ÿVe–ŽÓcould“unš¬rwind“Ól1“Öbut“then“w˜e“w˜ould“get“stuc˜k.‘DIf“w˜e“break“at“Ól2“Öor“Ól7“Öw˜e“will“still“getŽ¤‘êñëstuc¬rk–ÚábšSŽecause“of“the“inner“lo˜op.‘3žIf“wš¬re“break“at“Ól5“Öw˜e“can“un˜wind“Ól7Ö,‘Þ but“then“get“stuc˜k.Ž¡‘êñëIf–Awš¬re“break“at“Ól6“Öw˜e“get“stuc˜k“bšSŽecause“of“the“outer“lo˜op.‘<Ho•¬rw“ev“er,‘V­if›Aw“e˜break˜at˜Ól3˜ÖorŽ¡‘êñëÓl4–¬ìÖbšSŽoth“lo˜ops“are“brokš¬ren“and“w˜e“can“un˜wind“fully“to“lea˜v˜e“a“recursiv˜e“equation“for“eitherŽ¡‘êñëÓl3–ĸÖor“Ól4“Öand“an“equation“for“Óout“Öin“terms“of“that“line.‘,;So,‘ÌNthe“c¬rhoice“of“where“to“break“aŽ¡‘êñëloSŽop–ê¨maš¬ry“determine“ho˜w“far“the“un˜winding“can“go.Ž©`‘öSzÓUNWIND_AUTO_CONVŽ‘UÀwÖattempts–r]to“break“evš¬rery“loSŽop“in“the“circuit“using“the“minim˜um“n˜um-Ž¡‘êñëbšSŽer–øjof“breaks,‘ûÚso“that“there“are“as“few“equations“left“as“p˜ossible.‘b&The“function“also“giv¬resŽ¡‘êñëprioritš¬ry–'to“non-in˜ternal“lines“when“determining“where“to“break,‘E†so“that“if“pSŽossible“theŽ¡‘êñërecursiv¬re–ê¨equations“are“in“terms“of“these“lines.Ž¦‘öSzThe–wœalgorithm“used“determines“from“the“term“a“list“of“line“v›ÿXäariables.‘‡Eac¬rh“line“v˜ariableŽ¡‘êñëhas–a“righš¬rt-hand“side“of“an“equation“assoSŽciated“with“it.‘«õThe“free“v‘ÿXäariables“in“eac˜h“righ˜t-Ž¡‘êñëhand–ðside“are“computed“and“those“that“are“also“line“v‘ÿXäariables“are“placed“in“the“depSŽendencyŽ¡‘êñëlist–…mfor“the“correspšSŽonding“line.‘"F‘ÿVrom“the“dep˜endency“structure,‘™¬the“lo˜ops“are“determined.Ž¡‘êñëLines–ê¨are“then“eliminated“so“that“all“loSŽops“are“brok¬ren.Ž¦‘öSzA‘d5study–dXof“the“folloš¬rwing“circuit“rev˜eals“wh˜y“ó.›»ˆ@ cmti12Ùal‘™™l‘¢ëÖloSŽops“ha˜v˜e“to“bSŽe“brok˜en.‘ If“not“all“loSŽopsŽ¡‘êñëare–ê¨brokš¬ren,“then“a“remaining“loSŽop“can“mak˜e“the“breaking“of“other“loSŽops“fruitless.ŽŽŽŒ‹3ã ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ Automatic‘€un winding’"\µ7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß þÕ>ãŸ÷¦U’À@äÓoutŽŽŽ’½oŸ»ƒs‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ³­ ’·¿*l5ŽŽŽ’½oŸý7‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ†'d’·¿*l4ŽŽŽ’½o ÿ`vû‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž’$ç ÿ`vû‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿX¡(’·¿*l3ŽŽŽ ÿX¡(’)ŽÀl7ŽŽŽ’½o ÿ2ð¿‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž’êž« ÿ2ð¿‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿ+ì’·¿*l2ŽŽŽ ÿ+ì’ü„l6ŽŽŽ’½o ÿjƒ‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž þý”°’·¿*l1ŽŽŽ’½o þ×äG‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž þ¹KV’à ¹inŽŽŽ’È­1 þØz„ÃfeŽ’Èàc þØzëD?ŽŽ’È­1 ÿ¶„ÃfeŽ’Èàc ÿ¶?ŽŽ’È­1 ÿ3#ò„ÃfeŽ’Èàc ÿ3#ò?ŽŽ’È­1 ÿ`ª.„ÃfeŽ’Èàc ÿ`ª.?ŽŽ’È­1ŸŽ0j„ÃfeŽ’ÈàcŸŽ0j?ŽŽ’È­1Ÿ»¶¦„ÃfeŽ’ÈàcŸ»¶¦?ŽŽ’È­1Ÿé<â„ÃfeŽ’ÈàcŸé<â?ŽŽ’ÈàcŸ‚ÎÛëFqŽ’ÈàcŸƒ „fd-†<Ž’ö3mŸ‚ÎÛ„8çËfeŽ’öfŸ ÿSçëD6ŽŽŽ’ö3m ÿ3#ò„ afeŽŽ’ÔAò ÿ'õ•„fd"$­Ž’ÔÀ ÿ3#ò„ afeŽ’ÔAò ÿ3#ò?ŽŽ’ÈàcŸ°UëFqŽ’ÈàcŸ°ˆI„fd[ xŽ’#¹©Ÿ°U„8çËfeŽ’#ìÛŸmLëD6ŽŽŽ’#¹© ÿ`ª.„ afeŽŽ’ÔAò ÿU{Ñ„fdOªéŽ’ÔÀ ÿ`ª.„ afeŽ’ÔAò ÿ`ª.?ŽŽŽŽŽŽ©Sb‘ÇaÖThe–ê¨depSŽendency“structure“for“the“circuit“is:ŽŸìü‘$_Ól1,‘¿ª[]Ž¤ ™š‘$_l2,‘¿ª[l1]Ž¡‘$_l3,‘¿ª[l2;l6]Ž¡‘$_l4,‘¿ª[l3;l7]Ž¡‘$_l5,‘¿ª[l4]Ž¡‘$_l6,‘¿ª[l4]Ž¡‘$_l7,‘¿ª[l5]Ž¡‘$_out,[l5]Ž¦‘ÇaÖThe–ê¨loSŽops“for“the“circuit“are:ŽŸìü‘$_Ó[l3;l4;l6]Ž¡‘$_[l4;l5;l7]Ž¦‘ÇaÖBoth–ê¨lošSŽops“can“b˜e“brokš¬ren“b˜y“eliminating“Ól4Ö:ŽŸìü‘$_Ól1,‘¿ª[]Ž¡‘$_l2,‘¿ª[l1]Ž¡‘$_l3,‘¿ª[l2;l6]ŽŽŽŒ‹@§ ÌU ýFÓŸú™š‘êñëÛ8’ÿ‚ Chapter–€1.‘ €The“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ü0éÓl5,‘¿ª[]Ž¤ ™š‘ü0él6,‘¿ª[]Ž¡‘ü0él7,‘¿ª[l5]Ž¡‘ü0éout,[l5]Ž© Q‘êñëÖW‘ÿVe–ê¨can“noš¬rw“un˜wind“Ól1Ö,“Ól5“Öand“Ól6Ö:ŽŸ¤ë‘ü0éÓl2,‘¿ª[]Ž¡‘ü0él3,‘¿ª[l2]Ž¡‘ü0él7,‘¿ª[]Ž¡‘ü0éout,[]Ž¦‘êñëÖand–zthen“un¬rwind“Ól2Ö,›ÝßÓl7“Öand“ÓoutÖ,˜follo•¬rw“ed›zb“y˜un“winding˜with˜Ól3˜Öto˜yield˜a˜recursiv“eŽ¤‘êñëequation–¥Ëfor“Ól4“Öand“all“other“equations“in“terms“of“Ól4Ö.‘!ìAll“the“in¬rternal“lines“except“for“Ól4Ž¡‘êñëÖcan–ê¨bSŽe“pruned.‘8àThis“lea•¬rv“es–ê¨equations“for“Ól4“Öand“Óout“Öonly‘ÿV.Ž¡‘öSzThe–œ2tecš¬rhnique“doSŽes“not“alw˜a˜ys“yield“a“single“recursiv˜e“equation.‘M~Mutual“recursion“isŽ¡‘êñëalso–ê¨pSŽossible.‘8àThis“is“illustrated“bš¬ry“the“follo˜wing“example:Ž dÏgŸ÷¦U’£ÌýÓoutŽŽŽ’ ¤ˆŸ»ƒs‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ³­ ’›KCl5ŽŽŽ’ ¤ˆŸý7‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎ŽŸ†'d’›KCl4ŽŽŽ’ ¤ˆ ÿ`vû‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž’Î*Ä ÿw:‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿX¡(’›KCl3ŽŽŽ ÿodF’ß”l7ŽŽŽ’ ¤ˆ ÿ2ð¿‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž ÿ+ì’›KCl2ŽŽŽ’ ¤ˆ ÿjƒ‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž’Î*Ä ÿ-¡‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž þý”°’›KCl1ŽŽŽ ÿWÎ’ß”l6ŽŽŽ’ ¤ˆ þ×äG‰feèŸÃ„ÃfeŸôžqŽ‘ÄÃfeŽžfe‰fe莎Ž þ¹KV’¦¬ÒinŽŽŽ’¬9J þØz„ÃfeŽ’¬l| þØzëD?ŽŽ’¬9J ÿ¶„ÃfeŽ’¬l| ÿ¶?ŽŽ’¬9J ÿ3#ò„ÃfeŽ’¬l| ÿ3#ò?ŽŽ’¬9J ÿ`ª.„ÃfeŽ’¬l| ÿ`ª.?ŽŽ’¬9JŸŽ0j„ÃfeŽ’¬l|ŸŽ0j?ŽŽ’¬9JŸ»¶¦„ÃfeŽ’¬l|Ÿ»¶¦?ŽŽ’¬9JŸé<â„ÃfeŽ’¬l|Ÿé<â?ŽŽ’¬l| ÿUHŸëFqŽ’¬l| ÿU{Ñ„fd-†<Ž’Ù¿† ÿUHŸ„"$­feŽ’Ùò¸ ÿ=#òëD6ŽŽŽ’Ù¿† ÿ`Ô„ÃfeŽŽ’·Î  ÿÐè„fd"$­‘ÝÛSžÌÎŽŽ’¬l|Ÿ°UëFqŽ’¬l|Ÿ°ˆI„fd-†<Ž’Ù¿†Ÿ°U„"$­feŽ’Ùò¸Ÿ˜0jëD6ŽŽŽ’Ù¿† ÿwmL„ÃfeŽŽ’·Î  ÿ`Ý`„fd"$­‘ÝÛSžÌÎŽŽ’Ùò¸Ÿ°UëFqŽ’Ùò¸Ÿ°ˆI„fd-†<Ž’EŸ°U„¶ðfeŽŽ’·Î  þúoY„fdOªéŽ’·šÙ ÿ¶„ afeŽ’·Î  ÿ¶ëD?ŽŽŽŽŽŽ¦‘öSzÖThere–CHare“three“lošSŽops,‘dÂbut“breaking“at“Ól2“Öand“Ól4“Öis“sucien¬rt“to“break“all“the“lo˜ops.‘TheŽ¡‘êñëresult– His“three“equations:‘z an“equation“for“Ól2“Öin“terms“of“itself“and“Ól4Ö,‘pan“equation“for“Ól4ŽŽŽŒ‹ Gà ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Automatic‘€un winding’ ܵ9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖin–pterms“of“itself“and“Ól2Ö,›band“an“equation“for“Óout“Öin“terms“of“Ól4Ö.‘°8So,˜it“can“bSŽe“seen“thatŽ¤‘Çathe–ŒloSŽop“analysis“tecš¬rhnique“used“b˜y“ÓUNWIND_AUTO_CONVŽ‘cÈÖdošSŽes“not“eliminate“lo˜ops;‘«šit“simplyŽ¡‘Ça`shrinks'‘ê¨them.ŽŽŽŒ‹ Qf ÌU ýFÓŸú™š‘êñëÛ10’ø Chapter–€1.‘ €The“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹ Rû ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|Ÿ!£úëHML– ‰‹F‘ýunctions“in“the“un‘ÿ4‰windŽŸLibraryŽŸÖx‰Ç>|Ÿ<²2ÖThis–úcš¬rhapter“pro˜vides“doSŽcumen˜tation“on“all“the“ÍML“Öfunctions“that“are“made“a˜v‘ÿXäailable“inŽ¤ÍHOL–O}Öwhen“the“ÓunwindŽ‘+öÖlibrary“is“loaded.‘g^This“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“online“viaŽ¡the‘ê¨ÓhelpŽ‘ÓøÖfacilit¬ry‘ÿV.ŽŸEZkŸ¹IŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍóIßêþÓ|-–¿ª(!x1“...“xm.“t1)“/\“...“/\“(!x1“...“xm.“tn)“=ŽŸ ™š‘"}ü!x1–¿ª...“xm.“t1“/\“...“/\“tnŽŸ#›Öwhere–¸othe“original“term“can“bSŽe“an“arbitrary“tree“of“conjunctions.‘¢6The“structure“of“theŽ¡tree–ê¨is“retained“in“bSŽoth“sides“of“the“equation.ŽŸ%syâF‘þž¸ailureŽ¦ÖNev¬rer‘ê¨fails.ŽŽŸ$ý’烈Û11ŽŽŒ‹ S‰ ÌU ýFÓŸú™š‘êñëÛ12’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ +¨‘êñëÓ#CONJ_FORALL_CONV–¿ª"((!(x:*)“(y:*)“(z:*).“a)“/\“(!(x:*)“(y:*)“(z:*).“b))“/\Ž¤ ™š‘êñë#‘gyô(!(x:*)–¿ª(y:*)“(z:*).“c)";;Ž¡‘êñë|-–¿ª((!x“y“z.“a)“/\“(!x“y“z.“b))“/\“(!x“y“z.“c)“=“(!x“y“z.“(a“/\“b)“/\“c)Ž©34‘êñë#CONJ_FORALL_CONV‘¿ª"T";;Ž¡‘êñë|-–¿ªT“=“TŽ¦‘êñë#CONJ_FORALL_CONV–¿ª"((!(x:*)“(y:*)“(z:*).“a)“/\“(!(x:*)“(w:*)“(z:*).“b))“/\Ž¡‘êñë#‘gyô(!(x:*)–¿ª(y:*)“(z:*).“c)";;Ž¡‘êñë|-–¿ª((!x“y“z.“a)“/\“(!x“w“z.“b))“/\“(!x“y“z.“c)“=Ž¡‘ü0é(!x.–¿ª((!y“z.“a)“/\“(!w“z.“b))“/\“(!y“z.“c))ŽŸ/ây‘êñëâSee‘…alsoŽŸê‘êñëÓFORALL_CONJ_CONV,–¿ªCONJ_FORALL_ONCE_CONV,“FORALL_CONJ_ONCE_CONV,Ž¡‘êñëCONJ_FORALL_RIGHT_RULE,‘¿ªFORALL_CONJ_RIGHT_RULE.ŽŸ8ÄñŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëICONJ_FORALL_ONCE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ8:‘êñëÓCONJ_FORALL_ONCE_CONV–¿ª:“convŽ¤!A¦‘êñëâSynopsisŽ©Pi‘êñëÖMo•¬rv“es–ê¨a“single“univš¬rersal“quan˜ti er“up“through“a“tree“of“conjunctions.Ž¡‘êñëâDescriptionŽ¦‘êñëÓCONJ_FORALL_ONCE_CONV–¿ª"(!x.“t1)“/\“...“/\“(!x.“tn)"–ê¨Öreturns“the“theorem:ŽŸÛ?‘ü0éÓ|-–¿ª(!x.“t1)“/\“...“/\“(!x.“tn)“=“!x.“t1“/\“...“/\“tnŽŸñ<‘êñëÖwhere–¸othe“original“term“can“bSŽe“an“arbitrary“tree“of“conjunctions.‘¢6The“structure“of“theŽŸ‘êñëtree–ê¨is“retained“in“bSŽoth“sides“of“the“equation.Ž¡‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–ÐØif“the“argumen¬rt“term“is“not“of“the“required“form.‘ÚðThe“term“need“not“bSŽe“a“conjunction,ŽŸ‘êñëbut–ê¨if“it“is“evš¬rery“conjunct“m˜ust“bSŽe“univ˜ersally“quan˜ti ed“with“the“same“v‘ÿXäariable.ŽŽŽŒ‹ X ÌU ýFÓŸú™š‘ÇaÒCONJ‘Ái‰ffÇŽ–ˆ„Fš¦tORALL‘Ái‰ffÇŽ“RIGHT‘Ái‰ffÇŽ“R˜ULE’·pÛ13Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸÎ ‘ÇaÓ#CONJ_FORALL_ONCE_CONV–¿ª"((!x.“x“\/“a)“/\“(!x.“x“\/“b))“/\“(!x.“x“\/“c)";;Ž¤ ™š‘Ça|-–¿ª((!x.“x“\/“a)“/\“(!x.“x“\/“b))“/\“(!x.“x“\/“c)“=Ž¡‘$_(!x.–¿ª((x“\/“a)“/\“(x“\/“b))“/\“(x“\/“c))Ž©34‘Ça#CONJ_FORALL_ONCE_CONV–¿ª"!x.“x“\/“a";;Ž¡‘Ça|-–¿ª(!x.“x“\/“a)“=“(!x.“x“\/“a)Ž¦‘Ça#CONJ_FORALL_ONCE_CONV–¿ª"((!x.“x“\/“a)“/\“(!y.“y“\/“b))“/\“(!x.“x“\/“c)";;Ž¡‘Çaevaluation‘¿ªfailed‘¾RCONJ_FORALL_ONCE_CONVŽ©- º‘ÇaâSee‘…alsoŽŸpä‘ÇaÓFORALL_CONJ_ONCE_CONV,–¿ªCONJ_FORALL_CONV,“FORALL_CONJ_CONV,Ž¡‘ÇaCONJ_FORALL_RIGHT_RULE,‘¿ªFORALL_CONJ_RIGHT_RULE.ŽŸ3uŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëICONJ_FORALL_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ66ö‘ÇaÓCONJ_FORALL_RIGHT_RULE–¿ª:“(thm“->“thm)Ž¤]'‘ÇaâSynopsisŽŸ×J‘ÇaÖMo•¬rv“es›ê¨univ“ersal˜quan“ti ers˜up˜through˜a˜tree˜of˜conjunctions.Ž¡‘ÇaâDescriptionŽŸÎ ‘)Æ ÓA–¿ª|-“!z1“...“zr.Ž¤ ™š‘LDt–¿ª=“?y1“...“yp.“(!x1“...“xm.“t1)“/\“...“/\“(!x1“...“xm.“tn)Ž¡‘$_-------------------------------------------------------------------Ž¡‘5E]A–¿ª|-“!z1“...“zr.“t“=“?y1“...“yp.“!x1“...“xm.“t1“/\“...“/\“tnŽ¦‘ÇaâF‘þž¸ailureŽŸ×J‘ÇaÖF‘ÿVails–ÉSif“the“argumen¬rt“theorem“is“not“of“the“required“form,‘Ïþthough“either“or“bSŽoth“of“Ór“ÖandŽŸ‘ÇaÓp–ê¨Öma¬ry“bSŽe“zero.ŽŸ]'‘ÇaâSee‘…alsoŽŸpä‘ÇaÓFORALL_CONJ_RIGHT_RULE,–¿ªCONJ_FORALL_CONV,“FORALL_CONJ_CONV,Ž¡‘ÇaCONJ_FORALL_ONCE_CONV,‘¿ªFORALL_CONJ_ONCE_CONV.ŽŽŽŒ‹^  ÌU ýFÓŸú™š‘êñëÛ14’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIDEPTH_EXISTS_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ*䌑êñëÓDEPTH_EXISTS_CONV–¿ª:“(conv“->“conv)Ž¤HM‘êñëâSynopsisŽ©‘êñëÖApplies–ê¨a“con•¬rv“ersion–ê¨to“the“b•SŽo“dy–ê¨of“nested“existenš¬rtial“quan˜ti cations.Ž¡‘êñëâDescriptionŽ¦‘êñëÓDEPTH_EXISTS_CONV–¿ªconv“"?x1“...“xn.“body"–˜|Öapplies“Óconv“Öto“Ó"body"“Öand“returns“a“theo-Ž¦‘êñërem–ê¨of“the“form:ŽŸ=À‘ü0éÓ|-–¿ª(?x1“...“xn.“body)“=“(?x1“...“xn.“body')ŽŸ#ìs‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–ê¨if“the“application“of“Óconv“Öfails.Ž¡‘êñëâExampleŽŸ=À‘êñëÓ#DEPTH_EXISTS_CONV–¿ªBETA_CONV“"?x“y“z.“(\w.“x“/\“y“/\“z“/\“w)“T";;Ž¤ ™š‘êñë|-–¿ª(?x“y“z.“(\w.“x“/\“y“/\“z“/\“w)T)“=“(?x“y“z.“x“/\“y“/\“z“/\“T)ŽŸ#ìs‘êñëâSee‘…alsoŽ¡‘êñëÓDEPTH_FORALL_CONV.ŽŸ Ø矹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIDEPTH_FORALL_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ*䌑êñëÓDEPTH_FORALL_CONV–¿ª:“(conv“->“conv)Ž¤HM‘êñëâSynopsisŽ¦‘êñëÖApplies–ê¨a“con•¬rv“ersion–ê¨to“the“b•SŽo“dy–ê¨of“nested“univš¬rersal“quan˜ti cations.Ž¡‘êñëâDescriptionŽ¦‘êñëÓDEPTH_FORALL_CONV–¿ªconv“"!x1“...“xn.“body"–˜|Öapplies“Óconv“Öto“Ó"body"“Öand“returns“a“theo-Ž¦‘êñërem–ê¨of“the“form:ŽŸ=À‘ü0éÓ|-–¿ª(!x1“...“xn.“body)“=“(!x1“...“xn.“body')ŽŸ#ìs‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–ê¨if“the“application“of“Óconv“Öfails.ŽŽŽŒ‹e ÌU ýFÓŸú™š‘ÇaÒEXISTS‘Ái‰ffÇŽ–ˆ„DEL1‘Ái‰ffÇŽ“CONV’= •Û15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ‘‘ÇaÓ#DEPTH_FORALL_CONV–¿ªBETA_CONV“"!x“y“z.“(\w.“x“/\“y“/\“z“/\“w)“T";;ŽŸ ™š‘Ça|-–¿ª(!x“y“z.“(\w.“x“/\“y“/\“z“/\“w)T)“=“(!x“y“z.“x“/\“y“/\“z“/\“T)ŽŸ*뎑ÇaâSee‘…alsoŽŸ2‘ÇaÓDEPTH_EXISTS_CONV.ŽŸ.ן¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXISTS_DEL1_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ2Ò‘ÇaÓEXISTS_DEL1_CONV–¿ª:“convŽ¤ò_‘ÇaâSynopsisŽ©|˜‘ÇaÖDeletes–ê¨one“existenš¬rtial“quan˜ti er.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓEXISTS_DEL1_CONV–¿ª"?x.“t"–ê¨Öreturns“the“theorem:ŽŸ‹ù‘$_Ó|-–¿ª(?x.“t)“=“tŽŸuÇ‘ÇaÖpro¬rvided–ê¨Óx“Öis“not“free“in“ÓtÖ.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–ê¨if“the“argumenš¬rt“term“is“not“an“existen˜tial“quan˜ti cation“or“if“Óx“Öis“free“in“ÓtÖ.Ž¡‘ÇaâSee‘…alsoŽŸ2‘ÇaÓEXISTS_DEL_CONV,‘¿ªPRUNE_ONCE_CONV.ŽŸ.ן¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXISTS_DEL_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ2Ò‘ÇaÓEXISTS_DEL_CONV–¿ª:“convŽ¡‘ÇaâSynopsisŽ¦‘ÇaÖDeletes–ê¨existenš¬rtial“quan˜ti ers.ŽŽŽŒ‹jç ÌU ýFÓŸú™š‘êñëÛ16’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâDescriptionŽ¤‘êñëÓEXISTS_DEL_CONV–¿ª"?x1“...“xn.“t"–ê¨Öreturns“the“theorem:Ž©I[‘ü0éÓ|-–¿ª(?x1“...“xn.“t)“=“tŽŸ¯Á‘êñëÖpro¬rvided–ê¨Óx1,...,xn“Öare“not“free“in“ÓtÖ.ŽŸ_ƒ‘êñëâF‘þž¸ailureŽ¡‘êñëÖF‘ÿVails–õ•if“an¬ry“of“the“ÓxÖ's“appšSŽear“free“in“ÓtÖ.‘Y¨The“function“do˜es“not“p˜erform“a“partial“deletion;Ž¡‘êñëfor–ñexample,‘¢âif“Óx1“Öand“Óx2“Ödo“not“appšSŽear“free“in“Ót“Öbut“Óx3“Ödo˜es,‘¢âthe“function“will“fail;‘®Øit“willŽ¡‘êñënot‘ê¨return:Ž¦‘ü0éÓ|-–¿ª?x1“...“xn.“t“=“?x3“...“xn.“tŽŸ$D‘êñëâSee‘…alsoŽŸ ™š‘êñëÓEXISTS_DEL1_CONV,‘¿ªPRUNE_CONV.ŽŸ!ˆŸ-p‘êñëŸé8ö‰ffÇBXŸÇ ÌÍŸÇ „'ŽffŸñ•‘ÌÍëIEXISTS_EQN_CONVŽŽ’ÆÛò„'ŽffŽŽŸ-o‰ffÇBXŽŽŽŸ*…‘êñëÓEXISTS_EQN_CONV–¿ª:“convŽ©_ƒ‘êñëâSynopsisŽ¡‘êñëÖPro•¬rv“es–ê¨the“existence“of“a“line“that“has“a“non-recursiv¬re“equation.Ž¦‘êñëâDescriptionŽ¡‘êñëÓEXISTS_EQN_CONV–¿ª"?l.“!y1“...“ym.“l“x1“...“xn“=“t"–ê¨Öreturns“the“theorem:ŽŸI[‘ü0éÓ|-–¿ª(?l.“!y1“...“ym.“l“x1“...“xn“=“t)“=“TŽŸ¯Á‘êñëÖproš¬rvided–ê¨Ól“Öis“not“free“in“ÓtÖ.‘8àBoth“Óm“Öand“Ón“Öma˜y“bSŽe“zero.Ž¦‘êñëâF‘þž¸ailureŽ¡‘êñëÖF‘ÿVails–ê¨if“the“argumen¬rt“term“is“not“of“the“spšSŽeci ed“form“or“if“Ól“Öapp˜ears“free“in“ÓtÖ.Ž¦‘êñëâSee‘…alsoŽŸ ™š‘êñëÓPRUNE_ONCE_CONV.ŽŸ!ˆŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXPAND_ALL_BUT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ+÷‘êñëÓEXPAND_ALL_BUT_CONV–¿ª:“(string“list“->“thm“list“->“conv)ŽŽŽŒ‹op ÌU ýFÓŸú™š‘ÇaÒEXP‘þó\AND‘Ái‰ffÇŽ–ˆ„ALL‘Ái‰ffÇŽ“BUT‘Ái‰ffÇŽ“CONV’ÁÞÛ17Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâSynopsisŽ¤t2‘ÇaÖUnfolds,‘ðûthen–ï·unš¬rwinds“all“lines“(except“those“spSŽeci ed)“as“m˜uc˜h“as“pSŽossible,‘ðûthen“prunesŽŸ‘Çathe›ê¨un•¬rw“ound˜lines.ŽŸÐÊ‘ÇaâDescriptionŽ¡‘ÇaÓEXPAND_ALL_BUT_CONV–¿ª[`li(k+1)`;...;`lim`]“thl–ê¨Öwhen“applied“to“the“follo¬rwing“term:Ž¤jc‘$_Ó"?l1–¿ª...“lm.“t1“/\“...“/\“ui1“/\“...“/\“uik“/\“...“/\“tn"Ž©\—‘ÇaÖreturns–ê¨a“theorem“of“the“form:Ž¡‘$_ÓB–¿ª|-“(?l1“...“lm.“t1“/\“...“/\“ui1“/\“...“/\“uik“/\“...“/\“tn)“=ŽŸ ™š‘@ı(?li(k+1)–¿ª...“lim.“t1'“/\“...“/\“tn')Ž¦‘ÇaÖwhere–¡€eac¬rh“Óti'“Öis“the“result“of“rewriting“Óti“Öwith“the“theorems“in“ÓthlÖ.‘ }The“set“of“assump-Ž¤‘Çations––¿ÓB‘–©Öis“the“union“of“the“instan¬rtiated“assumptions“of“the“theorems“used“for“rewriting.‘èIfŽ¡‘Çanone–of“the“rewrites“are“applicable“to“a“conjunct,‘*öit“is“unc¬rhanged.‘Ó4Those“conjuncts“thatŽ¡‘Çaafter–eÅrewriting“are“equations“for“the“lines“Óli1,...,lik“Ö(they“are“denoted“b¬ry“Óui1,...,uikÖ)Ž¡‘Çaare–ê¨used“to“un¬rwind“and“the“lines“Óli1,...,lik“Öare“then“pruned.Ž¤t2‘(ðThe–ê¨ÓliÖ's“are“related“b¬ry“the“equation:ŽŸjc‘$_Ó{li1,...,lik}–¿ªu“{li(k+1),...,lim}“=“{l1,...,lm}Ž©*¹/‘ÇaâF‘þž¸ailureŽ¡‘ÇaÖThe–»€function“maš¬ry“fail“if“the“argumen˜t“term“is“not“of“the“spSŽeci ed“form.‘)(It“will“also“fail“ifŽ¤‘Çathe›moun•¬rw“ound˜lines˜cannot˜b•SŽe˜pruned.‘"It˜is˜p“ossible˜for˜the˜function˜to˜attempt˜un¬rwindingŽ¡‘Çainde nitely–ê¨(to“loSŽop).ŽŸÐÊ‘ÇaâExampleŽŸÞ•‘ÇaÓ#EXPAND_ALL_BUT_CONV‘¿ª[`l1`]Ž¤ ™š‘Ça#–¿ª[ASSUME“"!in“out.“INV“(in,out)“=“!(t:num).“out“t“=“~(in“t)"]Ž¡‘Ça#–¿ª"?l1“l2.Ž¡‘Ça#‘>þINV–¿ª(l1,l2)“/\“INV“(l2,out)“/\“(!(t:num).“l1“t“=“l2“(t-1)“\/“out“(t-1))";;Ž¡‘Ça.–¿ª|-“(?l1“l2.Ž¡‘;INV(l1,l2)–¿ª/\“INV(l2,out)“/\“(!t.“l1“t“=“l2(t“-“1)“\/“out(t“-“1)))“=Ž¡‘/…³(?l1.Ž¡‘;(!t.–¿ªout“t“=“~~l1“t)“/\“(!t.“l1“t“=“~l1(t“-“1)“\/“~~l1(t“-“1)))Ž¦‘ÇaâSee‘…alsoŽŸ Ì‘ÇaÓEXPAND_AUTO_CONV,–¿ªEXPAND_ALL_BUT_RIGHT_RULE,“EXPAND_AUTO_RIGHT_RULE,Ž¡‘ÇaUNFOLD_CONV,–¿ªUNWIND_ALL_BUT_CONV,“PRUNE_SOME_CONV.ŽŽŽŒ‹u­ ÌU ýFÓŸú™š‘êñëÛ18’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXPAND_ALL_BUT_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸP><‘êñëÓEXPAND_ALL_BUT_RIGHT_RULE–¿ª:“(string“list“->“thm“list“->“thm“->“thm)Ž¤.<½‘êñëâSynopsisŽ©/‘êñëÖUnfolds,‘ðûthen–ï·unš¬rwinds“all“lines“(except“those“spSŽeci ed)“as“m˜uc˜h“as“pSŽossible,‘ðûthen“prunesŽŸ‘êñëthe›ê¨un•¬rw“ound˜lines.Ž¡‘êñëâDescriptionŽ¦‘êñëÓEXPAND_ALL_BUT_RIGHT_RULE–¿ª[`li(k+1)`;...;`lim`]“thl›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:ŽŸ+ÖW‘ð“ÓA–¿ª|-“!z1“...“zr.Ž¤ ™š‘$nt–¿ª=“?l1“...“lm.“t1“/\“...“/\“ui1“/\“...“/\“uik“/\“...“/\“tnŽ¡‘ü0é-------------------------------------------------------------------Ž¡‘/‘B–¿ªu“A“|-“!z1“...“zr.“t“=“?li(k+1)“...“lim.“t1'“/\“...“/\“tn'ŽŸ)­‘êñëÖwhere–¡€eac¬rh“Óti'“Öis“the“result“of“rewriting“Óti“Öwith“the“theorems“in“ÓthlÖ.‘ }The“set“of“assump-Ž¤‘êñëtions––¿ÓB‘–©Öis“the“union“of“the“instan¬rtiated“assumptions“of“the“theorems“used“for“rewriting.‘èIfŽ¡‘êñënone–of“the“rewrites“are“applicable“to“a“conjunct,‘*öit“is“unc¬rhanged.‘Ó4Those“conjuncts“thatŽ¡‘êñëafter–eÅrewriting“are“equations“for“the“lines“Óli1,...,lik“Ö(they“are“denoted“b¬ry“Óui1,...,uikÖ)Ž¡‘êñëare–ê¨used“to“un¬rwind“and“the“lines“Óli1,...,lik“Öare“then“pruned.Ž¦‘öSzThe–ê¨ÓliÖ's“are“related“b¬ry“the“equation:ŽŸ+ÖW‘ü0éÓ{li1,...,lik}–¿ªu“{li(k+1),...,lim}“=“{l1,...,lm}ŽŸC[‘êñëâF‘þž¸ailureŽ¦‘êñëÖThe–vífunction“maš¬ry“fail“if“the“argumen˜t“theorem“is“not“of“the“spSŽeci ed“form.‘Ý®It“will“alsoŽ¡‘êñëfail–if“the“un•¬rw“ound–lines“cannot“bšSŽe“pruned.‘¼”It“is“p˜ossible“for“the“function“to“attemptŽ¡‘êñëun¬rwinding–ê¨inde nitely“(to“loSŽop).ŽŽŽŒ‹~Y ÌU ýFÓŸú™š‘ÇaÒEXP‘þó\AND‘Ái‰ffÇŽ–ˆ„A¦tUTO‘Ái‰ffÇŽ“CONV’/I0Û19Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ`þ‘ÇaÓ#EXPAND_ALL_BUT_RIGHT_RULE‘¿ª[`l1`]Ž¤ ™š‘Ça#–¿ª[ASSUME“"!in“out.“INV“(in,out)“=“!(t:num).“out“t“=“~(in“t)"]Ž¡‘Ça#‘¿ª(ASSUMEŽ¡‘Ça#‘>þ"!(in:num->bool)‘¿ªout.Ž¡‘Ça#‘¾RDEV(in,out)‘¿ª=Ž¡‘Ça#‘"}ü?l1‘¿ªl2.Ž¡‘Ça#‘(=¦INV–¿ª(l1,l2)“/\“INV“(l2,out)“/\“(!(t:num).“l1“t“=“in“t“\/“out“(t-1))");;Ž¡‘Ça..–¿ª|-“!in“out.Ž¡‘;DEV(in,out)‘¿ª=Ž¡‘;(?l1.–¿ª(!t.“out“t“=“~~l1“t)“/\“(!t.“l1“t“=“in“t“\/“~~l1(t“-“1)))ŽŸ'V-‘ÇaâSee‘…alsoŽ¡‘ÇaÓEXPAND_AUTO_RIGHT_RULE,–¿ªEXPAND_ALL_BUT_CONV,“EXPAND_AUTO_CONV,Ž¡‘ÇaUNFOLD_RIGHT_RULE,–¿ªUNWIND_ALL_BUT_RIGHT_RULE,“PRUNE_SOME_RIGHT_RULE.ŽŸ'¬ZŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXPAND_AUTO_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ/qƒ‘ÇaÓEXPAND_AUTO_CONV–¿ª:“(thm“list“->“conv)Ž¤ŽÉ‘ÇaâSynopsisŽ©‘ÇaÖUnfolds,–ê¨then“unš¬rwinds“as“m˜uc˜h“as“pSŽossible,“then“prunes“the“un˜w˜ound“lines.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓEXPAND_AUTO_CONV‘¿ªthl–ê¨Öwhen“applied“to“the“follo¬rwing“term:Ž¤`þ‘$_Ó"?l1–¿ª...“lm.“t1“/\“...“/\“ui1“/\“...“/\“uik“/\“...“/\“tn"Ž©Çd‘ÇaÖreturns–ê¨a“theorem“of“the“form:Ž¡‘$_ÓB–¿ª|-“(?l1“...“lm.“t1“/\“...“/\“ui1“/\“...“/\“uik“/\“...“/\“tn)“=ŽŸ ™š‘@ı(?li(k+1)–¿ª...“lim.“t1'“/\“...“/\“tn')Ž¦‘ÇaÖwhere–¡€eac¬rh“Óti'“Öis“the“result“of“rewriting“Óti“Öwith“the“theorems“in“ÓthlÖ.‘ }The“set“of“assump-Ž¤‘Çations–ƒgÓB‘ƒ@Öis“the“union“of“the“instan¬rtiated“assumptions“of“the“theorems“used“for“rewriting.Ž¡‘ÇaIf–ç>none“of“the“rewrites“are“applicable“to“a“conjunct,›çìit“is“unc¬rhanged.‘7½After“rewriting,˜theŽ¡‘Çafunction–Þ”decides“whicš¬rh“of“the“resulting“terms“to“use“for“un˜winding,‘àþb˜y“pšSŽerforming“a“lo˜opŽ¡‘Çaanalysis–ê¨on“the“graph“represen¬rting“the“depSŽendencies“of“the“lines.Ž¡‘(ðSuppSŽose–àvthe“function“decides“to“un¬rwind“Óli1,...,lik“Öusing“the“terms“Óui1',...,uik'Ž¡‘ÇaÖrespSŽectiv•¬rely‘ÿV.‘ 0ÃThen,›‘ñafter‘=Iun“winding,˜the–=Ilines“Óli1,...,lik“Öare“pruned“(pro¬rvided“theyŽŽŽŒ‹…t ÌU ýFÓŸú™š‘êñëÛ20’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖha•¬rv“e–#qbSŽeen“eliminated“from“the“righ¬rt-hand“sides“of“the“conjuncts“that“are“equations,‘1£andŽ¤‘êñëfrom–ê¨the“whole“of“an¬ry“other“conjuncts)“resulting“in“the“elimination“of“Óui1',...,uik'Ö.Ž¡‘öSzThe–ê¨ÓliÖ's“are“related“b¬ry“the“equation:ŽŸßÛ‘ü0éÓ{li1,...,lik}–¿ªu“{li(k+1),...,lim}“=“{l1,...,lm}ŽŸFA‘êñëÖThe–·lošSŽop“analysis“allo¬rws“the“term“to“b˜e“un•¬rw“ound–·as“m•¬ruc“h–·as“p˜ossible“without“the“risk“ofŽ¡‘êñëloSŽoping.‘8àThe–ê¨user“is“left“to“deal“with“the“recursiv¬re“equations.Ž©Œ‚‘êñëâF‘þž¸ailureŽ¡‘êñëÖThe–¬;function“maš¬ry“fail“if“the“argumen˜t“term“is“not“of“the“spSŽeci ed“form.‘}˜It“also“fails“ifŽ¡‘êñëthere–ê¨is“more“than“one“equation“for“an¬ry“line“v‘ÿXäariable.Ž¦‘êñëâExampleŽŸßÛ‘êñëÓ#EXPAND_AUTO_CONVŽ¤ ™š‘êñë#–¿ª[ASSUME“"!in“out.“INV“(in,out)“=“!(t:num).“out“t“=“~(in“t)"]Ž¡‘êñë#–¿ª"?l1“l2.Ž¡‘êñë#‘>þINV–¿ª(l1,l2)“/\“INV“(l2,out)“/\“(!(t:num).“l1“t“=“l2“(t-1)“\/“out“(t-1))";;Ž¡‘êñë.–¿ª|-“(?l1“l2.Ž¡‘/‘INV(l1,l2)–¿ª/\“INV(l2,out)“/\“(!t.“l1“t“=“l2(t“-“1)“\/“out(t“-“1)))“=Ž¡‘°=(?l1.Ž¡‘/‘(!t.–¿ªout“t“=“~~l1“t)“/\“(!t.“l1“t“=“~l1(t“-“1)“\/“~~l1(t“-“1)))ŽŸ"ÒÑêñëâSee‘…alsoŽ¡‘êñëÓEXPAND_ALL_BUT_CONV,–¿ªEXPAND_AUTO_RIGHT_RULE,“EXPAND_ALL_BUT_RIGHT_RULE,Ž¡‘êñëUNFOLD_CONV,–¿ªUNWIND_AUTO_CONV,“PRUNE_SOME_CONV.ŽŸ¥‡Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXPAND_AUTO_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ)l÷‘êñëÓEXPAND_AUTO_RIGHT_RULE–¿ª:“(thm“list“->“thm“->“thm)Ž¦‘êñëâSynopsisŽ¤‘êñëÖUnfolds,–ê¨then“unš¬rwinds“as“m˜uc˜h“as“pSŽossible,“then“prunes“the“un˜w˜ound“lines.Ž¦‘êñëâDescriptionŽ¡‘êñëÓEXPAND_AUTO_RIGHT_RULE‘¿ªthl›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:ŽŸßÛ‘ð“ÓA–¿ª|-“!z1“...“zr.Ž¤ ™š‘$nt–¿ª=“?l1“...“lm.“t1“/\“...“/\“ui1“/\“...“/\“uik“/\“...“/\“tnŽ¡‘ü0é-------------------------------------------------------------------Ž¡‘ oçB–¿ªu“A“|-“!z1“...“zr.“t“=“?li(k+1)“...“lim.“t1'“/\“...“/\“tn'ŽŸFA‘êñëÖwhere–¡€eac¬rh“Óti'“Öis“the“result“of“rewriting“Óti“Öwith“the“theorems“in“ÓthlÖ.‘ }The“set“of“assump-ŽŽŽŒ‹Ñ ÌU ýFÓŸú™š‘ÇaÒFLA‘þó\TTEN‘Ái‰ffÇŽ–ˆ„CONJ‘Ái‰ffÇŽ“CONV’,6½Û21Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖtions–ƒgÓB‘ƒ@Öis“the“union“of“the“instan¬rtiated“assumptions“of“the“theorems“used“for“rewriting.Ž¤‘ÇaIf–ç>none“of“the“rewrites“are“applicable“to“a“conjunct,›çìit“is“unc¬rhanged.‘7½After“rewriting,˜theŽ¡‘Çafunction–Þ”decides“whicš¬rh“of“the“resulting“terms“to“use“for“un˜winding,‘àþb˜y“pšSŽerforming“a“lo˜opŽ¡‘Çaanalysis–ê¨on“the“graph“represen¬rting“the“depSŽendencies“of“the“lines.Ž¡‘(ðSuppSŽose–àvthe“function“decides“to“un¬rwind“Óli1,...,lik“Öusing“the“terms“Óui1',...,uik'Ž¡‘ÇaÖrespSŽectiv•¬rely‘ÿV.‘ 0ÃThen,›‘ñafter‘=Iun“winding,˜the–=Ilines“Óli1,...,lik“Öare“pruned“(pro¬rvided“theyŽ¡‘Çaha•¬rv“e–#qbSŽeen“eliminated“from“the“righ¬rt-hand“sides“of“the“conjuncts“that“are“equations,‘1£andŽ¡‘Çafrom–ê¨the“whole“of“an¬ry“other“conjuncts)“resulting“in“the“elimination“of“Óui1',...,uik'Ö.Ž¡‘(ðThe–ê¨ÓliÖ's“are“related“b¬ry“the“equation:ŽŸ‡Š‘$_Ó{li1,...,lik}–¿ªu“{li(k+1),...,lim}“=“{l1,...,lm}ŽŸíð‘ÇaÖThe–·lošSŽop“analysis“allo¬rws“the“term“to“b˜e“un•¬rw“ound–·as“m•¬ruc“h–·as“p˜ossible“without“the“risk“ofŽ¡‘ÇaloSŽoping.‘8àThe–ê¨user“is“left“to“deal“with“the“recursiv¬re“equations.Ž©Ûà‘ÇaâF‘þž¸ailureŽ¡‘ÇaÖThe–·—function“maš¬ry“fail“if“the“argumen˜t“theorem“is“not“of“the“spSŽeci ed“form.‘'ÚIt“also“fails“ifŽ¡‘Çathere–ê¨is“more“than“one“equation“for“an¬ry“line“v‘ÿXäariable.Ž¦‘ÇaâExampleŽŸ‡Š‘ÇaÓ#EXPAND_AUTO_RIGHT_RULEŽ¤ ™š‘Ça#–¿ª[ASSUME“"!in“out.“INV“(in,out)“=“!(t:num).“out“t“=“~(in“t)"]Ž¡‘Ça#‘¿ª(ASSUMEŽ¡‘Ça#‘>þ"!(in:num->bool)‘¿ªout.Ž¡‘Ça#‘¾RDEV(in,out)‘¿ª=Ž¡‘Ça#‘"}ü?l1‘¿ªl2.Ž¡‘Ça#‘(=¦INV–¿ª(l1,l2)“/\“INV“(l2,out)“/\“(!(t:num).“l1“t“=“in“t“\/“out“(t-1))");;Ž¡‘Ça..–¿ª|-“!in“out.“DEV(in,out)“=“(!t.“out“t“=“~~(in“t“\/“out(t“-“1)))ŽŸ'ÉБÇaâSee‘…alsoŽ¡‘ÇaÓEXPAND_ALL_BUT_RIGHT_RULE,–¿ªEXPAND_AUTO_CONV,“EXPAND_ALL_BUT_CONV,Ž¡‘ÇaUNFOLD_RIGHT_RULE,–¿ªUNWIND_AUTO_RIGHT_RULE,“PRUNE_SOME_RIGHT_RULE.ŽŸ(“ Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIFLATTEN_CONJ_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ/"‘ÇaÓFLATTEN_CONJ_CONV–¿ª:“convŽ¦‘ÇaâSynopsisŽŸ‘ÇaÖFlattens–ê¨a“`tree'“of“conjunctions.ŽŽŽŒ‹–| ÌU ýFÓŸú™š‘êñëÛ22’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâDescriptionŽ¤ó‘êñëÓFLATTEN_CONJ_CONV–¿ª"t1“/\“...“/\“tn"–ê¨Öreturns“a“theorem“of“the“form:ŽŸe£‘ü0éÓ|-–¿ªt1“/\“...“/\“tn“=“u1“/\“...“/\“unŽŸÙ‘êñëÖwhere–ê¨the“righš¬rt-hand“side“of“the“equation“is“a“ attened“v˜ersion“of“the“left-hand“side.Ž©Ì ‘êñëâF‘þž¸ailureŽ¡‘êñëÖNev¬rer‘ê¨fails.Ž¦‘êñëâExampleŽŸX¥‘êñëÓ#FLATTEN_CONJ_CONV–¿ª"(a“/\“(b“/\“c))“/\“((d“/\“e)“/\“f)";;ŽŸ ™š‘êñë|-–¿ª(a“/\“b“/\“c)“/\“(d“/\“e)“/\“f“=“a“/\“b“/\“c“/\“d“/\“e“/\“fŽŸ-²‘êñëâSee‘…alsoŽŸŒœ‘êñëÓCONJUNCTS_CONV.ŽŸ4dŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIFORALL_CONJ_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ6i‘êñëÓFORALL_CONJ_CONV–¿ª:“convŽ¦‘êñëâSynopsisŽ¡‘êñëÖMo•¬rv“es›ê¨univ“ersal˜quan“ti ers˜do“wn˜through˜a˜tree˜of˜conjunctions.Ž¦‘êñëâDescriptionŽ¡‘êñëÓFORALL_CONJ_CONV–¿ª"!x1“...“xm.“t1“/\“...“/\“tn"–ê¨Öreturns“the“theorem:ŽŸe£‘ü0éÓ|-–¿ª!x1“...“xm.“t1“/\“...“/\“tn“=ŽŸ ™š‘ oç(!x1–¿ª...“xm.“t1)“/\“...“/\“(!x1“...“xm.“tn)ŽŸÙ‘êñëÖwhere–¸othe“original“term“can“bSŽe“an“arbitrary“tree“of“conjunctions.‘¢6The“structure“of“theŽŸ‘êñëtree–ê¨is“retained“in“bSŽoth“sides“of“the“equation.Ž¦‘êñëâF‘þž¸ailureŽ¡‘êñëÖNev¬rer‘ê¨fails.ŽŽŽŒ‹Ÿ~ ÌU ýFÓŸú™š‘ÇaÒF¦tORALL‘Ái‰ffÇŽ–ˆ„CONJ‘Ái‰ffÇŽ“ONCE‘Ái‰ffÇŽ“CONV’ x!Û23Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ$‘ÇaÓ#FORALL_CONJ_CONV–¿ª"!(x:*)“(y:*)“(z:*).“(a“/\“b)“/\“c";;Ž¤ ™š‘Ça|-–¿ª(!x“y“z.“(a“/\“b)“/\“c)“=“((!x“y“z.“a)“/\“(!x“y“z.“b))“/\“(!x“y“z.“c)Ž©34‘Ça#FORALL_CONJ_CONV‘¿ª"T";;Ž¡‘Ça|-–¿ªT“=“TŽ¦‘Ça#FORALL_CONJ_CONV–¿ª"!(x:*)“(y:*)“(z:*).“T";;Ž¡‘Ça|-–¿ª(!x“y“z.“T)“=“(!x“y“z.“T)ŽŸ4€ç‘ÇaâSee‘…alsoŽŸ¯‘ÇaÓCONJ_FORALL_CONV,–¿ªFORALL_CONJ_ONCE_CONV,“CONJ_FORALL_ONCE_CONV,Ž¡‘ÇaFORALL_CONJ_RIGHT_RULE,‘¿ªCONJ_FORALL_RIGHT_RULE.ŽŸBÍŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIFORALL_CONJ_ONCE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ>¼‘ÇaÓFORALL_CONJ_ONCE_CONV–¿ª:“convŽ¤$Uï‘ÇaâSynopsisŽ©|‘ÇaÖMo•¬rv“es–ê¨a“single“univš¬rersal“quan˜ti er“do˜wn“through“a“tree“of“conjunctions.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓFORALL_CONJ_ONCE_CONV–¿ª"!x.“t1“/\“...“/\“tn"–ê¨Öreturns“the“theorem:ŽŸ!$_Ó|-–¿ª!x.“t1“/\“...“/\“tn“=“(!x.“t1)“/\“...“/\“(!x.“tn)ŽŸ"@t‘ÇaÖwhere–¸othe“original“term“can“bSŽe“an“arbitrary“tree“of“conjunctions.‘¢6The“structure“of“theŽŸ‘Çatree–ê¨is“retained“in“bSŽoth“sides“of“the“equation.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–¦¾if“the“argumen¬rt“term“is“not“of“the“required“form.‘"=The“b•SŽo“dy–¦¾of“the“term“need“not“bSŽeŽŸ‘Çaa‘ê¨conjunction.ŽŽŽŒ‹¤¿ ÌU ýFÓŸú™š‘êñëÛ24’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸœ£‘êñëÓ#FORALL_CONJ_ONCE_CONV–¿ª"!x.“((x“\/“a)“/\“(x“\/“b))“/\“(x“\/“c)";;Ž¤ ™š‘êñë|-–¿ª(!x.“((x“\/“a)“/\“(x“\/“b))“/\“(x“\/“c))“=Ž¡‘ü0é((!x.–¿ªx“\/“a)“/\“(!x.“x“\/“b))“/\“(!x.“x“\/“c)Ž©34‘êñë#FORALL_CONJ_ONCE_CONV–¿ª"!x.“x“\/“a";;Ž¡‘êñë|-–¿ª(!x.“x“\/“a)“=“(!x.“x“\/“a)Ž¦‘êñë#FORALL_CONJ_ONCE_CONV–¿ª"!x.“((x“\/“a)“/\“(y“\/“b))“/\“(x“\/“c)";;Ž¡‘êñë|-–¿ª(!x.“((x“\/“a)“/\“(y“\/“b))“/\“(x“\/“c))“=Ž¡‘ü0é((!x.–¿ªx“\/“a)“/\“(!x.“y“\/“b))“/\“(!x.“x“\/“c)Ž©+>‘êñëâSee‘…alsoŽŸ3Ï‘êñëÓCONJ_FORALL_ONCE_CONV,–¿ªFORALL_CONJ_CONV,“CONJ_FORALL_CONV,Ž¡‘êñëFORALL_CONJ_RIGHT_RULE,‘¿ªCONJ_FORALL_RIGHT_RULE.ŽŸ0:|Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIFORALL_CONJ_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ4‹e‘êñëÓFORALL_CONJ_RIGHT_RULE–¿ª:“(thm“->“thm)Ž¤hÔ‘êñëâSynopsisŽŸš5‘êñëÖMo•¬rv“es›ê¨univ“ersal˜quan“ti ers˜do“wn˜through˜a˜tree˜of˜conjunctions.Ž¡‘êñëâDescriptionŽŸœ£‘ oçÓA–¿ª|-“!z1“...“zr.“t“=“?y1“...“yp.“!x1“...“xm.“t1“/\“...“/\“tnŽ¤ ™š‘ü0é-------------------------------------------------------------------Ž¡‘ð“A–¿ª|-“!z1“...“zr.Ž¡‘$nt–¿ª=“?y1“...“yp.“(!x1“...“xm.“t1)“/\“...“/\“(!x1“...“xm.“tn)Ž¦‘êñëâF‘þž¸ailureŽŸš5‘êñëÖF‘ÿVails–ÉSif“the“argumen¬rt“theorem“is“not“of“the“required“form,‘Ïþthough“either“or“bSŽoth“of“Ór“ÖandŽŸ‘êñëÓp–ê¨Öma¬ry“bSŽe“zero.ŽŸhÔ‘êñëâSee‘…alsoŽŸ3Ï‘êñëÓCONJ_FORALL_RIGHT_RULE,–¿ªFORALL_CONJ_CONV,“CONJ_FORALL_CONV,Ž¡‘êñëFORALL_CONJ_ONCE_CONV,‘¿ªCONJ_FORALL_ONCE_CONV.ŽŽŽŒ‹ªN ÌU ýFÓŸú™š‘ÇaÛline‘ÏZ‰ff ÏŽ‘Ü)name’€@25Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIline_nameŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.³Í‘ÇaÓline_name–¿ª:“(term“->“string)Ž¤/î‘ÇaâSynopsisŽ©‘ÇaÖComputes–ê¨the“line“name“of“an“equation.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓline_name–¿ª"!y1“...“ym.“f“x1“...“xn“=“t"–ê¨Öreturns“the“string“Ó`f`Ö.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–ê¨if“the“argumen¬rt“term“is“not“of“the“spSŽeci ed“form.Ž¡‘ÇaâSee‘…alsoŽŸ ™š‘ÇaÓline_var.ŽŸ&ÉŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIline_varŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.³Í‘ÇaÓline_var–¿ª:“(term“->“term)Ž¡‘ÇaâSynopsisŽ¦‘ÇaÖComputes–ê¨the“line“v‘ÿXäariable“of“an“equation.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓline_var–¿ª"!y1“...“ym.“f“x1“...“xn“=“t"–ê¨Öreturns“the“v‘ÿXäariable“Ó"f"Ö.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–ê¨if“the“argumen¬rt“term“is“not“of“the“spSŽeci ed“form.Ž¡‘ÇaâSee‘…alsoŽŸ ™š‘ÇaÓline_name.ŽŸ&ÉŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRUNE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ-Ê4‘ÇaÓPRUNE_CONV–¿ª:“convŽŽŽŒ‹°Ì ÌU ýFÓŸú™š‘êñëÛ26’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâSynopsisŽ¤<=‘êñëÖPrunes–ê¨all“hidden“v‘ÿXäariables.Ž©ðô‘êñëâDescriptionŽ¡‘êñëÓPRUNE_CONV–¿ª"?l1“...“lr.“t1“/\“...“/\“eqn1“/\“...“/\“eqnr“/\“...“/\“tp"–+—Öreturns“aŽ¤‘êñëtheorem–ê¨of“the“form:ŽŸŠŽ‘ü0éÓ|-–¿ª(?l1“...“lr.“t1“/\“...“/\“eqn1“/\“...“/\“eqnr“/\“...“/\“tp)“=ŽŸ ™š‘ oç(t1–¿ª/\“...“/\“tp)ŽŸ´·‘êñëÖwhere–½eac¬rh“Óeqni“Öhas“the“form“Ó"!y1–¿ª...“ym.“li“x1“...“xn“=“b"–½Öand“Óli“ÖdošSŽes“not“app˜earŽ¡‘êñëfree–Æ_in“anš¬ry“of“the“other“conjuncts“or“in“ÓbÖ.‘ÌThe“con˜v˜ersion“w˜orks“if“one“or“more“of“theŽ¡‘êñëÓeqniÖ's–Dare“not“presenš¬rt,‘efthat“is“if“Óli“Öis“not“free“in“an˜y“of“the“conjuncts,‘efbut“doSŽes“not“w˜ork“ifŽ¡‘êñëÓli–LÖappšSŽears“free“in“more“than“one“of“the“conjuncts.‘òlÓp“Öma¬ry“b˜e“zero,›A‘that“is,˜all“the“conjunctsŽ¡‘êñëma¬ry–ÊbšSŽe“ÓeqniÖ's.‘GIn“this“case“the“result“will“b˜e“simply“ÓT‘ÄÖ(true).‘GAlso,›Ófor“eac¬rh“ÓeqniÖ,˜Óm“ÖandŽ¡‘êñëÓn–ê¨Öma¬ry“bSŽe“zero.Ž¦‘êñëâF‘þž¸ailureŽŸ<=‘êñëÖF‘ÿVails–]Îif“the“argumenš¬rt“term“is“not“of“the“spSŽeci ed“form“or“if“an˜y“of“the“ÓliÖ's“are“free“in“moreŽ¡‘êñëthan–ê¨one“of“the“conjuncts“or“if“the“equation“for“anš¬ry“Óli“Öis“recursiv˜e.Ž¦‘êñëâExampleŽŸÆË‘êñëÓ#PRUNE_CONVŽ¤ ™š‘êñë#–¿ª"?l2“l1.Ž¡‘êñë#‘>þ(!(x:num).–¿ªl1“x“=“F)“/\“(!x.“l2“x“=“~(out“x))“/\“(!(x:num).“out“x“=“T)";;Ž¡‘êñë|-–¿ª(?l2“l1.“(!x.“l1“x“=“F)“/\“(!x.“l2“x“=“~out“x)“/\“(!x.“out“x“=“T))“=Ž¡‘ü0é(!x.–¿ªout“x“=“T)ŽŸ)in‘êñëâSee‘…alsoŽŸ ÕבêñëÓPRUNE_ONCE_CONV,–¿ªPRUNE_ONE_CONV,“PRUNE_SOME_CONV,“PRUNE_SOME_RIGHT_RULE,Ž¡‘êñëPRUNE_RIGHT_RULE.ŽŸ+ÒÜŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRUNE_ONCE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ1‘êñëÓPRUNE_ONCE_CONV–¿ª:“convŽ¦‘êñëâSynopsisŽŸ<=‘êñëÖPrunes–ê¨one“hidden“v‘ÿXäariable.ŽŽŽŒ‹µe ÌU ýFÓŸú™š‘ÇaÒPR¦tUNE‘Ái‰ffÇŽ–ˆ„ONE‘Ái‰ffÇŽ“CONV’A¤gÛ27Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâDescriptionŽ¤‘ÇaÓPRUNE_ONCE_CONV–¿ª"?l.“t1“/\“...“/\“ti“/\“eq“/\“t(i+1)“/\“...“/\“tp"–]ÑÖreturns“a“the-Ž¡‘Çaorem–ê¨of“the“form:ŽŸÄå‘$_Ó|-–¿ª(?l.“t1“/\“...“/\“ti“/\“eq“/\“t(i+1)“/\“...“/\“tp)“=ŽŸ ™š‘5E](t1–¿ª/\“...“/\“ti“/\“t(i+1)“/\“...“/\“tp)ŽŸ+K‘ÇaÖwhere–ˆÚÓeq“Öhas“the“form“Ó"!y1–¿ª...“ym.“l“x1“...“xn“=“b"–ˆÚÖand“Ól“ÖdošSŽes“not“app˜ear“free“in“theŽ¡‘ÇaÓtiÖ's–š€or“in“ÓbÖ.‘(The“con•¬rv“ersion›š€w“orks˜if˜Óeq˜Öis˜not˜presen“t,‘ªˆthat˜is˜if˜Ól˜Öis˜not˜free˜in˜an“y˜of˜theŽ¡‘Çaconjuncts,‘gúbut–NêdošSŽes“not“w¬rork“if“Ól“Öapp˜ears“free“in“more“than“one“of“the“conjuncts.‘e¥Eac¬rhŽ¡‘Çaof–ê¨ÓmÖ,“Ón“Öand“Óp“Öma¬ry“bSŽe“zero.Ž©V–‘ÇaâF‘þž¸ailureŽ¡‘ÇaÖF‘ÿVails–]if“the“argumen¬rt“term“is“not“of“the“spSŽeci ed“form“or“if“Ól“Öis“free“in“more“than“one“ofŽ¡‘Çathe–ê¨conjuncts“or“if“the“equation“for“Ól“Öis“recursiv¬re.Ž¦‘ÇaâExampleŽŸÄå‘ÇaÓ#PRUNE_ONCE_CONV–¿ª"?l2.“(!(x:num).“l1“x“=“F)“/\“(!x.“l2“x“=“~(l1“x))";;Ž¤ ™š‘Ça|-–¿ª(?l2.“(!x.“l1“x“=“F)“/\“(!x.“l2“x“=“~l1“x))“=“(!x.“l1“x“=“F)ŽŸ"á‘ÇaâSee‘…alsoŽ¡‘ÇaÓPRUNE_ONE_CONV,–¿ªPRUNE_SOME_CONV,“PRUNE_CONV,“PRUNE_SOME_RIGHT_RULE,Ž¡‘ÇaPRUNE_RIGHT_RULE.ŽŸß¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRUNE_ONE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ)‘ÇaÓPRUNE_ONE_CONV–¿ª:“(string“->“conv)Ž¦‘ÇaâSynopsisŽ¤‘ÇaÖPrunes–ê¨a“spSŽeci ed“hidden“v‘ÿXäariable.Ž¦‘ÇaâDescriptionŽ¡‘ÇaÓPRUNE_ONE_CONV‘¿ª`lj`–ê¨Öwhen“applied“to“the“term:Ž¤Äå‘$_Ó"?l1–¿ª...“lj“...“lr.“t1“/\“...“/\“ti“/\“eq“/\“t(i+1)“/\“...“/\“tp"Ž©+K‘ÇaÖreturns–ê¨a“theorem“of“the“form:Ž¡‘$_Ó|-–¿ª(?l1“...“lj“...“lr.“t1“/\“...“/\“ti“/\“eq“/\“t(i+1)“/\“...“/\“tp)“=ŽŸ ™š‘5E](?l1–¿ª...“l(j-1)“l(j+1)“...“lr.“t1“/\“...“/\“ti“/\“t(i+1)“/\“...“/\“tp)Ž¦‘ÇaÖwhere–; Óeq“Öhas“the“form“Ó"!y1–¿ª...“ym.“lj“x1“...“xn“=“b"–; Öand“Ólj“ÖdošSŽes“not“app˜ear“free“inŽŸ‘Çathe–õØÓtiÖ's“or“in“ÓbÖ.‘ZoThe“con•¬rv“ersion›õØw“orks˜if˜Óeq˜Öis˜not˜presen“t,‘ø£that˜is˜if˜Ólj˜Öis˜not˜free˜in˜an“yŽŽŽŒ‹¼ñ ÌU ýFÓŸú™š‘êñëÛ28’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖof–аthe“conjuncts,‘Õâbut“došSŽes“not“w¬rork“if“Ólj“Öapp˜ears“free“in“more“than“one“of“the“conjuncts.Ž¤‘êñëEacš¬rh–ê¨of“ÓmÖ,“Ón“Öand“Óp“Öma˜y“bSŽe“zero.Ž©Ç‘öSzIf–‹tthere“is“more“than“one“line“with“the“spSŽeci ed“name“(but“with“di erenš¬rt“t˜ypSŽes),‘³¦theŽ¡‘êñëone–ê¨that“appSŽears“outermost“in“the“existenš¬rtial“quan˜ti cations“is“pruned.ŽŸ‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–ÒÈif“the“argumen¬rt“term“is“not“of“the“spSŽeci ed“form“or“if“Ólj“Öis“free“in“more“than“one“ofŽ¡‘êñëthe–Á conjuncts“or“if“the“equation“for“Ólj“Öis“recursiv¬re.‘+The“function“also“fails“if“the“spSŽeci edŽ¡‘êñëline–ê¨is“not“one“of“the“existenš¬rtially“quan˜ti ed“lines.Ž©‘êñëâExampleŽŸ»|‘êñëÓ#PRUNE_ONE_CONV–¿ª`l2`“"?l2“l1.“(!(x:num).“l1“x“=“F)“/\“(!x.“l2“x“=“~(l1“x))";;Ž¤ ™š‘êñë|-–¿ª(?l2“l1.“(!x.“l1“x“=“F)“/\“(!x.“l2“x“=“~l1“x))“=“(?l1.“!x.“l1“x“=“F)ŽŸ34‘êñë#PRUNE_ONE_CONV–¿ª`l1`“"?l2“l1.“(!(x:num).“l1“x“=“F)“/\“(!x.“l2“x“=“~(l1“x))";;Ž¡‘êñëevaluation‘¿ªfailed‘¾RPRUNE_ONE_CONVŽŸ((¨‘êñëâSee‘…alsoŽŸ  a‘êñëÓPRUNE_ONCE_CONV,–¿ªPRUNE_SOME_CONV,“PRUNE_CONV,“PRUNE_SOME_RIGHT_RULE,Ž¡‘êñëPRUNE_RIGHT_RULE.ŽŸ)QQŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRUNE_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0ƒa‘êñëÓPRUNE_RIGHT_RULE–¿ª:“(thm“->“thm)Ž¦‘êñëâSynopsisŽ¤Ç‘êñëÖPrunes–ê¨all“hidden“v‘ÿXäariables.Ž¦‘êñëâDescriptionŽ¡‘êñëÓPRUNE_RIGHT_RULE›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:ŽŸ´µ‘ð“ÓA–¿ª|-“!z1“...“zr.Ž¤ ™š‘$nt–¿ª=“?l1“...“lr.“t1“/\“...“/\“eqn1“/\“...“/\“eqnr“/\“...“/\“tpŽ¡‘ü0é---------------------------------------------------------------------Ž¡‘X+‰A–¿ª|-“!z1“...“zr.“t“=“t1“/\“...“/\“tpŽŸT‘êñëÖwhere–½eac¬rh“Óeqni“Öhas“the“form“Ó"!y1–¿ª...“ym.“li“x1“...“xn“=“b"–½Öand“Óli“ÖdošSŽes“not“app˜earŽ¤‘êñëfree–®,in“anš¬ry“of“the“other“conjuncts“or“in“ÓbÖ.‘ƒkThe“rule“w˜orks“if“one“or“more“of“the“ÓeqniÖ'sŽ¡‘êñëare–=œnot“presenš¬rt,‘RYthat“is“if“Óli“Öis“not“free“in“an˜y“of“the“conjuncts,‘RYbut“doSŽes“not“w˜ork“if“ÓliŽŽŽŒ‹Åj ÌU ýFÓŸú™š‘ÇaÒPR¦tUNE‘Ái‰ffÇŽ–ˆ„SOME‘Ái‰ffÇŽ“CONV’8Œ4Û29Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖappšSŽears–ýyfree“in“more“than“one“of“the“conjuncts.‘qTÓp“Öma¬ry“b˜e“zero,›.that“is,˜all“the“conjunctsŽ¤‘Çama¬ry–ÊbšSŽe“ÓeqniÖ's.‘GIn“this“case“the“result“will“b˜e“simply“ÓT‘ÄÖ(true).‘GAlso,›Ófor“eac¬rh“ÓeqniÖ,˜Óm“ÖandŽ¡‘ÇaÓn–ê¨Öma¬ry“bSŽe“zero.Ž©!‘ÇaâF‘þž¸ailureŽ¡‘ÇaÖF‘ÿVails–ô´if“the“argumenš¬rt“theorem“is“not“of“the“spSŽeci ed“form“or“if“an˜y“of“the“ÓliÖ's“are“free“inŽ¡‘Çamore–ê¨than“one“of“the“conjuncts“or“if“the“equation“for“anš¬ry“Óli“Öis“recursiv˜e.Ž¦‘ÇaâExampleŽŸ«‘ÇaÓ#PRUNE_RIGHT_RULEŽ¤ ™š‘Ça#‘¿ª(ASSUMEŽ¡‘Ça#‘>þ"!(in:num->bool)‘¿ª(out:num->bool).Ž¡‘Ça#‘¾RDEV–¿ª(in,out)“=Ž¡‘Ça#‘"}ü?(l1:num->bool)‘¿ªl2.Ž¡‘Ça#‘(=¦(!x.–¿ªl1“x“=“F)“/\“(!x.“l2“x“=“~(in“x))“/\“(!x.“out“x“=“~(in“x))");;Ž¡‘Ça.–¿ª|-“!in“out.“DEV(in,out)“=“(!x.“out“x“=“~in“x)ŽŸ#‰2‘ÇaâSee‘…alsoŽ¡‘ÇaÓPRUNE_SOME_RIGHT_RULE,–¿ªPRUNE_ONCE_CONV,“PRUNE_ONE_CONV,“PRUNE_SOME_CONV,Ž¡‘ÇaPRUNE_CONV.ŽŸ dŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRUNE_SOME_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ*`5‘ÇaÓPRUNE_SOME_CONV–¿ª:“(string“list“->“conv)Ž¦‘ÇaâSynopsisŽ¤‘ÇaÖPrunes–ê¨sev¬reral“hidden“v‘ÿXäariables.Ž¦‘ÇaâDescriptionŽ¡‘ÇaÓPRUNE_SOME_CONV‘¿ª[`li1`;...;`lik`]–ê¨Öwhen“applied“to“the“term:Ž¤«‘$_Ó"?l1–¿ª...“lr.“t1“/\“...“/\“eqni1“/\“...“/\“eqnik“/\“...“/\“tp"Ž©ƒ‘ÇaÖreturns–ê¨a“theorem“of“the“form:Ž¡‘$_Ó|-–¿ª(?l1“...“lr.“t1“/\“...“/\“eqni1“/\“...“/\“eqnik“/\“...“/\“tp)“=ŽŸ ™š‘5E](?li(k+1)–¿ª...“lir.“t1“/\“...“/\“tp)Ž¦‘ÇaÖwhere–ê¨for“Ó1–¿ª<=“j“<=“kÖ,–ê¨eac¬rh“Óeqnij“Öhas“the“form:Ž¡‘$_Ó"!y1–¿ª...“ym.“lij“x1“...“xn“=“b"Ž¦‘ÇaÖand–+…Ólij“ÖdošSŽes“not“app˜ear“free“in“an¬ry“of“the“other“conjuncts“or“in“ÓbÖ.‘ûvThe“ÓliÖ's“are“relatedŽŽŽŒ‹Íæ ÌU ýFÓŸú™š‘êñëÛ30’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖb¬ry–ê¨the“equation:ŽŸ³f‘ü0éÓ{li1,...,lik}–¿ªu“{li(k+1),...,lir}“=“{l1,...,lr}ŽŸY‘êñëÖThe›W)con•¬rv“ersion˜w“orks˜if˜one˜or˜more˜of˜the˜ÓeqnijÖ's˜are˜not˜presen“t,‘rIthat˜is˜if˜Ólij˜Öis˜notŽ¤‘êñëfree–zBin“anš¬ry“of“the“conjuncts,‘ž(but“doSŽes“not“w˜ork“if“Ólij“ÖappSŽears“free“in“more“than“one“ofŽ¡‘êñëthe–+conjuncts.‘¸hÓp“Öma¬ry“bSŽe“zero,›Ëthat“is,˜all“the“conjuncts“ma¬ry“bSŽe“ÓeqnijÖ's.‘¸hIn“this“case“theŽ¡‘êñëb•SŽo“dy–ê¨of“the“result“will“bSŽe“ÓT“Ö(true).‘8àAlso,“for“eacš¬rh“ÓeqnijÖ,“Óm“Öand“Ón“Öma˜y“bSŽe“zero.Ž©s‘öSzIf–Òthere“is“more“than“one“line“with“a“spSŽeci ed“name“(but“with“di erenš¬rt“t˜ypSŽes),‘Öùthe“oneŽ¡‘êñëthat–›ÏappSŽears“outermost“in“the“existenš¬rtial“quan˜ti cations“is“pruned.‘˜If“suc˜h“a“line“name“isŽ¡‘êñëmen•¬rtioned›wit“wice˜in˜the˜list,‘š™the˜t“w“o˜outermost˜oSŽccurrences˜of˜lines˜with˜that˜name˜willŽ¡‘êñëbSŽe–ê¨pruned,“and“so“on.ŽŸ Ì‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–”¸if“the“argumenš¬rt“term“is“not“of“the“spSŽeci ed“form“or“if“an˜y“of“the“ÓlijÖ's“are“free“inŽ¡‘êñëmore–(²than“one“of“the“conjuncts“or“if“the“equation“for“anš¬ry“Ólij“Öis“recursiv˜e.‘òÿThe“functionŽ¡‘êñëalso–ê¨fails“if“anš¬ry“of“the“spSŽeci ed“lines“are“not“one“of“the“existen˜tially“quan˜ti ed“lines.Ž© Ì‘êñëâExampleŽŸ¹Ù‘êñëÓ#PRUNE_SOME_CONV‘¿ª[`l1`;`l2`]Ž¤ ™š‘êñë#–¿ª"?l3“l2“l1.Ž¡‘êñë#‘>þ(!(x:num).–¿ªl1“x“=“F)“/\“(!x.“l2“x“=“~(l3“x))“/\“(!(x:num).“l3“x“=“T)";;Ž¡‘êñë|-–¿ª(?l3“l2“l1.“(!x.“l1“x“=“F)“/\“(!x.“l2“x“=“~l3“x)“/\“(!x.“l3“x“=“T))“=Ž¡‘ü0é(?l3.–¿ª!x.“l3“x“=“T)ŽŸ.&²‘êñëâSee‘…alsoŽŸ  ‘êñëÓPRUNE_ONCE_CONV,–¿ªPRUNE_ONE_CONV,“PRUNE_CONV,“PRUNE_SOME_RIGHT_RULE,Ž¡‘êñëPRUNE_RIGHT_RULE.ŽŸ5MeŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRUNE_SOME_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ7‘êñëÓPRUNE_SOME_RIGHT_RULE–¿ª:“(string“list“->“thm“->“thm)Ž¦‘êñëâSynopsisŽŸs‘êñëÖPrunes–ê¨sev¬reral“hidden“v‘ÿXäariables.ŽŽŽŒ‹ÕW ÌU ýFÓŸú™š‘ÇaÒPRš¦tUNE‘Ái‰ffÇŽ–ˆ„SOME‘Ái‰ffÇŽ“RIGHT‘Ái‰ffÇŽ“R˜ULE’ ”VÛ31Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâDescriptionŽŸg}‘ÇaÓPRUNE_SOME_RIGHT_RULE‘¿ª[`li1`;...;`lik`]›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:Ž©7‘)Æ ÓA–¿ª|-“!z1“...“zr.Ž¤ ™š‘LDt–¿ª=“?l1“...“lr.“t1“/\“...“/\“eqni1“/\“...“/\“eqnik“/\“...“/\“tpŽ¡‘$_-----------------------------------------------------------------------Ž¡‘R¯A–¿ª|-“!z1“...“zr.“t“=“?li(k+1)“...“lir.“t1“/\“...“/\“tpŽ¤6w‘ÇaÖwhere–ê¨for“Ó1–¿ª<=“j“<=“kÖ,–ê¨eac¬rh“Óeqnij“Öhas“the“form:Ž¦‘$_Ó"!y1–¿ª...“ym.“lij“x1“...“xn“=“b"Ž¡‘ÇaÖand–+…Ólij“ÖdošSŽes“not“app˜ear“free“in“an¬ry“of“the“other“conjuncts“or“in“ÓbÖ.‘ûvThe“ÓliÖ's“are“relatedŽŸ‘Çab¬ry–ê¨the“equation:Ž¦‘$_Ó{li1,...,lik}–¿ªu“{li(k+1),...,lir}“=“{l1,...,lr}Ž¡‘ÇaÖThe–^rule“wš¬rorks“if“one“or“more“of“the“ÓeqnijÖ's“are“not“presen˜t,‘C9that“is“if“Ólij“Öis“not“free“in“an˜yŽ¤‘Çaof–ythe“conjuncts,‘Íbut“došSŽes“not“w¬rork“if“Ólij“Öapp˜ears“free“in“more“than“one“of“the“conjuncts.Ž¡‘ÇaÓp–œ¹Öma¬ry“bSŽe“zero,›¬Othat“is,˜all“the“conjuncts“ma¬ry“bSŽe“ÓeqnijÖ's.‘æIn“this“case“the“conjunction“willŽ¡‘ÇabSŽe–ê¨transformed“to“ÓT“Ö(true).‘8àAlso,“for“eacš¬rh“ÓeqnijÖ,“Óm“Öand“Ón“Öma˜y“bSŽe“zero.Ž©g}‘(ðIf–Òthere“is“more“than“one“line“with“a“spSŽeci ed“name“(but“with“di erenš¬rt“t˜ypSŽes),‘Öùthe“oneŽ¡‘Çathat–›ÏappSŽears“outermost“in“the“existenš¬rtial“quan˜ti cations“is“pruned.‘˜If“suc˜h“a“line“name“isŽ¡‘Çamen•¬rtioned›wit“wice˜in˜the˜list,‘š™the˜t“w“o˜outermost˜oSŽccurrences˜of˜lines˜with˜that˜name˜willŽ¡‘ÇabSŽe–ê¨pruned,“and“so“on.ŽŸó‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–§@if“the“argumenš¬rt“theorem“is“not“of“the“spSŽeci ed“form“or“if“an˜y“of“the“ÓlijÖ's“are“free“inŽ¡‘Çamore–(²than“one“of“the“conjuncts“or“if“the“equation“for“anš¬ry“Ólij“Öis“recursiv˜e.‘òÿThe“functionŽ¡‘Çaalso–ê¨fails“if“anš¬ry“of“the“spSŽeci ed“lines“are“not“one“of“the“existen˜tially“quan˜ti ed“lines.ŽŸó‘ÇaâExampleŽŸŸ ‘ÇaÓ#PRUNE_SOME_RIGHT_RULE‘¿ª[`l1`;`l2`]Ž¤ ™š‘Ça#‘¿ª(ASSUMEŽ¡‘Ça#‘>þ"!(in:num->bool)‘¿ª(out:num->bool).Ž¡‘Ça#‘¾RDEV–¿ª(in,out)“=Ž¡‘Ça#‘"}ü?(l1:num->bool)‘¿ªl2.Ž¡‘Ça#‘(=¦(!x.–¿ªl1“x“=“F)“/\“(!x.“l2“x“=“~(in“x))“/\“(!x.“out“x“=“~(in“x))");;Ž¡‘Ça.–¿ª|-“!in“out.“DEV(in,out)“=“(!x.“out“x“=“~in“x)ŽŸ*lí‘ÇaâSee‘…alsoŽŸ‘ÇaÓPRUNE_RIGHT_RULE,–¿ªPRUNE_ONCE_CONV,“PRUNE_ONE_CONV,“PRUNE_SOME_CONV,“PRUNE_CONV.ŽŽŽŒ‹ Ý ÌU ýFÓŸú™š‘êñëÛ32’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNFOLD_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0÷#‘êñëÓUNFOLD_CONV–¿ª:“(thm“list“->“conv)Ž¤]A‘êñëâSynopsisŽ©P‘êñëÖExpands–ê¨sub-compSŽonenš¬rts“of“a“hardw˜are“description“using“their“de nitions.Ž¡‘êñëâDescriptionŽ¦‘êñëÓUNFOLD_CONV–¿ªthl“"t1“/\“...“/\“tn"–ê¨Öreturns“a“theorem“of“the“form:ŽŸöÚ‘ü0éÓB–¿ª|-“t1“/\“...“/\“tn“=“t1'“/\“...“/\“tn'ŽŸEð‘êñëÖwhere–¡€eac¬rh“Óti'“Öis“the“result“of“rewriting“Óti“Öwith“the“theorems“in“ÓthlÖ.‘ }The“set“of“assump-Ž¤‘êñëtions––¿ÓB‘–©Öis“the“union“of“the“instan¬rtiated“assumptions“of“the“theorems“used“for“rewriting.‘èIfŽ¡‘êñënone–ê¨of“the“rewrites“are“applicable“to“a“ÓtiÖ,“it“is“unc¬rhanged.Ž¤]A‘êñëâF‘þž¸ailureŽ¦‘êñëÖNev¬rer‘ê¨fails.Ž¡‘êñëâExampleŽŸ*‘êñëÓ#UNFOLD_CONV–¿ª[ASSUME“"!in“out.“INV“(in,out)“=“!(t:num).“out“t“=“~(in“t)"]Ž¤ ™š‘êñë#–¿ª"INV“(l1,l2)“/\“INV“(l2,l3)“/\“(!(t:num).“l1“t“=“l2“(t-1)“\/“l3“(t-1))";;Ž¡‘êñë.–¿ª|-“INV(l1,l2)“/\“INV(l2,l3)“/\“(!t.“l1“t“=“l2(t“-“1)“\/“l3(t“-“1))“=Ž¡‘°=(!t.–¿ªl2“t“=“~l1“t)“/\Ž¡‘°=(!t.–¿ªl3“t“=“~l2“t)“/\Ž¡‘°=(!t.–¿ªl1“t“=“l2(t“-“1)“\/“l3(t“-“1))ŽŸ(‹á‘êñëâSee‘…alsoŽŸ °ê‘êñëÓUNFOLD_RIGHT_RULE.ŽŸ*Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNFOLD_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0÷#‘êñëÓUNFOLD_RIGHT_RULE–¿ª:“(thm“list“->“thm“->“thm)ŽŸ]A‘êñëâSynopsisŽ¦‘êñëÖExpands–ê¨sub-compSŽonenš¬rts“of“a“hardw˜are“description“using“their“de nitions.ŽŽŽŒ‹!çD ÌU ýFÓŸú™š‘ÇaÒUNWIND‘Ái‰ffÇŽ–ˆ„ALL‘Ái‰ffÇŽ“BUT‘Ái‰ffÇŽ“CONV’K$Û33Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâDescriptionŽ©‘ÇaÓUNFOLD_RIGHT_RULE‘¿ªthl›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:ŽŸðÈ‘;ÓA–¿ª|-“!z1“...“zr.“t“=“?y1“...“yp.“t1“/\“...“/\“tnŽ¤ ™š‘$_--------------------------------------------------------Ž¡‘)Æ B–¿ªu“A“|-“!z1“...“zr.“t“=“?y1“...“yp.“t1'“/\“...“/\“tn'ŽŸW.‘ÇaÖwhere–¡€eac¬rh“Óti'“Öis“the“result“of“rewriting“Óti“Öwith“the“theorems“in“ÓthlÖ.‘ }The“set“of“assump-Ž¦‘Çations––¿ÓB‘–©Öis“the“union“of“the“instan¬rtiated“assumptions“of“the“theorems“used“for“rewriting.‘èIfŽ¦‘Çanone–ê¨of“the“rewrites“are“applicable“to“a“ÓtiÖ,“it“is“unc¬rhanged.Ž¤®\‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–=zif“the“second“argumen¬rt“is“not“of“the“required“form,‘R.though“either“or“bSŽoth“of“Ór“ÖandŽ¦‘ÇaÓp–ê¨Öma¬ry“bSŽe“zero.Ž¡‘ÇaâExampleŽŸðÈ‘ÇaÓ#UNFOLD_RIGHT_RULE–¿ª[ASSUME“"!in“out.“INV(in,out)“=“!(t:num).“out“t“=“~(in“t)"]Ž¤ ™š‘Ça#–¿ª(ASSUME“"!(in:num->bool)“out.“BUF(in,out)“=“?l.“INV(in,l)“/\“INV(l,out)");;Ž¡‘Ça..–¿ª|-“!in“out.Ž¡‘;BUF(in,out)–¿ª=“(?l.“(!t.“l“t“=“~in“t)“/\“(!t.“out“t“=“~l“t))ŽŸ#Š‘ÇaâSee‘…alsoŽ¡‘ÇaÓUNFOLD_CONV.ŽŸ Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNWIND_ALL_BUT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ)°ª‘ÇaÓUNWIND_ALL_BUT_CONV–¿ª:“(string“list“->“conv)Ž¤®\‘ÇaâSynopsisŽ¦‘ÇaÖUnš¬rwinds–ê¨all“lines“of“a“device“(except“those“in“the“argumen˜t“list)“as“m˜uc˜h“as“pSŽossible.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓUNWIND_ALL_BUT_CONV‘¿ªl–ê¨Öwhen“applied“to“the“follo¬rwing“term:Ž¤ðÈ‘$_Ó"t1–¿ª/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn"Ž©W.‘ÇaÖreturns–ê¨a“theorem“of“the“form:Ž¡‘$_Ó|-–¿ªt1‘ T/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn“=ŽŸ ™š‘5E]t1'–¿ª/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn'Ž¦‘ÇaÖwhere–îÓti'“Ö(for“Ó1–¿ª<=“i“<=“nÖ)–îis“Óti“Örewritten“with“the“equations“Óeqni“Ö(Ó1–¿ª<=“i“<=“mÖ).‘ï¢TheseŽŸ‘Çaequations–ê¨are“those“conjuncts“with“line“name“not“in“Ól“Ö(and“whic¬rh“are“equations).ŽŽŽŒ‹"í° ÌU ýFÓŸú™š‘êñëÛ34’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâF‘þž¸ailureŽŸPÖ‘êñëÖNevš¬rer–ê¨fails“but“ma˜y“loSŽop“inde nitely‘ÿV.Ž©CV‘êñëâExampleŽŸ-Ç‘êñëÓ#UNWIND_ALL_BUT_CONV‘¿ª[`l2`]Ž¤ ™š‘êñë#–¿ª"(!(x:num).“l1“x“=“(l2“x)“-“1)“/\Ž¡‘êñë#‘ T(!x.–¿ªf“x“=“(l2“(x+1))“+“(l1“(x+2)))“/\Ž¡‘êñë#‘ T(!x.–¿ªl2“x“=“7)";;Ž¡‘êñë|-–¿ª(!x.“l1“x“=“(l2“x)“-“1)“/\Ž¡‘ü0é(!x.–¿ªf“x“=“(l2(x“+“1))“+“(l1(x“+“2)))“/\Ž¡‘ü0é(!x.–¿ªl2“x“=“7)“=Ž¡‘ü0é(!x.–¿ªl1“x“=“(l2“x)“-“1)“/\Ž¡‘ü0é(!x.–¿ªf“x“=“(l2(x“+“1))“+“((l2(x“+“2))“-“1))“/\Ž¡‘ü0é(!x.–¿ªl2“x“=“7)ŽŸ)å‘êñëâSee‘…alsoŽŸ êp‘êñëÓUNWIND_ONCE_CONV,–¿ªUNWIND_CONV,“UNWIND_AUTO_CONV,“UNWIND_ALL_BUT_RIGHT_RULE,Ž¡‘êñëUNWIND_AUTO_RIGHT_RULE.ŽŸ,ÊŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNWIND_ALL_BUT_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ2‰É‘êñëÓUNWIND_ALL_BUT_RIGHT_RULE–¿ª:“(string“list“->“thm“->“thm)Ž¦‘êñëâSynopsisŽ¤PÖ‘êñëÖUnš¬rwinds–ê¨all“lines“of“a“device“(except“those“in“the“argumen˜t“list)“as“m˜uc˜h“as“pSŽossible.Ž¦‘êñëâDescriptionŽ¡‘êñëÓUNWIND_ALL_BUT_RIGHT_RULE‘¿ªl›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:ŽŸÜñ‘ð“ÓA–¿ª|-“!z1“...“zr.Ž¤ ™š‘$nt‘¿ª=Ž¡‘$n(?l1–¿ª...“lp.“t1‘ T/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn)Ž¡‘ü0é---------------------------------------------------------------------Ž¡‘ð“A–¿ª|-“!z1“...“zr.Ž¡‘$nt‘¿ª=Ž¡‘$n(?l1–¿ª...“lp.“t1'“/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn')ŽŸò‘êñëÖwhere–îÓti'“Ö(for“Ó1–¿ª<=“i“<=“nÖ)–îis“Óti“Örewritten“with“the“equations“Óeqni“Ö(Ó1–¿ª<=“i“<=“mÖ).‘ï¢TheseŽŸ‘êñëequations–ê¨are“those“conjuncts“with“line“name“not“in“Ól“Ö(and“whic¬rh“are“equations).ŽŽŽŒ‹#õâ ÌU ýFÓŸú™š‘ÇaÒUNWIND‘Ái‰ffÇŽ–ˆ„A¦tUTO‘Ái‰ffÇŽ“CONV’,ÒvÛ35Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâF‘þž¸ailureŽ¤‘ÇaÖF‘ÿVails–ÉSif“the“argumen¬rt“theorem“is“not“of“the“required“form,‘Ïþthough“either“or“bSŽoth“of“Óp“ÖandŽ¡‘ÇaÓr–ê¨Ömaš¬ry“bSŽe“zero.‘8àMa˜y“loSŽop“inde nitely‘ÿV.Ž©~È‘ÇaâExampleŽŸXþ‘ÇaÓ#UNWIND_ALL_BUT_RIGHT_RULE‘¿ª[`l2`]Ž¤ ™š‘Ça#‘¿ª(ASSUMEŽ¡‘Ça#‘>þ"!f.–¿ªIMP(f)“=Ž¡‘Ça#‘¾R?l2‘¿ªl1.Ž¡‘Ça#‘"}ü(!(x:num).–¿ªl1“x“=“(l2“x)“-“1)“/\Ž¡‘Ça#‘"}ü(!x.–¿ªf“x“=“(l2“(x+1))“+“(l1“(x+2)))“/\Ž¡‘Ça#‘"}ü(!x.–¿ªl2“x“=“7)");;Ž¡‘Ça.–¿ª|-“!f.Ž¡‘5E]IMP–¿ªf“=Ž¡‘5E](?l2‘¿ªl1.Ž¡‘@ı(!x.–¿ªl1“x“=“(l2“x)“-“1)“/\Ž¡‘@ı(!x.–¿ªf“x“=“(l2(x“+“1))“+“((l2(x“+“2))“-“1))“/\Ž¡‘@ı(!x.–¿ªl2“x“=“7))ŽŸ'>,‘ÇaâSee‘…alsoŽ¡‘ÇaÓUNWIND_AUTO_RIGHT_RULE,–¿ªUNWIND_ALL_BUT_CONV,“UNWIND_AUTO_CONV,Ž¡‘ÇaUNWIND_ONCE_CONV,‘¿ªUNWIND_CONV.ŽŸ'|YŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNWIND_AUTO_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.gê‘ÇaÓUNWIND_AUTO_CONV–¿ª:“convŽ¦‘ÇaâSynopsisŽ¤‘ÇaÖAutomatic–i©un¬rwinding“of“equations“de ning“wire“v‘ÿXäalues“in“a“standard“device“spSŽeci cation.Ž¦‘ÇaâDescriptionŽ¡‘ÇaÓUNWIND_AUTO_CONV–¿ª"?l1“...“lm.“t1“/\“...“/\“tn"–ê¨Öreturns“a“theorem“of“the“form:ŽŸXþ‘$_Ó|-–¿ª(?l1“...“lm.“t1“/\“...“/\“tn)“=“(?l1“...“lm.“t1'“/\“...“/\“tn')ŽŸ¿d‘ÇaÖwhere–ê¨Ótj'“Öis“Ótj“Örewritten“with“equations“selected“from“the“ÓtiÖ's.Ž¡‘(ðThe–IŽfunction“decides“whicš¬rh“equations“to“use“for“rewriting“b˜y“pšSŽerforming“a“lo˜op“analysisŽ¡‘Çaon–"@the“graph“represen¬rting“the“depšSŽendencies“of“the“lines.‘ß©By“this“means“the“term“can“b˜eŽ¡‘Çaun•¬rw“ound–Š\as“m•¬ruc“h–Š\as“pšSŽossible“without“the“risk“of“lo˜oping.‘ýThe“user“is“left“to“deal“withŽ¡‘Çathe–ê¨recursiv¬re“equations.ŽŽŽŒ‹$ü± ÌU ýFÓŸú™š‘êñëÛ36’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâF‘þž¸ailureŽŸ‘êñëÖF‘ÿVails–ê¨if“there“is“more“than“one“equation“for“an¬ry“line“v‘ÿXäariable.Ž©1Ñ‘êñëâExampleŽŸ2ƒ‘êñëÓ#UNWIND_AUTO_CONVŽ¤ ™š‘êñë#–¿ª"(!(x:num).“l1“x“=“(l2“x)“-“1)“/\Ž¡‘êñë#‘ T(!x.–¿ªf“x“=“(l2“(x+1))“+“(l1“(x+2)))“/\Ž¡‘êñë#‘ T(!x.–¿ªl2“x“=“7)";;Ž¡‘êñë|-–¿ª(!x.“l1“x“=“(l2“x)“-“1)“/\Ž¡‘ü0é(!x.–¿ªf“x“=“(l2(x“+“1))“+“(l1(x“+“2)))“/\Ž¡‘ü0é(!x.–¿ªl2“x“=“7)“=Ž¡‘ü0é(!x.–¿ªl1“x“=“7“-“1)“/\“(!x.“f“x“=“7“+“(7“-“1))“/\“(!x.“l2“x“=“7)ŽŸ&ʺ‘êñëâSee‘…alsoŽ¡‘êñëÓUNWIND_ONCE_CONV,–¿ªUNWIND_CONV,“UNWIND_ALL_BUT_CONV,“UNWIND_ALL_BUT_RIGHT_RULE,Ž¡‘êñëUNWIND_AUTO_RIGHT_RULE.ŽŸ&•tŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNWIND_AUTO_RIGHT_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.·•‘êñëÓUNWIND_AUTO_RIGHT_RULE–¿ª:“(thm“->“thm)Ž¦‘êñëâSynopsisŽ¤‘êñëÖAutomatic–i©un¬rwinding“of“equations“de ning“wire“v‘ÿXäalues“in“a“standard“device“spSŽeci cation.Ž¦‘êñëâDescriptionŽ¡‘êñëÓUNWIND_AUTO_RIGHT_RULE›ê¨ÖbSŽeha•¬rv“es˜as˜follo“ws:ŽŸ2ƒ‘ð“ÓA–¿ª|-“!z1“...“zr.“t“=“?l1“...“lm.“t1‘ T/\“...“/\“tnŽ¤ ™š‘ü0é----------------------------------------------------Ž¡‘ð“A–¿ª|-“!z1“...“zr.“t“=“?l1“...“lm.“t1'“/\“...“/\“tn'ŽŸ˜é‘êñëÖwhere–ê¨Ótj'“Öis“Ótj“Örewritten“with“equations“selected“from“the“ÓtiÖ's.Ž¤‘öSzThe–IŽfunction“decides“whicš¬rh“equations“to“use“for“rewriting“b˜y“pšSŽerforming“a“lo˜op“analysisŽ¡‘êñëon–"@the“graph“represen¬rting“the“depšSŽendencies“of“the“lines.‘ß©By“this“means“the“term“can“b˜eŽ¡‘êñëun•¬rw“ound–Š\as“m•¬ruc“h–Š\as“pšSŽossible“without“the“risk“of“lo˜oping.‘ýThe“user“is“left“to“deal“withŽ¡‘êñëthe–ê¨recursiv¬re“equations.Ž¦‘êñëâF‘þž¸ailureŽ¡‘êñëÖF‘ÿVails–ßœif“there“is“more“than“one“equation“for“anš¬ry“line“v‘ÿXäariable,‘áÒor“if“the“argumen˜t“theoremŽ¡‘êñëis–ê¨not“of“the“required“form,“though“either“or“bšSŽoth“of“Óm“Öand“Ór“Öma¬ry“b˜e“zero.ŽŽŽŒ‹%î ÌU ýFÓŸú™š‘ÇaÒUNWIND‘Ái‰ffÇŽ‘ˆ„CONV’VnÜÛ37Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸJÁ‘ÇaÓ#UNWIND_AUTO_RIGHT_RULEŽ¤ ™š‘Ça#‘¿ª(ASSUMEŽ¡‘Ça#‘>þ"!f.–¿ªIMP(f)“=Ž¡‘Ça#‘¾R?l2‘¿ªl1.Ž¡‘Ça#‘"}ü(!(x:num).–¿ªl1“x“=“(l2“x)“-“1)“/\Ž¡‘Ça#‘"}ü(!x.–¿ªf“x“=“(l2“(x+1))“+“(l1“(x+2)))“/\Ž¡‘Ça#‘"}ü(!x.–¿ªl2“x“=“7)");;Ž¡‘Ça.–¿ª|-“!f.Ž¡‘5E]IMP–¿ªf“=Ž¡‘5E](?l2‘¿ªl1.Ž¡‘@ı(!x.–¿ªl1“x“=“7“-“1)“/\“(!x.“f“x“=“7“+“(7“-“1))“/\“(!x.“l2“x“=“7))ŽŸ,n/‘ÇaâSee‘…alsoŽŸV¢‘ÇaÓUNWIND_ALL_BUT_RIGHT_RULE,–¿ªUNWIND_AUTO_CONV,“UNWIND_ALL_BUT_CONV,Ž¡‘ÇaUNWIND_ONCE_CONV,‘¿ªUNWIND_CONV.ŽŸ1Ü^Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNWIND_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ5)‘ÇaÓUNWIND_CONV–¿ª:“((term“->“bool)“->“conv)Ž¤ô‘ÇaâSynopsisŽ©½‘ÇaÖUnš¬rwinds–ê¨device“bSŽeha˜viour“using“selected“line“equations“un˜til“no“c˜hange.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓUNWIND_CONV–¿ªp“"t1“/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn"–µ„Öreturns“a“theorem“ofŽ¤‘Çathe‘ê¨form:ŽŸ¹‘$_Ó|-–¿ªt1‘ T/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn“=ŽŸ ™š‘5E]t1'–¿ª/\“...“/\“eqn1“/\“...“/\“eqnm“/\“...“/\“tn'ŽŸ7‘ÇaÖwhere–îÓti'“Ö(for“Ó1–¿ª<=“i“<=“nÖ)–îis“Óti“Örewritten“with“the“equations“Óeqni“Ö(Ó1–¿ª<=“i“<=“mÖ).‘ï¢TheseŽ¡‘Çaequations–—are“the“conjuncts“for“whic¬rh“the“predicate“Óp“Öis“true.‘ >The“Óti“Öterms“are“theŽ¡‘Çaconjuncts–ê¨for“whicš¬rh“Óp“Öis“false.‘8àThe“rewriting“is“repSŽeated“un˜til“no“c˜hanges“tak˜e“place.ŽŸô‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖNevš¬rer–ê¨fails“but“ma˜y“loSŽop“inde nitely‘ÿV.ŽŽŽŒ‹& Ø ÌU ýFÓŸú™š‘êñëÛ38’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸŠ"‘êñëÓ#UNWIND_CONV–¿ª(\tm.“mem“(line_name“tm)“[`l1`;`l2`])Ž¤ ™š‘êñë#–¿ª"(!(x:num).“l1“x“=“(l2“x)“-“1)“/\Ž¡‘êñë#‘ T(!x.–¿ªf“x“=“(l2“(x+1))“+“(l1“(x+2)))“/\Ž¡‘êñë#‘ T(!x.–¿ªl2“x“=“7)";;Ž¡‘êñë|-–¿ª(!x.“l1“x“=“(l2“x)“-“1)“/\Ž¡‘ü0é(!x.–¿ªf“x“=“(l2(x“+“1))“+“(l1(x“+“2)))“/\Ž¡‘ü0é(!x.–¿ªl2“x“=“7)“=Ž¡‘ü0é(!x.–¿ªl1“x“=“(l2“x)“-“1)“/\“(!x.“f“x“=“7“+“(7“-“1))“/\“(!x.“l2“x“=“7)ŽŸ-íp‘êñëâSee‘…alsoŽŸ–‚‘êñëÓUNWIND_ONCE_CONV,–¿ªUNWIND_ALL_BUT_CONV,“UNWIND_AUTO_CONV,Ž¡‘êñëUNWIND_ALL_BUT_RIGHT_RULE,‘¿ªUNWIND_AUTO_RIGHT_RULE.ŽŸ4Úߟ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIUNWIND_ONCE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ7>I‘êñëÓUNWIND_ONCE_CONV–¿ª:“((term“->“bool)“->“conv)Ž¤ó ‘êñëâSynopsisŽ©üè‘êñëÖBasic›Ë£con•¬rv“ersion˜for˜parallel˜un“winding˜of˜equations˜de ning˜wire˜v‘ÿXäalues˜in˜a˜standardŽŸ‘êñëdevice‘ê¨spSŽeci cation.Ž¡‘êñëâDescriptionŽ¦‘êñëÓUNWIND_ONCE_CONV–¿ªp“tm–o†Öunš¬rwinds“the“conjunction“Ótm“Öusing“the“equations“selected“b˜y“theŽ¤‘êñëpredicate–ýûÓpÖ.‘rØÓtm“Öshould“bšSŽe“a“conjunction,‘BÏequiv‘ÿXäalen¬rt“under“asso˜ciativ•¬re-comm“utativ“e‘ýûre-Ž¡‘êñëordering‘ê¨to:Ž¤:‘ü0éÓt1–¿ª/\“t2“/\“...“/\“tnŽ©ö¸‘êñëp–ê¨Öis“used“to“partition“the“terms“Óti“Öfor“Ó1–¿ª<=“i“<=“n–ê¨Öinš¬rto“t˜w˜o“disjoin˜t“sets:Ž¡‘ü0éÓREW–¿ª=“{ti“|“p“ti}ŽŸ ™š‘ü0éOBJ–¿ª=“{ti“|“~p“ti}Ž¦‘êñëÖThe–;terms“Óti“Öfor“whicš¬rh“Óp“Öis“true“are“then“used“as“a“set“of“rewrite“rules“(th˜us“they“should“bSŽeŽŸ‘êñëequations)–xàto“do“a“single“top-do¬rwn“parallel“rewrite“of“the“remaining“terms.‘óThe“rewrittenŽŽŽŒ‹') ÌU ýFÓŸú™š‘ÇaÒUNWIND‘Ái‰ffÇŽ–ˆ„ONCE‘Ái‰ffÇŽ“CONV’-7¯Û39Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖterms–¶tak¬re“the“place“of“the“original“terms“in“the“input“conjunction.‘']F‘ÿVor“example,‘À¡if“Ótm“Öis:Ž¤™š‘$_Ót1–¿ª/\“t2“/\“t3“/\“t4Ž©‘ÇaÖand›ê¨ÓREW–¿ª=“{t1,t3}˜Öthen˜the˜result˜is:Ž¡‘$_Ó|-–¿ªt1“/\“t2“/\“t3“/\“t4“=“t1“/\“t2'“/\“t3“/\“t4'Ž¦‘ÇaÖwhere–ê¨Óti'“Öis“Óti“Örewritten“with“the“equations“ÓREWÖ.Ž¦‘ÇaâF‘þž¸ailureŽŸ‘ÇaÖNev¬rer‘ê¨fails.Ž¦‘ÇaâExampleŽ¡‘ÇaÓ#UNWIND_ONCE_CONV–¿ª(\tm.“mem“(line_name“tm)“[`l1`;`l2`])Ž¤ ™š‘Ça#–¿ª"(!(x:num).“l1“x“=“(l2“x)“-“1)“/\Ž¡‘Ça#‘ T(!x.–¿ªf“x“=“(l2“(x+1))“+“(l1“(x+2)))“/\Ž¡‘Ça#‘ T(!x.–¿ªl2“x“=“7)";;Ž¡‘Ça|-–¿ª(!x.“l1“x“=“(l2“x)“-“1)“/\Ž¡‘$_(!x.–¿ªf“x“=“(l2(x“+“1))“+“(l1(x“+“2)))“/\Ž¡‘$_(!x.–¿ªl2“x“=“7)“=Ž¡‘$_(!x.–¿ªl1“x“=“(l2“x)“-“1)“/\Ž¡‘$_(!x.–¿ªf“x“=“7“+“((l2(x“+“2))“-“1))“/\Ž¡‘$_(!x.–¿ªl2“x“=“7)ŽŸ(‘ÇaâSee‘…alsoŽ¡‘ÇaÓUNWIND_CONV,–¿ªUNWIND_ALL_BUT_CONV,“UNWIND_AUTO_CONV,“UNWIND_ALL_BUT_RIGHT_RULE,Ž¡‘ÇaUNWIND_AUTO_RIGHT_RULE.ŽŽŽŒ‹( ÌU ýFÓŸú™š‘êñëÛ40’–KEChapter–€2.‘ €ML“F‘þàunctions“in“the“un wind“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹)^ ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸGëHReferencesŽŸ‰Ç>|Ÿ;‘ßüÖ[1]ŽŽ‘' A.–ÀCamilleri,›…M.“Gordon,˜and“T.“Melham.‘zYHardwš¬rare“v˜eri cation“using“higher-orderŽ¤‘' logic.‘ÎIn–‡aD.“Borrione,–›|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘êñëó1߆µT cmtt12ÜCONJ_FORALL_CONVÖ,‘ê¨11Ž¤s‘êñëÜCONJ_FORALL_ONCE_CONVÖ,‘ê¨12Ž¡‘êñëÜCONJ_FORALL_RIGHT_RULEÖ,‘ê¨13Ž©ÿH‘êñëÜDEPTH_EXISTS_CONVÖ,‘ê¨14Ž¡‘êñëÜDEPTH_FORALL_CONVÖ,‘ê¨14Ž¦‘êñëÜEXISTS_DEL1_CONVÖ,‘ê¨15Ž¡‘êñëÜEXISTS_DEL_CONVÖ,‘ê¨15Ž¡‘êñëÜEXISTS_EQN_CONVÖ,‘ê¨16Ž¡‘êñëÜEXPAND_ALL_BUT_CONVÖ,‘ê¨16Ž¡‘êñëÜEXPAND_ALL_BUT_RIGHT_RULEÖ,‘ê¨18Ž¡‘êñëÜEXPAND_AUTO_CONVÖ,‘ê¨19Ž¡‘êñëÜEXPAND_AUTO_RIGHT_RULEÖ,‘ê¨20Ž¦‘êñëÜFLATTEN_CONJ_CONVÖ,‘ê¨21Ž¡‘êñëÜFORALL_CONJ_CONVÖ,‘ê¨22Ž¡‘êñëÜFORALL_CONJ_ONCE_CONVÖ,‘ê¨23Ž¡‘êñëÜFORALL_CONJ_RIGHT_RULEÖ,‘ê¨24Ž¦‘êñëhelpŽ¡‘þñëupSŽdating–ê¨searc¬rh“path,“1Ž¦‘êñëÜline_nameÖ,‘ê¨25Ž¡‘êñëÜline_varÖ,‘ê¨25Ž¡‘êñëÜload_libraryÖ,‘ê¨1Ž¦‘êñëÜPRUNE_CONVÖ,‘ê¨25Ž¡‘êñëÜPRUNE_ONCE_CONVÖ,‘ê¨26Ž¡‘êñëÜPRUNE_ONE_CONVÖ,‘ê¨27Ž¡‘êñëÜPRUNE_RIGHT_RULEÖ,‘ê¨28Ž¡‘êñëÜPRUNE_SOME_CONVÖ,‘ê¨29Ž¡‘êñëÜPRUNE_SOME_RIGHT_RULEÖ,‘ê¨30Ž¦‘êñëÜUNFOLD_CONVÖ,‘ê¨32ŽŽŽ þä’à)ÜUNFOLD_RIGHT_RULEÖ,‘ê¨32Ž¤’à)ÜUNWIND_ALL_BUT_CONVÖ,‘ê¨33Ž¡’à)ÜUNWIND_ALL_BUT_RIGHT_RULEÖ,‘ê¨34Ž¡’à)ÜUNWIND_AUTO_CONVÖ,‘ê¨35Ž¡’à)ÜUNWIND_AUTO_RIGHT_RULEÖ,‘ê¨36Ž¡’à)ÜUNWIND_CONVÖ,‘ê¨37Ž¡’à)ÜUNWIND_ONCE_CONVÖ,‘ê¨38ŽŽŽŽŽŽŸ$ý’ÇÑ)Û42ŽŽŒø!ƒ’À;èÌUÚÝ .óIßê index.tex @echo "\mbox{}" >> index.tex @echo "\end{theindex}" >> index.tex tex: ids @echo "TeX files made" ids: @echo "\chapter{ML Functions in the unwind Library}">entries.tex @echo "\input{entries-intro}" >> entries.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex index: ${MAKEINDEX} unwind.idx index.tex unwind: latex unwind.tex all: make clean; make tex; make unwind; make index; make unwind hol88-2.02.19940316/Library/unwind/Manual/entries-intro.tex0000640000212700021270000000032205072042367021377 0ustar cammcammThis chapter provides documentation on all the \ML\ functions that are made available in \HOL\ when the \ml{unwind} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/unwind/Manual/entries.tex0000640000212700021270000012613305535606374020267 0ustar cammcamm\chapter{ML Functions in the unwind Library} \input{entries-intro} \DOC{CONJ\_FORALL\_CONV} \TYPE {\small\verb%CONJ_FORALL_CONV : conv%}\egroup \SYNOPSIS Moves universal quantifiers up through a tree of conjunctions. \DESCRIBE {\small\verb%CONJ_FORALL_CONV "(!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn)"%} returns the following theorem: {\par\samepage\setseps\small \begin{verbatim} |- (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) = !x1 ... xm. t1 /\ ... /\ tn \end{verbatim} } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Never fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #CONJ_FORALL_CONV "((!(x:*) (y:*) (z:*). a) /\ (!(x:*) (y:*) (z:*). b)) /\ # (!(x:*) (y:*) (z:*). c)";; |- ((!x y z. a) /\ (!x y z. b)) /\ (!x y z. c) = (!x y z. (a /\ b) /\ c) #CONJ_FORALL_CONV "T";; |- T = T #CONJ_FORALL_CONV "((!(x:*) (y:*) (z:*). a) /\ (!(x:*) (w:*) (z:*). b)) /\ # (!(x:*) (y:*) (z:*). c)";; |- ((!x y z. a) /\ (!x w z. b)) /\ (!x y z. c) = (!x. ((!y z. a) /\ (!w z. b)) /\ (!y z. c)) \end{verbatim} } \SEEALSO FORALL_CONJ_CONV, CONJ_FORALL_ONCE_CONV, FORALL_CONJ_ONCE_CONV, CONJ_FORALL_RIGHT_RULE, FORALL_CONJ_RIGHT_RULE. \ENDDOC \DOC{CONJ\_FORALL\_ONCE\_CONV} \TYPE {\small\verb%CONJ_FORALL_ONCE_CONV : conv%}\egroup \SYNOPSIS Moves a single universal quantifier up through a tree of conjunctions. \DESCRIBE {\small\verb%CONJ_FORALL_ONCE_CONV "(!x. t1) /\ ... /\ (!x. tn)"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (!x. t1) /\ ... /\ (!x. tn) = !x. t1 /\ ... /\ tn \end{verbatim} } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Fails if the argument term is not of the required form. The term need not be a conjunction, but if it is every conjunct must be universally quantified with the same variable. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #CONJ_FORALL_ONCE_CONV "((!x. x \/ a) /\ (!x. x \/ b)) /\ (!x. x \/ c)";; |- ((!x. x \/ a) /\ (!x. x \/ b)) /\ (!x. x \/ c) = (!x. ((x \/ a) /\ (x \/ b)) /\ (x \/ c)) #CONJ_FORALL_ONCE_CONV "!x. x \/ a";; |- (!x. x \/ a) = (!x. x \/ a) #CONJ_FORALL_ONCE_CONV "((!x. x \/ a) /\ (!y. y \/ b)) /\ (!x. x \/ c)";; evaluation failed CONJ_FORALL_ONCE_CONV \end{verbatim} } \SEEALSO FORALL_CONJ_ONCE_CONV, CONJ_FORALL_CONV, FORALL_CONJ_CONV, CONJ_FORALL_RIGHT_RULE, FORALL_CONJ_RIGHT_RULE. \ENDDOC \DOC{CONJ\_FORALL\_RIGHT\_RULE} \TYPE {\small\verb%CONJ_FORALL_RIGHT_RULE : (thm -> thm)%}\egroup \SYNOPSIS Moves universal quantifiers up through a tree of conjunctions. \DESCRIBE {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?y1 ... yp. (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) ------------------------------------------------------------------- A |- !z1 ... zr. t = ?y1 ... yp. !x1 ... xm. t1 /\ ... /\ tn \end{verbatim} } \FAILURE Fails if the argument theorem is not of the required form, though either or both of {\small\verb%r%} and {\small\verb%p%} may be zero. \SEEALSO FORALL_CONJ_RIGHT_RULE, CONJ_FORALL_CONV, FORALL_CONJ_CONV, CONJ_FORALL_ONCE_CONV, FORALL_CONJ_ONCE_CONV. \ENDDOC \DOC{DEPTH\_EXISTS\_CONV} \TYPE {\small\verb%DEPTH_EXISTS_CONV : (conv -> conv)%}\egroup \SYNOPSIS Applies a conversion to the body of nested existential quantifications. \DESCRIBE {\small\verb%DEPTH_EXISTS_CONV conv "?x1 ... xn. body"%} applies {\small\verb%conv%} to {\small\verb%"body"%} and returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (?x1 ... xn. body) = (?x1 ... xn. body') \end{verbatim} } \FAILURE Fails if the application of {\small\verb%conv%} fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #DEPTH_EXISTS_CONV BETA_CONV "?x y z. (\w. x /\ y /\ z /\ w) T";; |- (?x y z. (\w. x /\ y /\ z /\ w)T) = (?x y z. x /\ y /\ z /\ T) \end{verbatim} } \SEEALSO DEPTH_FORALL_CONV. \ENDDOC \DOC{DEPTH\_FORALL\_CONV} \TYPE {\small\verb%DEPTH_FORALL_CONV : (conv -> conv)%}\egroup \SYNOPSIS Applies a conversion to the body of nested universal quantifications. \DESCRIBE {\small\verb%DEPTH_FORALL_CONV conv "!x1 ... xn. body"%} applies {\small\verb%conv%} to {\small\verb%"body"%} and returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (!x1 ... xn. body) = (!x1 ... xn. body') \end{verbatim} } \FAILURE Fails if the application of {\small\verb%conv%} fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #DEPTH_FORALL_CONV BETA_CONV "!x y z. (\w. x /\ y /\ z /\ w) T";; |- (!x y z. (\w. x /\ y /\ z /\ w)T) = (!x y z. x /\ y /\ z /\ T) \end{verbatim} } \SEEALSO DEPTH_EXISTS_CONV. \ENDDOC \DOC{EXISTS\_DEL1\_CONV} \TYPE {\small\verb%EXISTS_DEL1_CONV : conv%}\egroup \SYNOPSIS Deletes one existential quantifier. \DESCRIBE {\small\verb%EXISTS_DEL1_CONV "?x. t"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (?x. t) = t \end{verbatim} } \noindent provided {\small\verb%x%} is not free in {\small\verb%t%}. \FAILURE Fails if the argument term is not an existential quantification or if {\small\verb%x%} is free in {\small\verb%t%}. \SEEALSO EXISTS_DEL_CONV, PRUNE_ONCE_CONV. \ENDDOC \DOC{EXISTS\_DEL\_CONV} \TYPE {\small\verb%EXISTS_DEL_CONV : conv%}\egroup \SYNOPSIS Deletes existential quantifiers. \DESCRIBE {\small\verb%EXISTS_DEL_CONV "?x1 ... xn. t"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (?x1 ... xn. t) = t \end{verbatim} } \noindent provided {\small\verb%x1,...,xn%} are not free in {\small\verb%t%}. \FAILURE Fails if any of the {\small\verb%x%}'s appear free in {\small\verb%t%}. The function does not perform a partial deletion; for example, if {\small\verb%x1%} and {\small\verb%x2%} do not appear free in {\small\verb%t%} but {\small\verb%x3%} does, the function will fail; it will not return: {\par\samepage\setseps\small \begin{verbatim} |- ?x1 ... xn. t = ?x3 ... xn. t \end{verbatim} } \SEEALSO EXISTS_DEL1_CONV, PRUNE_CONV. \ENDDOC \DOC{EXISTS\_EQN\_CONV} \TYPE {\small\verb%EXISTS_EQN_CONV : conv%}\egroup \SYNOPSIS Proves the existence of a line that has a non-recursive equation. \DESCRIBE {\small\verb%EXISTS_EQN_CONV "?l. !y1 ... ym. l x1 ... xn = t"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (?l. !y1 ... ym. l x1 ... xn = t) = T \end{verbatim} } \noindent provided {\small\verb%l%} is not free in {\small\verb%t%}. Both {\small\verb%m%} and {\small\verb%n%} may be zero. \FAILURE Fails if the argument term is not of the specified form or if {\small\verb%l%} appears free in {\small\verb%t%}. \SEEALSO PRUNE_ONCE_CONV. \ENDDOC \DOC{EXPAND\_ALL\_BUT\_CONV} \TYPE {\small\verb%EXPAND_ALL_BUT_CONV : (string list -> thm list -> conv)%}\egroup \SYNOPSIS Unfolds, then unwinds all lines (except those specified) as much as possible, then prunes the unwound lines. \DESCRIBE {\small\verb%EXPAND_ALL_BUT_CONV [`li(k+1)`;...;`lim`] thl%} when applied to the following term: {\par\samepage\setseps\small \begin{verbatim} "?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn" \end{verbatim} } \noindent returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} B |- (?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn) = (?li(k+1) ... lim. t1' /\ ... /\ tn') \end{verbatim} } \noindent where each {\small\verb%ti'%} is the result of rewriting {\small\verb%ti%} with the theorems in {\small\verb%thl%}. The set of assumptions {\small\verb%B%} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. Those conjuncts that after rewriting are equations for the lines {\small\verb%li1,...,lik%} (they are denoted by {\small\verb%ui1,...,uik%}) are used to unwind and the lines {\small\verb%li1,...,lik%} are then pruned. The {\small\verb%li%}'s are related by the equation: {\par\samepage\setseps\small \begin{verbatim} {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} \end{verbatim} } \FAILURE The function may fail if the argument term is not of the specified form. It will also fail if the unwound lines cannot be pruned. It is possible for the function to attempt unwinding indefinitely (to loop). \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #EXPAND_ALL_BUT_CONV [`l1`] # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # "?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = l2 (t-1) \/ out (t-1))";; . |- (?l1 l2. INV(l1,l2) /\ INV(l2,out) /\ (!t. l1 t = l2(t - 1) \/ out(t - 1))) = (?l1. (!t. out t = ~~l1 t) /\ (!t. l1 t = ~l1(t - 1) \/ ~~l1(t - 1))) \end{verbatim} } \SEEALSO EXPAND_AUTO_CONV, EXPAND_ALL_BUT_RIGHT_RULE, EXPAND_AUTO_RIGHT_RULE, UNFOLD_CONV, UNWIND_ALL_BUT_CONV, PRUNE_SOME_CONV. \ENDDOC \DOC{EXPAND\_ALL\_BUT\_RIGHT\_RULE} \TYPE {\small\verb%EXPAND_ALL_BUT_RIGHT_RULE : (string list -> thm list -> thm -> thm)%}\egroup \SYNOPSIS Unfolds, then unwinds all lines (except those specified) as much as possible, then prunes the unwound lines. \DESCRIBE {\small\verb%EXPAND_ALL_BUT_RIGHT_RULE [`li(k+1)`;...;`lim`] thl%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn ------------------------------------------------------------------- B u A |- !z1 ... zr. t = ?li(k+1) ... lim. t1' /\ ... /\ tn' \end{verbatim} } \noindent where each {\small\verb%ti'%} is the result of rewriting {\small\verb%ti%} with the theorems in {\small\verb%thl%}. The set of assumptions {\small\verb%B%} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. Those conjuncts that after rewriting are equations for the lines {\small\verb%li1,...,lik%} (they are denoted by {\small\verb%ui1,...,uik%}) are used to unwind and the lines {\small\verb%li1,...,lik%} are then pruned. The {\small\verb%li%}'s are related by the equation: {\par\samepage\setseps\small \begin{verbatim} {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} \end{verbatim} } \FAILURE The function may fail if the argument theorem is not of the specified form. It will also fail if the unwound lines cannot be pruned. It is possible for the function to attempt unwinding indefinitely (to loop). \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #EXPAND_ALL_BUT_RIGHT_RULE [`l1`] # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # (ASSUME # "!(in:num->bool) out. # DEV(in,out) = # ?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = in t \/ out (t-1))");; .. |- !in out. DEV(in,out) = (?l1. (!t. out t = ~~l1 t) /\ (!t. l1 t = in t \/ ~~l1(t - 1))) \end{verbatim} } \SEEALSO EXPAND_AUTO_RIGHT_RULE, EXPAND_ALL_BUT_CONV, EXPAND_AUTO_CONV, UNFOLD_RIGHT_RULE, UNWIND_ALL_BUT_RIGHT_RULE, PRUNE_SOME_RIGHT_RULE. \ENDDOC \DOC{EXPAND\_AUTO\_CONV} \TYPE {\small\verb%EXPAND_AUTO_CONV : (thm list -> conv)%}\egroup \SYNOPSIS Unfolds, then unwinds as much as possible, then prunes the unwound lines. \DESCRIBE {\small\verb%EXPAND_AUTO_CONV thl%} when applied to the following term: {\par\samepage\setseps\small \begin{verbatim} "?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn" \end{verbatim} } \noindent returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} B |- (?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn) = (?li(k+1) ... lim. t1' /\ ... /\ tn') \end{verbatim} } \noindent where each {\small\verb%ti'%} is the result of rewriting {\small\verb%ti%} with the theorems in {\small\verb%thl%}. The set of assumptions {\small\verb%B%} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. After rewriting, the function decides which of the resulting terms to use for unwinding, by performing a loop analysis on the graph representing the dependencies of the lines. Suppose the function decides to unwind {\small\verb%li1,...,lik%} using the terms {\small\verb%ui1',...,uik'%} respectively. Then, after unwinding, the lines {\small\verb%li1,...,lik%} are pruned (provided they have been eliminated from the right-hand sides of the conjuncts that are equations, and from the whole of any other conjuncts) resulting in the elimination of {\small\verb%ui1',...,uik'%}. The {\small\verb%li%}'s are related by the equation: {\par\samepage\setseps\small \begin{verbatim} {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} \end{verbatim} } \noindent The loop analysis allows the term to be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE The function may fail if the argument term is not of the specified form. It also fails if there is more than one equation for any line variable. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #EXPAND_AUTO_CONV # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # "?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = l2 (t-1) \/ out (t-1))";; . |- (?l1 l2. INV(l1,l2) /\ INV(l2,out) /\ (!t. l1 t = l2(t - 1) \/ out(t - 1))) = (?l1. (!t. out t = ~~l1 t) /\ (!t. l1 t = ~l1(t - 1) \/ ~~l1(t - 1))) \end{verbatim} } \SEEALSO EXPAND_ALL_BUT_CONV, EXPAND_AUTO_RIGHT_RULE, EXPAND_ALL_BUT_RIGHT_RULE, UNFOLD_CONV, UNWIND_AUTO_CONV, PRUNE_SOME_CONV. \ENDDOC \DOC{EXPAND\_AUTO\_RIGHT\_RULE} \TYPE {\small\verb%EXPAND_AUTO_RIGHT_RULE : (thm list -> thm -> thm)%}\egroup \SYNOPSIS Unfolds, then unwinds as much as possible, then prunes the unwound lines. \DESCRIBE {\small\verb%EXPAND_AUTO_RIGHT_RULE thl%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn ------------------------------------------------------------------- B u A |- !z1 ... zr. t = ?li(k+1) ... lim. t1' /\ ... /\ tn' \end{verbatim} } \noindent where each {\small\verb%ti'%} is the result of rewriting {\small\verb%ti%} with the theorems in {\small\verb%thl%}. The set of assumptions {\small\verb%B%} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. After rewriting, the function decides which of the resulting terms to use for unwinding, by performing a loop analysis on the graph representing the dependencies of the lines. Suppose the function decides to unwind {\small\verb%li1,...,lik%} using the terms {\small\verb%ui1',...,uik'%} respectively. Then, after unwinding, the lines {\small\verb%li1,...,lik%} are pruned (provided they have been eliminated from the right-hand sides of the conjuncts that are equations, and from the whole of any other conjuncts) resulting in the elimination of {\small\verb%ui1',...,uik'%}. The {\small\verb%li%}'s are related by the equation: {\par\samepage\setseps\small \begin{verbatim} {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} \end{verbatim} } \noindent The loop analysis allows the term to be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE The function may fail if the argument theorem is not of the specified form. It also fails if there is more than one equation for any line variable. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #EXPAND_AUTO_RIGHT_RULE # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # (ASSUME # "!(in:num->bool) out. # DEV(in,out) = # ?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = in t \/ out (t-1))");; .. |- !in out. DEV(in,out) = (!t. out t = ~~(in t \/ out(t - 1))) \end{verbatim} } \SEEALSO EXPAND_ALL_BUT_RIGHT_RULE, EXPAND_AUTO_CONV, EXPAND_ALL_BUT_CONV, UNFOLD_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE, PRUNE_SOME_RIGHT_RULE. \ENDDOC \DOC{FLATTEN\_CONJ\_CONV} \TYPE {\small\verb%FLATTEN_CONJ_CONV : conv%}\egroup \SYNOPSIS Flattens a `tree' of conjunctions. \DESCRIBE {\small\verb%FLATTEN_CONJ_CONV "t1 /\ ... /\ tn"%} returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- t1 /\ ... /\ tn = u1 /\ ... /\ un \end{verbatim} } \noindent where the right-hand side of the equation is a flattened version of the left-hand side. \FAILURE Never fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #FLATTEN_CONJ_CONV "(a /\ (b /\ c)) /\ ((d /\ e) /\ f)";; |- (a /\ b /\ c) /\ (d /\ e) /\ f = a /\ b /\ c /\ d /\ e /\ f \end{verbatim} } \SEEALSO CONJUNCTS_CONV. \ENDDOC \DOC{FORALL\_CONJ\_CONV} \TYPE {\small\verb%FORALL_CONJ_CONV : conv%}\egroup \SYNOPSIS Moves universal quantifiers down through a tree of conjunctions. \DESCRIBE {\small\verb%FORALL_CONJ_CONV "!x1 ... xm. t1 /\ ... /\ tn"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- !x1 ... xm. t1 /\ ... /\ tn = (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) \end{verbatim} } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Never fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #FORALL_CONJ_CONV "!(x:*) (y:*) (z:*). (a /\ b) /\ c";; |- (!x y z. (a /\ b) /\ c) = ((!x y z. a) /\ (!x y z. b)) /\ (!x y z. c) #FORALL_CONJ_CONV "T";; |- T = T #FORALL_CONJ_CONV "!(x:*) (y:*) (z:*). T";; |- (!x y z. T) = (!x y z. T) \end{verbatim} } \SEEALSO CONJ_FORALL_CONV, FORALL_CONJ_ONCE_CONV, CONJ_FORALL_ONCE_CONV, FORALL_CONJ_RIGHT_RULE, CONJ_FORALL_RIGHT_RULE. \ENDDOC \DOC{FORALL\_CONJ\_ONCE\_CONV} \TYPE {\small\verb%FORALL_CONJ_ONCE_CONV : conv%}\egroup \SYNOPSIS Moves a single universal quantifier down through a tree of conjunctions. \DESCRIBE {\small\verb%FORALL_CONJ_ONCE_CONV "!x. t1 /\ ... /\ tn"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- !x. t1 /\ ... /\ tn = (!x. t1) /\ ... /\ (!x. tn) \end{verbatim} } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Fails if the argument term is not of the required form. The body of the term need not be a conjunction. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #FORALL_CONJ_ONCE_CONV "!x. ((x \/ a) /\ (x \/ b)) /\ (x \/ c)";; |- (!x. ((x \/ a) /\ (x \/ b)) /\ (x \/ c)) = ((!x. x \/ a) /\ (!x. x \/ b)) /\ (!x. x \/ c) #FORALL_CONJ_ONCE_CONV "!x. x \/ a";; |- (!x. x \/ a) = (!x. x \/ a) #FORALL_CONJ_ONCE_CONV "!x. ((x \/ a) /\ (y \/ b)) /\ (x \/ c)";; |- (!x. ((x \/ a) /\ (y \/ b)) /\ (x \/ c)) = ((!x. x \/ a) /\ (!x. y \/ b)) /\ (!x. x \/ c) \end{verbatim} } \SEEALSO CONJ_FORALL_ONCE_CONV, FORALL_CONJ_CONV, CONJ_FORALL_CONV, FORALL_CONJ_RIGHT_RULE, CONJ_FORALL_RIGHT_RULE. \ENDDOC \DOC{FORALL\_CONJ\_RIGHT\_RULE} \TYPE {\small\verb%FORALL_CONJ_RIGHT_RULE : (thm -> thm)%}\egroup \SYNOPSIS Moves universal quantifiers down through a tree of conjunctions. \DESCRIBE {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?y1 ... yp. !x1 ... xm. t1 /\ ... /\ tn ------------------------------------------------------------------- A |- !z1 ... zr. t = ?y1 ... yp. (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) \end{verbatim} } \FAILURE Fails if the argument theorem is not of the required form, though either or both of {\small\verb%r%} and {\small\verb%p%} may be zero. \SEEALSO CONJ_FORALL_RIGHT_RULE, FORALL_CONJ_CONV, CONJ_FORALL_CONV, FORALL_CONJ_ONCE_CONV, CONJ_FORALL_ONCE_CONV. \ENDDOC \DOC{line\_name} \TYPE {\small\verb%line_name : (term -> string)%}\egroup \SYNOPSIS Computes the line name of an equation. \DESCRIBE {\small\verb%line_name "!y1 ... ym. f x1 ... xn = t"%} returns the string {\small\verb%`f`%}. \FAILURE Fails if the argument term is not of the specified form. \SEEALSO line_var. \ENDDOC \DOC{line\_var} \TYPE {\small\verb%line_var : (term -> term)%}\egroup \SYNOPSIS Computes the line variable of an equation. \DESCRIBE {\small\verb%line_var "!y1 ... ym. f x1 ... xn = t"%} returns the variable {\small\verb%"f"%}. \FAILURE Fails if the argument term is not of the specified form. \SEEALSO line_name. \ENDDOC \DOC{PRUNE\_CONV} \TYPE {\small\verb%PRUNE_CONV : conv%}\egroup \SYNOPSIS Prunes all hidden variables. \DESCRIBE {\small\verb%PRUNE_CONV "?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp"%} returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp) = (t1 /\ ... /\ tp) \end{verbatim} } \noindent where each {\small\verb%eqni%} has the form {\small\verb%"!y1 ... ym. li x1 ... xn = b"%} and {\small\verb%li%} does not appear free in any of the other conjuncts or in {\small\verb%b%}. The conversion works if one or more of the {\small\verb%eqni%}'s are not present, that is if {\small\verb%li%} is not free in any of the conjuncts, but does not work if {\small\verb%li%} appears free in more than one of the conjuncts. {\small\verb%p%} may be zero, that is, all the conjuncts may be {\small\verb%eqni%}'s. In this case the result will be simply {\small\verb%T%} (true). Also, for each {\small\verb%eqni%}, {\small\verb%m%} and {\small\verb%n%} may be zero. \FAILURE Fails if the argument term is not of the specified form or if any of the {\small\verb%li%}'s are free in more than one of the conjuncts or if the equation for any {\small\verb%li%} is recursive. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRUNE_CONV # "?l2 l1. # (!(x:num). l1 x = F) /\ (!x. l2 x = ~(out x)) /\ (!(x:num). out x = T)";; |- (?l2 l1. (!x. l1 x = F) /\ (!x. l2 x = ~out x) /\ (!x. out x = T)) = (!x. out x = T) \end{verbatim} } \SEEALSO PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC \DOC{PRUNE\_ONCE\_CONV} \TYPE {\small\verb%PRUNE_ONCE_CONV : conv%}\egroup \SYNOPSIS Prunes one hidden variable. \DESCRIBE {\small\verb%PRUNE_ONCE_CONV "?l. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp"%} returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (?l. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp) = (t1 /\ ... /\ ti /\ t(i+1) /\ ... /\ tp) \end{verbatim} } \noindent where {\small\verb%eq%} has the form {\small\verb%"!y1 ... ym. l x1 ... xn = b"%} and {\small\verb%l%} does not appear free in the {\small\verb%ti%}'s or in {\small\verb%b%}. The conversion works if {\small\verb%eq%} is not present, that is if {\small\verb%l%} is not free in any of the conjuncts, but does not work if {\small\verb%l%} appears free in more than one of the conjuncts. Each of {\small\verb%m%}, {\small\verb%n%} and {\small\verb%p%} may be zero. \FAILURE Fails if the argument term is not of the specified form or if {\small\verb%l%} is free in more than one of the conjuncts or if the equation for {\small\verb%l%} is recursive. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRUNE_ONCE_CONV "?l2. (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l1 x))";; |- (?l2. (!x. l1 x = F) /\ (!x. l2 x = ~l1 x)) = (!x. l1 x = F) \end{verbatim} } \SEEALSO PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC \DOC{PRUNE\_ONE\_CONV} \TYPE {\small\verb%PRUNE_ONE_CONV : (string -> conv)%}\egroup \SYNOPSIS Prunes a specified hidden variable. \DESCRIBE {\small\verb%PRUNE_ONE_CONV `lj`%} when applied to the term: {\par\samepage\setseps\small \begin{verbatim} "?l1 ... lj ... lr. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp" \end{verbatim} } \noindent returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (?l1 ... lj ... lr. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp) = (?l1 ... l(j-1) l(j+1) ... lr. t1 /\ ... /\ ti /\ t(i+1) /\ ... /\ tp) \end{verbatim} } \noindent where {\small\verb%eq%} has the form {\small\verb%"!y1 ... ym. lj x1 ... xn = b"%} and {\small\verb%lj%} does not appear free in the {\small\verb%ti%}'s or in {\small\verb%b%}. The conversion works if {\small\verb%eq%} is not present, that is if {\small\verb%lj%} is not free in any of the conjuncts, but does not work if {\small\verb%lj%} appears free in more than one of the conjuncts. Each of {\small\verb%m%}, {\small\verb%n%} and {\small\verb%p%} may be zero. If there is more than one line with the specified name (but with different types), the one that appears outermost in the existential quantifications is pruned. \FAILURE Fails if the argument term is not of the specified form or if {\small\verb%lj%} is free in more than one of the conjuncts or if the equation for {\small\verb%lj%} is recursive. The function also fails if the specified line is not one of the existentially quantified lines. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRUNE_ONE_CONV `l2` "?l2 l1. (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l1 x))";; |- (?l2 l1. (!x. l1 x = F) /\ (!x. l2 x = ~l1 x)) = (?l1. !x. l1 x = F) #PRUNE_ONE_CONV `l1` "?l2 l1. (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l1 x))";; evaluation failed PRUNE_ONE_CONV \end{verbatim} } \SEEALSO PRUNE_ONCE_CONV, PRUNE_SOME_CONV, PRUNE_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC \DOC{PRUNE\_RIGHT\_RULE} \TYPE {\small\verb%PRUNE_RIGHT_RULE : (thm -> thm)%}\egroup \SYNOPSIS Prunes all hidden variables. \DESCRIBE {\small\verb%PRUNE_RIGHT_RULE%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp --------------------------------------------------------------------- A |- !z1 ... zr. t = t1 /\ ... /\ tp \end{verbatim} } \noindent where each {\small\verb%eqni%} has the form {\small\verb%"!y1 ... ym. li x1 ... xn = b"%} and {\small\verb%li%} does not appear free in any of the other conjuncts or in {\small\verb%b%}. The rule works if one or more of the {\small\verb%eqni%}'s are not present, that is if {\small\verb%li%} is not free in any of the conjuncts, but does not work if {\small\verb%li%} appears free in more than one of the conjuncts. {\small\verb%p%} may be zero, that is, all the conjuncts may be {\small\verb%eqni%}'s. In this case the result will be simply {\small\verb%T%} (true). Also, for each {\small\verb%eqni%}, {\small\verb%m%} and {\small\verb%n%} may be zero. \FAILURE Fails if the argument theorem is not of the specified form or if any of the {\small\verb%li%}'s are free in more than one of the conjuncts or if the equation for any {\small\verb%li%} is recursive. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRUNE_RIGHT_RULE # (ASSUME # "!(in:num->bool) (out:num->bool). # DEV (in,out) = # ?(l1:num->bool) l2. # (!x. l1 x = F) /\ (!x. l2 x = ~(in x)) /\ (!x. out x = ~(in x))");; . |- !in out. DEV(in,out) = (!x. out x = ~in x) \end{verbatim} } \SEEALSO PRUNE_SOME_RIGHT_RULE, PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_CONV. \ENDDOC \DOC{PRUNE\_SOME\_CONV} \TYPE {\small\verb%PRUNE_SOME_CONV : (string list -> conv)%}\egroup \SYNOPSIS Prunes several hidden variables. \DESCRIBE {\small\verb%PRUNE_SOME_CONV [`li1`;...;`lik`]%} when applied to the term: {\par\samepage\setseps\small \begin{verbatim} "?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp" \end{verbatim} } \noindent returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp) = (?li(k+1) ... lir. t1 /\ ... /\ tp) \end{verbatim} } \noindent where for {\small\verb%1 <= j <= k%}, each {\small\verb%eqnij%} has the form: {\par\samepage\setseps\small \begin{verbatim} "!y1 ... ym. lij x1 ... xn = b" \end{verbatim} } \noindent and {\small\verb%lij%} does not appear free in any of the other conjuncts or in {\small\verb%b%}. The {\small\verb%li%}'s are related by the equation: {\par\samepage\setseps\small \begin{verbatim} {li1,...,lik} u {li(k+1),...,lir} = {l1,...,lr} \end{verbatim} } \noindent The conversion works if one or more of the {\small\verb%eqnij%}'s are not present, that is if {\small\verb%lij%} is not free in any of the conjuncts, but does not work if {\small\verb%lij%} appears free in more than one of the conjuncts. {\small\verb%p%} may be zero, that is, all the conjuncts may be {\small\verb%eqnij%}'s. In this case the body of the result will be {\small\verb%T%} (true). Also, for each {\small\verb%eqnij%}, {\small\verb%m%} and {\small\verb%n%} may be zero. If there is more than one line with a specified name (but with different types), the one that appears outermost in the existential quantifications is pruned. If such a line name is mentioned twice in the list, the two outermost occurrences of lines with that name will be pruned, and so on. \FAILURE Fails if the argument term is not of the specified form or if any of the {\small\verb%lij%}'s are free in more than one of the conjuncts or if the equation for any {\small\verb%lij%} is recursive. The function also fails if any of the specified lines are not one of the existentially quantified lines. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRUNE_SOME_CONV [`l1`;`l2`] # "?l3 l2 l1. # (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l3 x)) /\ (!(x:num). l3 x = T)";; |- (?l3 l2 l1. (!x. l1 x = F) /\ (!x. l2 x = ~l3 x) /\ (!x. l3 x = T)) = (?l3. !x. l3 x = T) \end{verbatim} } \SEEALSO PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC \DOC{PRUNE\_SOME\_RIGHT\_RULE} \TYPE {\small\verb%PRUNE_SOME_RIGHT_RULE : (string list -> thm -> thm)%}\egroup \SYNOPSIS Prunes several hidden variables. \DESCRIBE {\small\verb%PRUNE_SOME_RIGHT_RULE [`li1`;...;`lik`]%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp ----------------------------------------------------------------------- A |- !z1 ... zr. t = ?li(k+1) ... lir. t1 /\ ... /\ tp \end{verbatim} } \noindent where for {\small\verb%1 <= j <= k%}, each {\small\verb%eqnij%} has the form: {\par\samepage\setseps\small \begin{verbatim} "!y1 ... ym. lij x1 ... xn = b" \end{verbatim} } \noindent and {\small\verb%lij%} does not appear free in any of the other conjuncts or in {\small\verb%b%}. The {\small\verb%li%}'s are related by the equation: {\par\samepage\setseps\small \begin{verbatim} {li1,...,lik} u {li(k+1),...,lir} = {l1,...,lr} \end{verbatim} } \noindent The rule works if one or more of the {\small\verb%eqnij%}'s are not present, that is if {\small\verb%lij%} is not free in any of the conjuncts, but does not work if {\small\verb%lij%} appears free in more than one of the conjuncts. {\small\verb%p%} may be zero, that is, all the conjuncts may be {\small\verb%eqnij%}'s. In this case the conjunction will be transformed to {\small\verb%T%} (true). Also, for each {\small\verb%eqnij%}, {\small\verb%m%} and {\small\verb%n%} may be zero. If there is more than one line with a specified name (but with different types), the one that appears outermost in the existential quantifications is pruned. If such a line name is mentioned twice in the list, the two outermost occurrences of lines with that name will be pruned, and so on. \FAILURE Fails if the argument theorem is not of the specified form or if any of the {\small\verb%lij%}'s are free in more than one of the conjuncts or if the equation for any {\small\verb%lij%} is recursive. The function also fails if any of the specified lines are not one of the existentially quantified lines. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRUNE_SOME_RIGHT_RULE [`l1`;`l2`] # (ASSUME # "!(in:num->bool) (out:num->bool). # DEV (in,out) = # ?(l1:num->bool) l2. # (!x. l1 x = F) /\ (!x. l2 x = ~(in x)) /\ (!x. out x = ~(in x))");; . |- !in out. DEV(in,out) = (!x. out x = ~in x) \end{verbatim} } \SEEALSO PRUNE_RIGHT_RULE, PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_CONV. \ENDDOC \DOC{UNFOLD\_CONV} \TYPE {\small\verb%UNFOLD_CONV : (thm list -> conv)%}\egroup \SYNOPSIS Expands sub-components of a hardware description using their definitions. \DESCRIBE {\small\verb%UNFOLD_CONV thl "t1 /\ ... /\ tn"%} returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} B |- t1 /\ ... /\ tn = t1' /\ ... /\ tn' \end{verbatim} } \noindent where each {\small\verb%ti'%} is the result of rewriting {\small\verb%ti%} with the theorems in {\small\verb%thl%}. The set of assumptions {\small\verb%B%} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a {\small\verb%ti%}, it is unchanged. \FAILURE Never fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNFOLD_CONV [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # "INV (l1,l2) /\ INV (l2,l3) /\ (!(t:num). l1 t = l2 (t-1) \/ l3 (t-1))";; . |- INV(l1,l2) /\ INV(l2,l3) /\ (!t. l1 t = l2(t - 1) \/ l3(t - 1)) = (!t. l2 t = ~l1 t) /\ (!t. l3 t = ~l2 t) /\ (!t. l1 t = l2(t - 1) \/ l3(t - 1)) \end{verbatim} } \SEEALSO UNFOLD_RIGHT_RULE. \ENDDOC \DOC{UNFOLD\_RIGHT\_RULE} \TYPE {\small\verb%UNFOLD_RIGHT_RULE : (thm list -> thm -> thm)%}\egroup \SYNOPSIS Expands sub-components of a hardware description using their definitions. \DESCRIBE {\small\verb%UNFOLD_RIGHT_RULE thl%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?y1 ... yp. t1 /\ ... /\ tn -------------------------------------------------------- B u A |- !z1 ... zr. t = ?y1 ... yp. t1' /\ ... /\ tn' \end{verbatim} } \noindent where each {\small\verb%ti'%} is the result of rewriting {\small\verb%ti%} with the theorems in {\small\verb%thl%}. The set of assumptions {\small\verb%B%} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a {\small\verb%ti%}, it is unchanged. \FAILURE Fails if the second argument is not of the required form, though either or both of {\small\verb%r%} and {\small\verb%p%} may be zero. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNFOLD_RIGHT_RULE [ASSUME "!in out. INV(in,out) = !(t:num). out t = ~(in t)"] # (ASSUME "!(in:num->bool) out. BUF(in,out) = ?l. INV(in,l) /\ INV(l,out)");; .. |- !in out. BUF(in,out) = (?l. (!t. l t = ~in t) /\ (!t. out t = ~l t)) \end{verbatim} } \SEEALSO UNFOLD_CONV. \ENDDOC \DOC{UNWIND\_ALL\_BUT\_CONV} \TYPE {\small\verb%UNWIND_ALL_BUT_CONV : (string list -> conv)%}\egroup \SYNOPSIS Unwinds all lines of a device (except those in the argument list) as much as possible. \DESCRIBE {\small\verb%UNWIND_ALL_BUT_CONV l%} when applied to the following term: {\par\samepage\setseps\small \begin{verbatim} "t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn" \end{verbatim} } \noindent returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn = t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn' \end{verbatim} } \noindent where {\small\verb%ti'%} (for {\small\verb%1 <= i <= n%}) is {\small\verb%ti%} rewritten with the equations {\small\verb%eqni%} ({\small\verb%1 <= i <= m%}). These equations are those conjuncts with line name not in {\small\verb%l%} (and which are equations). \FAILURE Never fails but may loop indefinitely. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNWIND_ALL_BUT_CONV [`l2`] # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + ((l2(x + 2)) - 1)) /\ (!x. l2 x = 7) \end{verbatim} } \SEEALSO UNWIND_ONCE_CONV, UNWIND_CONV, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC \DOC{UNWIND\_ALL\_BUT\_RIGHT\_RULE} \TYPE {\small\verb%UNWIND_ALL_BUT_RIGHT_RULE : (string list -> thm -> thm)%}\egroup \SYNOPSIS Unwinds all lines of a device (except those in the argument list) as much as possible. \DESCRIBE {\small\verb%UNWIND_ALL_BUT_RIGHT_RULE l%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = (?l1 ... lp. t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn) --------------------------------------------------------------------- A |- !z1 ... zr. t = (?l1 ... lp. t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn') \end{verbatim} } \noindent where {\small\verb%ti'%} (for {\small\verb%1 <= i <= n%}) is {\small\verb%ti%} rewritten with the equations {\small\verb%eqni%} ({\small\verb%1 <= i <= m%}). These equations are those conjuncts with line name not in {\small\verb%l%} (and which are equations). \FAILURE Fails if the argument theorem is not of the required form, though either or both of {\small\verb%p%} and {\small\verb%r%} may be zero. May loop indefinitely. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNWIND_ALL_BUT_RIGHT_RULE [`l2`] # (ASSUME # "!f. IMP(f) = # ?l2 l1. # (!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)");; . |- !f. IMP f = (?l2 l1. (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + ((l2(x + 2)) - 1)) /\ (!x. l2 x = 7)) \end{verbatim} } \SEEALSO UNWIND_AUTO_RIGHT_RULE, UNWIND_ALL_BUT_CONV, UNWIND_AUTO_CONV, UNWIND_ONCE_CONV, UNWIND_CONV. \ENDDOC \DOC{UNWIND\_AUTO\_CONV} \TYPE {\small\verb%UNWIND_AUTO_CONV : conv%}\egroup \SYNOPSIS Automatic unwinding of equations defining wire values in a standard device specification. \DESCRIBE {\small\verb%UNWIND_AUTO_CONV "?l1 ... lm. t1 /\ ... /\ tn"%} returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- (?l1 ... lm. t1 /\ ... /\ tn) = (?l1 ... lm. t1' /\ ... /\ tn') \end{verbatim} } \noindent where {\small\verb%tj'%} is {\small\verb%tj%} rewritten with equations selected from the {\small\verb%ti%}'s. The function decides which equations to use for rewriting by performing a loop analysis on the graph representing the dependencies of the lines. By this means the term can be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE Fails if there is more than one equation for any line variable. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNWIND_AUTO_CONV # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = 7 - 1) /\ (!x. f x = 7 + (7 - 1)) /\ (!x. l2 x = 7) \end{verbatim} } \SEEALSO UNWIND_ONCE_CONV, UNWIND_CONV, UNWIND_ALL_BUT_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC \DOC{UNWIND\_AUTO\_RIGHT\_RULE} \TYPE {\small\verb%UNWIND_AUTO_RIGHT_RULE : (thm -> thm)%}\egroup \SYNOPSIS Automatic unwinding of equations defining wire values in a standard device specification. \DESCRIBE {\small\verb%UNWIND_AUTO_RIGHT_RULE%} behaves as follows: {\par\samepage\setseps\small \begin{verbatim} A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ tn ---------------------------------------------------- A |- !z1 ... zr. t = ?l1 ... lm. t1' /\ ... /\ tn' \end{verbatim} } \noindent where {\small\verb%tj'%} is {\small\verb%tj%} rewritten with equations selected from the {\small\verb%ti%}'s. The function decides which equations to use for rewriting by performing a loop analysis on the graph representing the dependencies of the lines. By this means the term can be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE Fails if there is more than one equation for any line variable, or if the argument theorem is not of the required form, though either or both of {\small\verb%m%} and {\small\verb%r%} may be zero. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNWIND_AUTO_RIGHT_RULE # (ASSUME # "!f. IMP(f) = # ?l2 l1. # (!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)");; . |- !f. IMP f = (?l2 l1. (!x. l1 x = 7 - 1) /\ (!x. f x = 7 + (7 - 1)) /\ (!x. l2 x = 7)) \end{verbatim} } \SEEALSO UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_CONV, UNWIND_ONCE_CONV, UNWIND_CONV. \ENDDOC \DOC{UNWIND\_CONV} \TYPE {\small\verb%UNWIND_CONV : ((term -> bool) -> conv)%}\egroup \SYNOPSIS Unwinds device behaviour using selected line equations until no change. \DESCRIBE {\small\verb%UNWIND_CONV p "t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn"%} returns a theorem of the form: {\par\samepage\setseps\small \begin{verbatim} |- t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn = t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn' \end{verbatim} } \noindent where {\small\verb%ti'%} (for {\small\verb%1 <= i <= n%}) is {\small\verb%ti%} rewritten with the equations {\small\verb%eqni%} ({\small\verb%1 <= i <= m%}). These equations are the conjuncts for which the predicate {\small\verb%p%} is true. The {\small\verb%ti%} terms are the conjuncts for which {\small\verb%p%} is false. The rewriting is repeated until no changes take place. \FAILURE Never fails but may loop indefinitely. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNWIND_CONV (\tm. mem (line_name tm) [`l1`;`l2`]) # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = (l2 x) - 1) /\ (!x. f x = 7 + (7 - 1)) /\ (!x. l2 x = 7) \end{verbatim} } \SEEALSO UNWIND_ONCE_CONV, UNWIND_ALL_BUT_CONV, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC \DOC{UNWIND\_ONCE\_CONV} \TYPE {\small\verb%UNWIND_ONCE_CONV : ((term -> bool) -> conv)%}\egroup \SYNOPSIS Basic conversion for parallel unwinding of equations defining wire values in a standard device specification. \DESCRIBE {\small\verb%UNWIND_ONCE_CONV p tm%} unwinds the conjunction {\small\verb%tm%} using the equations selected by the predicate {\small\verb%p%}. {\small\verb%tm%} should be a conjunction, equivalent under associative-commutative reordering to: {\par\samepage\setseps\small \begin{verbatim} t1 /\ t2 /\ ... /\ tn \end{verbatim} } \noindent {\small\verb%p%} is used to partition the terms {\small\verb%ti%} for {\small\verb%1 <= i <= n%} into two disjoint sets: {\par\samepage\setseps\small \begin{verbatim} REW = {ti | p ti} OBJ = {ti | ~p ti} \end{verbatim} } \noindent The terms {\small\verb%ti%} for which {\small\verb%p%} is true are then used as a set of rewrite rules (thus they should be equations) to do a single top-down parallel rewrite of the remaining terms. The rewritten terms take the place of the original terms in the input conjunction. For example, if {\small\verb%tm%} is: {\par\samepage\setseps\small \begin{verbatim} t1 /\ t2 /\ t3 /\ t4 \end{verbatim} } \noindent and {\small\verb%REW = {t1,t3}%} then the result is: {\par\samepage\setseps\small \begin{verbatim} |- t1 /\ t2 /\ t3 /\ t4 = t1 /\ t2' /\ t3 /\ t4' \end{verbatim} } \noindent where {\small\verb%ti'%} is {\small\verb%ti%} rewritten with the equations {\small\verb%REW%}. \FAILURE Never fails. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #UNWIND_ONCE_CONV (\tm. mem (line_name tm) [`l1`;`l2`]) # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = (l2 x) - 1) /\ (!x. f x = 7 + ((l2(x + 2)) - 1)) /\ (!x. l2 x = 7) \end{verbatim} } \SEEALSO UNWIND_CONV, UNWIND_ALL_BUT_CONV, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/Manual/index.tex0000640000212700021270000000271205535606431017713 0ustar cammcamm\begin{theindex} \item {\ptt CONJ\_FORALL\_CONV}, 11 \item {\ptt CONJ\_FORALL\_ONCE\_CONV}, 12 \item {\ptt CONJ\_FORALL\_RIGHT\_RULE}, 13 \indexspace \item {\ptt DEPTH\_EXISTS\_CONV}, 14 \item {\ptt DEPTH\_FORALL\_CONV}, 14 \indexspace \item {\ptt EXISTS\_DEL1\_CONV}, 15 \item {\ptt EXISTS\_DEL\_CONV}, 15 \item {\ptt EXISTS\_EQN\_CONV}, 16 \item {\ptt EXPAND\_ALL\_BUT\_CONV}, 16 \item {\ptt EXPAND\_ALL\_BUT\_RIGHT\_RULE}, 18 \item {\ptt EXPAND\_AUTO\_CONV}, 19 \item {\ptt EXPAND\_AUTO\_RIGHT\_RULE}, 20 \indexspace \item {\ptt FLATTEN\_CONJ\_CONV}, 21 \item {\ptt FORALL\_CONJ\_CONV}, 22 \item {\ptt FORALL\_CONJ\_ONCE\_CONV}, 23 \item {\ptt FORALL\_CONJ\_RIGHT\_RULE}, 24 \indexspace \item help \subitem updating search path, 1 \indexspace \item {\ptt line\_name}, 25 \item {\ptt line\_var}, 25 \item {\ptt load\_library}, 1 \indexspace \item {\ptt PRUNE\_CONV}, 25 \item {\ptt PRUNE\_ONCE\_CONV}, 26 \item {\ptt PRUNE\_ONE\_CONV}, 27 \item {\ptt PRUNE\_RIGHT\_RULE}, 28 \item {\ptt PRUNE\_SOME\_CONV}, 29 \item {\ptt PRUNE\_SOME\_RIGHT\_RULE}, 30 \indexspace \item {\ptt UNFOLD\_CONV}, 32 \item {\ptt UNFOLD\_RIGHT\_RULE}, 32 \item {\ptt UNWIND\_ALL\_BUT\_CONV}, 33 \item {\ptt UNWIND\_ALL\_BUT\_RIGHT\_RULE}, 34 \item {\ptt UNWIND\_AUTO\_CONV}, 35 \item {\ptt UNWIND\_AUTO\_RIGHT\_RULE}, 36 \item {\ptt UNWIND\_CONV}, 37 \item {\ptt UNWIND\_ONCE\_CONV}, 38 \end{theindex} hol88-2.02.19940316/Library/unwind/Manual/references.tex0000640000212700021270000000114505072042371020715 0ustar cammcamm\begin{thebibliography}{99} \bibitem{HVusingHOL} A.~Camilleri, M.~Gordon, and T.~Melham. \newblock Hardware verification using higher-order logic. \newblock In D.~Borrione, editor, {\em Proceedings of the {IFIP} {WG} 10.2 Working Conference: From {HDL} Descriptions to Guaranteed Correct Circuit Designs}, Grenoble, September 1986. North-Holland, Amsterdam (1987). \newblock Also: University of Cambridge Computer Laboratory, Technical Report 91, September 1986. \bibitem{description} % OK {\small DSTO} and {\small SRI} International, {\it The HOL System: DESCRIPTION}, (1991). \end{thebibliography} hol88-2.02.19940316/Library/unwind/Manual/title.tex0000640000212700021270000000366005072042373017723 0ustar cammcamm% ===================================================================== % % Standard titlepage for unwind library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL unwind Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf Documentation written by\\ \medskip \large\bf R.\ J.\ Boulton \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf August 1991 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ R.\ J.\ Boulton 1991 \end{center} \newpage hol88-2.02.19940316/Library/unwind/help/0000750000212700021270000000000005227250232015562 5ustar cammcammhol88-2.02.19940316/Library/unwind/help/entries/0000750000212700021270000000000005227266207017244 5ustar cammcammhol88-2.02.19940316/Library/unwind/help/entries/CONJ_FORALL_CONV.doc0000640000212700021270000000211505072361415022343 0ustar cammcamm\DOC CONJ_FORALL_CONV \TYPE {CONJ_FORALL_CONV : conv} \SYNOPSIS Moves universal quantifiers up through a tree of conjunctions. \LIBRARY unwind \DESCRIBE {CONJ_FORALL_CONV "(!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn)"} returns the following theorem: { |- (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) = !x1 ... xm. t1 /\ ... /\ tn } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Never fails. \EXAMPLE { #CONJ_FORALL_CONV "((!(x:*) (y:*) (z:*). a) /\ (!(x:*) (y:*) (z:*). b)) /\ # (!(x:*) (y:*) (z:*). c)";; |- ((!x y z. a) /\ (!x y z. b)) /\ (!x y z. c) = (!x y z. (a /\ b) /\ c) #CONJ_FORALL_CONV "T";; |- T = T #CONJ_FORALL_CONV "((!(x:*) (y:*) (z:*). a) /\ (!(x:*) (w:*) (z:*). b)) /\ # (!(x:*) (y:*) (z:*). c)";; |- ((!x y z. a) /\ (!x w z. b)) /\ (!x y z. c) = (!x. ((!y z. a) /\ (!w z. b)) /\ (!y z. c)) } \SEEALSO FORALL_CONJ_CONV, CONJ_FORALL_ONCE_CONV, FORALL_CONJ_ONCE_CONV, CONJ_FORALL_RIGHT_RULE, FORALL_CONJ_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/CONJ_FORALL_ONCE_CONV.doc0000640000212700021270000000216205072361415023151 0ustar cammcamm\DOC CONJ_FORALL_ONCE_CONV \TYPE {CONJ_FORALL_ONCE_CONV : conv} \SYNOPSIS Moves a single universal quantifier up through a tree of conjunctions. \LIBRARY unwind \DESCRIBE {CONJ_FORALL_ONCE_CONV "(!x. t1) /\ ... /\ (!x. tn)"} returns the theorem: { |- (!x. t1) /\ ... /\ (!x. tn) = !x. t1 /\ ... /\ tn } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Fails if the argument term is not of the required form. The term need not be a conjunction, but if it is every conjunct must be universally quantified with the same variable. \EXAMPLE { #CONJ_FORALL_ONCE_CONV "((!x. x \/ a) /\ (!x. x \/ b)) /\ (!x. x \/ c)";; |- ((!x. x \/ a) /\ (!x. x \/ b)) /\ (!x. x \/ c) = (!x. ((x \/ a) /\ (x \/ b)) /\ (x \/ c)) #CONJ_FORALL_ONCE_CONV "!x. x \/ a";; |- (!x. x \/ a) = (!x. x \/ a) #CONJ_FORALL_ONCE_CONV "((!x. x \/ a) /\ (!y. y \/ b)) /\ (!x. x \/ c)";; evaluation failed CONJ_FORALL_ONCE_CONV } \SEEALSO FORALL_CONJ_ONCE_CONV, CONJ_FORALL_CONV, FORALL_CONJ_CONV, CONJ_FORALL_RIGHT_RULE, FORALL_CONJ_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/CONJ_FORALL_RIGHT_RULE.doc0000640000212700021270000000121605072361415023303 0ustar cammcamm\DOC CONJ_FORALL_RIGHT_RULE \TYPE {CONJ_FORALL_RIGHT_RULE : (thm -> thm)} \SYNOPSIS Moves universal quantifiers up through a tree of conjunctions. \LIBRARY unwind \DESCRIBE { A |- !z1 ... zr. t = ?y1 ... yp. (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) ------------------------------------------------------------------- A |- !z1 ... zr. t = ?y1 ... yp. !x1 ... xm. t1 /\ ... /\ tn } \FAILURE Fails if the argument theorem is not of the required form, though either or both of {r} and {p} may be zero. \SEEALSO FORALL_CONJ_RIGHT_RULE, CONJ_FORALL_CONV, FORALL_CONJ_CONV, CONJ_FORALL_ONCE_CONV, FORALL_CONJ_ONCE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/DEPTH_EXISTS_CONV.doc0000640000212700021270000000107205072361415022517 0ustar cammcamm\DOC DEPTH_EXISTS_CONV \TYPE {DEPTH_EXISTS_CONV : (conv -> conv)} \SYNOPSIS Applies a conversion to the body of nested existential quantifications. \LIBRARY unwind \DESCRIBE {DEPTH_EXISTS_CONV conv "?x1 ... xn. body"} applies {conv} to {"body"} and returns a theorem of the form: { |- (?x1 ... xn. body) = (?x1 ... xn. body') } \FAILURE Fails if the application of {conv} fails. \EXAMPLE { #DEPTH_EXISTS_CONV BETA_CONV "?x y z. (\w. x /\ y /\ z /\ w) T";; |- (?x y z. (\w. x /\ y /\ z /\ w)T) = (?x y z. x /\ y /\ z /\ T) } \SEEALSO DEPTH_FORALL_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/DEPTH_FORALL_CONV.doc0000640000212700021270000000107005072361416022456 0ustar cammcamm\DOC DEPTH_FORALL_CONV \TYPE {DEPTH_FORALL_CONV : (conv -> conv)} \SYNOPSIS Applies a conversion to the body of nested universal quantifications. \LIBRARY unwind \DESCRIBE {DEPTH_FORALL_CONV conv "!x1 ... xn. body"} applies {conv} to {"body"} and returns a theorem of the form: { |- (!x1 ... xn. body) = (!x1 ... xn. body') } \FAILURE Fails if the application of {conv} fails. \EXAMPLE { #DEPTH_FORALL_CONV BETA_CONV "!x y z. (\w. x /\ y /\ z /\ w) T";; |- (!x y z. (\w. x /\ y /\ z /\ w)T) = (!x y z. x /\ y /\ z /\ T) } \SEEALSO DEPTH_EXISTS_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXISTS_DEL1_CONV.doc0000640000212700021270000000061405072361416022342 0ustar cammcamm\DOC EXISTS_DEL1_CONV \TYPE {EXISTS_DEL1_CONV : conv} \SYNOPSIS Deletes one existential quantifier. \LIBRARY unwind \DESCRIBE {EXISTS_DEL1_CONV "?x. t"} returns the theorem: { |- (?x. t) = t } \noindent provided {x} is not free in {t}. \FAILURE Fails if the argument term is not an existential quantification or if {x} is free in {t}. \SEEALSO EXISTS_DEL_CONV, PRUNE_ONCE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXISTS_DEL_CONV.doc0000640000212700021270000000107305072361417022262 0ustar cammcamm\DOC EXISTS_DEL_CONV \TYPE {EXISTS_DEL_CONV : conv} \SYNOPSIS Deletes existential quantifiers. \LIBRARY unwind \DESCRIBE {EXISTS_DEL_CONV "?x1 ... xn. t"} returns the theorem: { |- (?x1 ... xn. t) = t } \noindent provided {x1,...,xn} are not free in {t}. \FAILURE Fails if any of the {x}'s appear free in {t}. The function does not perform a partial deletion; for example, if {x1} and {x2} do not appear free in {t} but {x3} does, the function will fail; it will not return: { |- ?x1 ... xn. t = ?x3 ... xn. t } \SEEALSO EXISTS_DEL1_CONV, PRUNE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXISTS_EQN_CONV.doc0000640000212700021270000000074505072361417022306 0ustar cammcamm\DOC EXISTS_EQN_CONV \TYPE {EXISTS_EQN_CONV : conv} \SYNOPSIS Proves the existence of a line that has a non-recursive equation. \LIBRARY unwind \DESCRIBE {EXISTS_EQN_CONV "?l. !y1 ... ym. l x1 ... xn = t"} returns the theorem: { |- (?l. !y1 ... ym. l x1 ... xn = t) = T } \noindent provided {l} is not free in {t}. Both {m} and {n} may be zero. \FAILURE Fails if the argument term is not of the specified form or if {l} appears free in {t}. \SEEALSO PRUNE_ONCE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXPAND_ALL_BUT_CONV.doc0000640000212700021270000000342705072361417022745 0ustar cammcamm\DOC EXPAND_ALL_BUT_CONV \TYPE {EXPAND_ALL_BUT_CONV : (string list -> thm list -> conv)} \SYNOPSIS Unfolds, then unwinds all lines (except those specified) as much as possible, then prunes the unwound lines. \LIBRARY unwind \DESCRIBE {EXPAND_ALL_BUT_CONV [`li(k+1)`;...;`lim`] thl} when applied to the following term: { "?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn" } \noindent returns a theorem of the form: { B |- (?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn) = (?li(k+1) ... lim. t1' /\ ... /\ tn') } \noindent where each {ti'} is the result of rewriting {ti} with the theorems in {thl}. The set of assumptions {B} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. Those conjuncts that after rewriting are equations for the lines {li1,...,lik} (they are denoted by {ui1,...,uik}) are used to unwind and the lines {li1,...,lik} are then pruned. The {li}'s are related by the equation: { {{li1,...,lik}} u {{li(k+1),...,lim}} = {{l1,...,lm}} } \FAILURE The function may fail if the argument term is not of the specified form. It will also fail if the unwound lines cannot be pruned. It is possible for the function to attempt unwinding indefinitely (to loop). \EXAMPLE { #EXPAND_ALL_BUT_CONV [`l1`] # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # "?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = l2 (t-1) \/ out (t-1))";; . |- (?l1 l2. INV(l1,l2) /\ INV(l2,out) /\ (!t. l1 t = l2(t - 1) \/ out(t - 1))) = (?l1. (!t. out t = ~~l1 t) /\ (!t. l1 t = ~l1(t - 1) \/ ~~l1(t - 1))) } \SEEALSO EXPAND_AUTO_CONV, EXPAND_ALL_BUT_RIGHT_RULE, EXPAND_AUTO_RIGHT_RULE, UNFOLD_CONV, UNWIND_ALL_BUT_CONV, PRUNE_SOME_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXPAND_ALL_BUT_RIGHT_RULE.doc0000640000212700021270000000347205072361417023704 0ustar cammcamm\DOC EXPAND_ALL_BUT_RIGHT_RULE \TYPE {EXPAND_ALL_BUT_RIGHT_RULE : (string list -> thm list -> thm -> thm)} \SYNOPSIS Unfolds, then unwinds all lines (except those specified) as much as possible, then prunes the unwound lines. \LIBRARY unwind \DESCRIBE {EXPAND_ALL_BUT_RIGHT_RULE [`li(k+1)`;...;`lim`] thl} behaves as follows: { A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn ------------------------------------------------------------------- B u A |- !z1 ... zr. t = ?li(k+1) ... lim. t1' /\ ... /\ tn' } \noindent where each {ti'} is the result of rewriting {ti} with the theorems in {thl}. The set of assumptions {B} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. Those conjuncts that after rewriting are equations for the lines {li1,...,lik} (they are denoted by {ui1,...,uik}) are used to unwind and the lines {li1,...,lik} are then pruned. The {li}'s are related by the equation: { {{li1,...,lik}} u {{li(k+1),...,lim}} = {{l1,...,lm}} } \FAILURE The function may fail if the argument theorem is not of the specified form. It will also fail if the unwound lines cannot be pruned. It is possible for the function to attempt unwinding indefinitely (to loop). \EXAMPLE { #EXPAND_ALL_BUT_RIGHT_RULE [`l1`] # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # (ASSUME # "!(in:num->bool) out. # DEV(in,out) = # ?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = in t \/ out (t-1))");; .. |- !in out. DEV(in,out) = (?l1. (!t. out t = ~~l1 t) /\ (!t. l1 t = in t \/ ~~l1(t - 1))) } \SEEALSO EXPAND_AUTO_RIGHT_RULE, EXPAND_ALL_BUT_CONV, EXPAND_AUTO_CONV, UNFOLD_RIGHT_RULE, UNWIND_ALL_BUT_RIGHT_RULE, PRUNE_SOME_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXPAND_AUTO_CONV.doc0000640000212700021270000000417205233246024022364 0ustar cammcamm\DOC EXPAND_AUTO_CONV \TYPE {EXPAND_AUTO_CONV : (thm list -> conv)} \SYNOPSIS Unfolds, then unwinds as much as possible, then prunes the unwound lines. \LIBRARY unwind \DESCRIBE {EXPAND_AUTO_CONV thl} when applied to the following term: { "?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn" } \noindent returns a theorem of the form: { B |- (?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn) = (?li(k+1) ... lim. t1' /\ ... /\ tn') } \noindent where each {ti'} is the result of rewriting {ti} with the theorems in {thl}. The set of assumptions {B} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. After rewriting, the function decides which of the resulting terms to use for unwinding, by performing a loop analysis on the graph representing the dependencies of the lines. Suppose the function decides to unwind {li1,...,lik} using the terms {ui1',...,uik'} respectively. Then, after unwinding, the lines {li1,...,lik} are pruned (provided they have been eliminated from the right-hand sides of the conjuncts that are equations, and from the whole of any other conjuncts) resulting in the elimination of {ui1',...,uik'}. The {li}'s are related by the equation: { {{li1,...,lik}} u {{li(k+1),...,lim}} = {{l1,...,lm}} } \noindent The loop analysis allows the term to be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE The function may fail if the argument term is not of the specified form. It also fails if there is more than one equation for any line variable. \EXAMPLE { #EXPAND_AUTO_CONV # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # "?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = l2 (t-1) \/ out (t-1))";; . |- (?l1 l2. INV(l1,l2) /\ INV(l2,out) /\ (!t. l1 t = l2(t - 1) \/ out(t - 1))) = (?l1. (!t. out t = ~~l1 t) /\ (!t. l1 t = ~l1(t - 1) \/ ~~l1(t - 1))) } \SEEALSO EXPAND_ALL_BUT_CONV, EXPAND_AUTO_RIGHT_RULE, EXPAND_ALL_BUT_RIGHT_RULE, UNFOLD_CONV, UNWIND_AUTO_CONV, PRUNE_SOME_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/EXPAND_AUTO_RIGHT_RULE.doc0000640000212700021270000000416305072361420023322 0ustar cammcamm\DOC EXPAND_AUTO_RIGHT_RULE \TYPE {EXPAND_AUTO_RIGHT_RULE : (thm list -> thm -> thm)} \SYNOPSIS Unfolds, then unwinds as much as possible, then prunes the unwound lines. \LIBRARY unwind \DESCRIBE {EXPAND_AUTO_RIGHT_RULE thl} behaves as follows: { A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn ------------------------------------------------------------------- B u A |- !z1 ... zr. t = ?li(k+1) ... lim. t1' /\ ... /\ tn' } \noindent where each {ti'} is the result of rewriting {ti} with the theorems in {thl}. The set of assumptions {B} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a conjunct, it is unchanged. After rewriting, the function decides which of the resulting terms to use for unwinding, by performing a loop analysis on the graph representing the dependencies of the lines. Suppose the function decides to unwind {li1,...,lik} using the terms {ui1',...,uik'} respectively. Then, after unwinding, the lines {li1,...,lik} are pruned (provided they have been eliminated from the right-hand sides of the conjuncts that are equations, and from the whole of any other conjuncts) resulting in the elimination of {ui1',...,uik'}. The {li}'s are related by the equation: { {{li1,...,lik}} u {{li(k+1),...,lim}} = {{l1,...,lm}} } \noindent The loop analysis allows the term to be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE The function may fail if the argument theorem is not of the specified form. It also fails if there is more than one equation for any line variable. \EXAMPLE { #EXPAND_AUTO_RIGHT_RULE # [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # (ASSUME # "!(in:num->bool) out. # DEV(in,out) = # ?l1 l2. # INV (l1,l2) /\ INV (l2,out) /\ (!(t:num). l1 t = in t \/ out (t-1))");; .. |- !in out. DEV(in,out) = (!t. out t = ~~(in t \/ out(t - 1))) } \SEEALSO EXPAND_ALL_BUT_RIGHT_RULE, EXPAND_AUTO_CONV, EXPAND_ALL_BUT_CONV, UNFOLD_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE, PRUNE_SOME_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/FLATTEN_CONJ_CONV.doc0000640000212700021270000000102605072361420022455 0ustar cammcamm\DOC FLATTEN_CONJ_CONV \TYPE {FLATTEN_CONJ_CONV : conv} \SYNOPSIS Flattens a `tree' of conjunctions. \LIBRARY unwind \DESCRIBE {FLATTEN_CONJ_CONV "t1 /\ ... /\ tn"} returns a theorem of the form: { |- t1 /\ ... /\ tn = u1 /\ ... /\ un } \noindent where the right-hand side of the equation is a flattened version of the left-hand side. \FAILURE Never fails. \EXAMPLE { #FLATTEN_CONJ_CONV "(a /\ (b /\ c)) /\ ((d /\ e) /\ f)";; |- (a /\ b /\ c) /\ (d /\ e) /\ f = a /\ b /\ c /\ d /\ e /\ f } \SEEALSO CONJUNCTS_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/FORALL_CONJ_CONV.doc0000640000212700021270000000154405072361420022344 0ustar cammcamm\DOC FORALL_CONJ_CONV \TYPE {FORALL_CONJ_CONV : conv} \SYNOPSIS Moves universal quantifiers down through a tree of conjunctions. \LIBRARY unwind \DESCRIBE {FORALL_CONJ_CONV "!x1 ... xm. t1 /\ ... /\ tn"} returns the theorem: { |- !x1 ... xm. t1 /\ ... /\ tn = (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Never fails. \EXAMPLE { #FORALL_CONJ_CONV "!(x:*) (y:*) (z:*). (a /\ b) /\ c";; |- (!x y z. (a /\ b) /\ c) = ((!x y z. a) /\ (!x y z. b)) /\ (!x y z. c) #FORALL_CONJ_CONV "T";; |- T = T #FORALL_CONJ_CONV "!(x:*) (y:*) (z:*). T";; |- (!x y z. T) = (!x y z. T) } \SEEALSO CONJ_FORALL_CONV, FORALL_CONJ_ONCE_CONV, CONJ_FORALL_ONCE_CONV, FORALL_CONJ_RIGHT_RULE, CONJ_FORALL_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/PRUNE_CONV.doc0000640000212700021270000000243205072361421021443 0ustar cammcamm\DOC PRUNE_CONV \TYPE {PRUNE_CONV : conv} \SYNOPSIS Prunes all hidden variables. \LIBRARY unwind \DESCRIBE {PRUNE_CONV "?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp"} returns a theorem of the form: { |- (?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp) = (t1 /\ ... /\ tp) } \noindent where each {eqni} has the form {"!y1 ... ym. li x1 ... xn = b"} and {li} does not appear free in any of the other conjuncts or in {b}. The conversion works if one or more of the {eqni}'s are not present, that is if {li} is not free in any of the conjuncts, but does not work if {li} appears free in more than one of the conjuncts. {p} may be zero, that is, all the conjuncts may be {eqni}'s. In this case the result will be simply {T} (true). Also, for each {eqni}, {m} and {n} may be zero. \FAILURE Fails if the argument term is not of the specified form or if any of the {li}'s are free in more than one of the conjuncts or if the equation for any {li} is recursive. \EXAMPLE { #PRUNE_CONV # "?l2 l1. # (!(x:num). l1 x = F) /\ (!x. l2 x = ~(out x)) /\ (!(x:num). out x = T)";; |- (?l2 l1. (!x. l1 x = F) /\ (!x. l2 x = ~out x) /\ (!x. out x = T)) = (!x. out x = T) } \SEEALSO PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/FORALL_CONJ_ONCE_CONV.doc0000640000212700021270000000211105072361420023137 0ustar cammcamm\DOC FORALL_CONJ_ONCE_CONV \TYPE {FORALL_CONJ_ONCE_CONV : conv} \SYNOPSIS Moves a single universal quantifier down through a tree of conjunctions. \LIBRARY unwind \DESCRIBE {FORALL_CONJ_ONCE_CONV "!x. t1 /\ ... /\ tn"} returns the theorem: { |- !x. t1 /\ ... /\ tn = (!x. t1) /\ ... /\ (!x. tn) } \noindent where the original term can be an arbitrary tree of conjunctions. The structure of the tree is retained in both sides of the equation. \FAILURE Fails if the argument term is not of the required form. The body of the term need not be a conjunction. \EXAMPLE { #FORALL_CONJ_ONCE_CONV "!x. ((x \/ a) /\ (x \/ b)) /\ (x \/ c)";; |- (!x. ((x \/ a) /\ (x \/ b)) /\ (x \/ c)) = ((!x. x \/ a) /\ (!x. x \/ b)) /\ (!x. x \/ c) #FORALL_CONJ_ONCE_CONV "!x. x \/ a";; |- (!x. x \/ a) = (!x. x \/ a) #FORALL_CONJ_ONCE_CONV "!x. ((x \/ a) /\ (y \/ b)) /\ (x \/ c)";; |- (!x. ((x \/ a) /\ (y \/ b)) /\ (x \/ c)) = ((!x. x \/ a) /\ (!x. y \/ b)) /\ (!x. x \/ c) } \SEEALSO CONJ_FORALL_ONCE_CONV, FORALL_CONJ_CONV, CONJ_FORALL_CONV, FORALL_CONJ_RIGHT_RULE, CONJ_FORALL_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/FORALL_CONJ_RIGHT_RULE.doc0000640000212700021270000000122005072361421023273 0ustar cammcamm\DOC FORALL_CONJ_RIGHT_RULE \TYPE {FORALL_CONJ_RIGHT_RULE : (thm -> thm)} \SYNOPSIS Moves universal quantifiers down through a tree of conjunctions. \LIBRARY unwind \DESCRIBE { A |- !z1 ... zr. t = ?y1 ... yp. !x1 ... xm. t1 /\ ... /\ tn ------------------------------------------------------------------- A |- !z1 ... zr. t = ?y1 ... yp. (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) } \FAILURE Fails if the argument theorem is not of the required form, though either or both of {r} and {p} may be zero. \SEEALSO CONJ_FORALL_RIGHT_RULE, FORALL_CONJ_CONV, CONJ_FORALL_CONV, FORALL_CONJ_ONCE_CONV, CONJ_FORALL_ONCE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/PRUNE_ONCE_CONV.doc0000640000212700021270000000205705072361421022252 0ustar cammcamm\DOC PRUNE_ONCE_CONV \TYPE {PRUNE_ONCE_CONV : conv} \SYNOPSIS Prunes one hidden variable. \LIBRARY unwind \DESCRIBE {PRUNE_ONCE_CONV "?l. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp"} returns a theorem of the form: { |- (?l. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp) = (t1 /\ ... /\ ti /\ t(i+1) /\ ... /\ tp) } \noindent where {eq} has the form {"!y1 ... ym. l x1 ... xn = b"} and {l} does not appear free in the {ti}'s or in {b}. The conversion works if {eq} is not present, that is if {l} is not free in any of the conjuncts, but does not work if {l} appears free in more than one of the conjuncts. Each of {m}, {n} and {p} may be zero. \FAILURE Fails if the argument term is not of the specified form or if {l} is free in more than one of the conjuncts or if the equation for {l} is recursive. \EXAMPLE { #PRUNE_ONCE_CONV "?l2. (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l1 x))";; |- (?l2. (!x. l1 x = F) /\ (!x. l2 x = ~l1 x)) = (!x. l1 x = F) } \SEEALSO PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/PRUNE_ONE_CONV.doc0000640000212700021270000000306705072361421022151 0ustar cammcamm\DOC PRUNE_ONE_CONV \TYPE {PRUNE_ONE_CONV : (string -> conv)} \SYNOPSIS Prunes a specified hidden variable. \LIBRARY unwind \DESCRIBE {PRUNE_ONE_CONV `lj`} when applied to the term: { "?l1 ... lj ... lr. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp" } \noindent returns a theorem of the form: { |- (?l1 ... lj ... lr. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp) = (?l1 ... l(j-1) l(j+1) ... lr. t1 /\ ... /\ ti /\ t(i+1) /\ ... /\ tp) } \noindent where {eq} has the form {"!y1 ... ym. lj x1 ... xn = b"} and {lj} does not appear free in the {ti}'s or in {b}. The conversion works if {eq} is not present, that is if {lj} is not free in any of the conjuncts, but does not work if {lj} appears free in more than one of the conjuncts. Each of {m}, {n} and {p} may be zero. If there is more than one line with the specified name (but with different types), the one that appears outermost in the existential quantifications is pruned. \FAILURE Fails if the argument term is not of the specified form or if {lj} is free in more than one of the conjuncts or if the equation for {lj} is recursive. The function also fails if the specified line is not one of the existentially quantified lines. \EXAMPLE { #PRUNE_ONE_CONV `l2` "?l2 l1. (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l1 x))";; |- (?l2 l1. (!x. l1 x = F) /\ (!x. l2 x = ~l1 x)) = (?l1. !x. l1 x = F) #PRUNE_ONE_CONV `l1` "?l2 l1. (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l1 x))";; evaluation failed PRUNE_ONE_CONV } \SEEALSO PRUNE_ONCE_CONV, PRUNE_SOME_CONV, PRUNE_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/PRUNE_RIGHT_RULE.doc0000640000212700021270000000262405072361421022405 0ustar cammcamm\DOC PRUNE_RIGHT_RULE \TYPE {PRUNE_RIGHT_RULE : (thm -> thm)} \SYNOPSIS Prunes all hidden variables. \LIBRARY unwind \DESCRIBE {PRUNE_RIGHT_RULE} behaves as follows: { A |- !z1 ... zr. t = ?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp --------------------------------------------------------------------- A |- !z1 ... zr. t = t1 /\ ... /\ tp } \noindent where each {eqni} has the form {"!y1 ... ym. li x1 ... xn = b"} and {li} does not appear free in any of the other conjuncts or in {b}. The rule works if one or more of the {eqni}'s are not present, that is if {li} is not free in any of the conjuncts, but does not work if {li} appears free in more than one of the conjuncts. {p} may be zero, that is, all the conjuncts may be {eqni}'s. In this case the result will be simply {T} (true). Also, for each {eqni}, {m} and {n} may be zero. \FAILURE Fails if the argument theorem is not of the specified form or if any of the {li}'s are free in more than one of the conjuncts or if the equation for any {li} is recursive. \EXAMPLE { #PRUNE_RIGHT_RULE # (ASSUME # "!(in:num->bool) (out:num->bool). # DEV (in,out) = # ?(l1:num->bool) l2. # (!x. l1 x = F) /\ (!x. l2 x = ~(in x)) /\ (!x. out x = ~(in x))");; . |- !in out. DEV(in,out) = (!x. out x = ~in x) } \SEEALSO PRUNE_SOME_RIGHT_RULE, PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/PRUNE_SOME_CONV.doc0000640000212700021270000000372105072361422022271 0ustar cammcamm\DOC PRUNE_SOME_CONV \TYPE {PRUNE_SOME_CONV : (string list -> conv)} \SYNOPSIS Prunes several hidden variables. \LIBRARY unwind \DESCRIBE {PRUNE_SOME_CONV [`li1`;...;`lik`]} when applied to the term: { "?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp" } \noindent returns a theorem of the form: { |- (?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp) = (?li(k+1) ... lir. t1 /\ ... /\ tp) } \noindent where for {1 <= j <= k}, each {eqnij} has the form: { "!y1 ... ym. lij x1 ... xn = b" } \noindent and {lij} does not appear free in any of the other conjuncts or in {b}. The {li}'s are related by the equation: { {{li1,...,lik}} u {{li(k+1),...,lir}} = {{l1,...,lr}} } \noindent The conversion works if one or more of the {eqnij}'s are not present, that is if {lij} is not free in any of the conjuncts, but does not work if {lij} appears free in more than one of the conjuncts. {p} may be zero, that is, all the conjuncts may be {eqnij}'s. In this case the body of the result will be {T} (true). Also, for each {eqnij}, {m} and {n} may be zero. If there is more than one line with a specified name (but with different types), the one that appears outermost in the existential quantifications is pruned. If such a line name is mentioned twice in the list, the two outermost occurrences of lines with that name will be pruned, and so on. \FAILURE Fails if the argument term is not of the specified form or if any of the {lij}'s are free in more than one of the conjuncts or if the equation for any {lij} is recursive. The function also fails if any of the specified lines are not one of the existentially quantified lines. \EXAMPLE { #PRUNE_SOME_CONV [`l1`;`l2`] # "?l3 l2 l1. # (!(x:num). l1 x = F) /\ (!x. l2 x = ~(l3 x)) /\ (!(x:num). l3 x = T)";; |- (?l3 l2 l1. (!x. l1 x = F) /\ (!x. l2 x = ~l3 x) /\ (!x. l3 x = T)) = (?l3. !x. l3 x = T) } \SEEALSO PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_CONV, PRUNE_SOME_RIGHT_RULE, PRUNE_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/PRUNE_SOME_RIGHT_RULE.doc0000640000212700021270000000403005072361422023222 0ustar cammcamm\DOC PRUNE_SOME_RIGHT_RULE \TYPE {PRUNE_SOME_RIGHT_RULE : (string list -> thm -> thm)} \SYNOPSIS Prunes several hidden variables. \LIBRARY unwind \DESCRIBE {PRUNE_SOME_RIGHT_RULE [`li1`;...;`lik`]} behaves as follows: { A |- !z1 ... zr. t = ?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp ----------------------------------------------------------------------- A |- !z1 ... zr. t = ?li(k+1) ... lir. t1 /\ ... /\ tp } \noindent where for {1 <= j <= k}, each {eqnij} has the form: { "!y1 ... ym. lij x1 ... xn = b" } \noindent and {lij} does not appear free in any of the other conjuncts or in {b}. The {li}'s are related by the equation: { {{li1,...,lik}} u {{li(k+1),...,lir}} = {{l1,...,lr}} } \noindent The rule works if one or more of the {eqnij}'s are not present, that is if {lij} is not free in any of the conjuncts, but does not work if {lij} appears free in more than one of the conjuncts. {p} may be zero, that is, all the conjuncts may be {eqnij}'s. In this case the conjunction will be transformed to {T} (true). Also, for each {eqnij}, {m} and {n} may be zero. If there is more than one line with a specified name (but with different types), the one that appears outermost in the existential quantifications is pruned. If such a line name is mentioned twice in the list, the two outermost occurrences of lines with that name will be pruned, and so on. \FAILURE Fails if the argument theorem is not of the specified form or if any of the {lij}'s are free in more than one of the conjuncts or if the equation for any {lij} is recursive. The function also fails if any of the specified lines are not one of the existentially quantified lines. \EXAMPLE { #PRUNE_SOME_RIGHT_RULE [`l1`;`l2`] # (ASSUME # "!(in:num->bool) (out:num->bool). # DEV (in,out) = # ?(l1:num->bool) l2. # (!x. l1 x = F) /\ (!x. l2 x = ~(in x)) /\ (!x. out x = ~(in x))");; . |- !in out. DEV(in,out) = (!x. out x = ~in x) } \SEEALSO PRUNE_RIGHT_RULE, PRUNE_ONCE_CONV, PRUNE_ONE_CONV, PRUNE_SOME_CONV, PRUNE_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNFOLD_CONV.doc0000640000212700021270000000165305072361422021546 0ustar cammcamm\DOC UNFOLD_CONV \TYPE {UNFOLD_CONV : (thm list -> conv)} \SYNOPSIS Expands sub-components of a hardware description using their definitions. \LIBRARY unwind \DESCRIBE {UNFOLD_CONV thl "t1 /\ ... /\ tn"} returns a theorem of the form: { B |- t1 /\ ... /\ tn = t1' /\ ... /\ tn' } \noindent where each {ti'} is the result of rewriting {ti} with the theorems in {thl}. The set of assumptions {B} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a {ti}, it is unchanged. \FAILURE Never fails. \EXAMPLE { #UNFOLD_CONV [ASSUME "!in out. INV (in,out) = !(t:num). out t = ~(in t)"] # "INV (l1,l2) /\ INV (l2,l3) /\ (!(t:num). l1 t = l2 (t-1) \/ l3 (t-1))";; . |- INV(l1,l2) /\ INV(l2,l3) /\ (!t. l1 t = l2(t - 1) \/ l3(t - 1)) = (!t. l2 t = ~l1 t) /\ (!t. l3 t = ~l2 t) /\ (!t. l1 t = l2(t - 1) \/ l3(t - 1)) } \SEEALSO UNFOLD_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNFOLD_RIGHT_RULE.doc0000640000212700021270000000206505072361422022503 0ustar cammcamm\DOC UNFOLD_RIGHT_RULE \TYPE {UNFOLD_RIGHT_RULE : (thm list -> thm -> thm)} \SYNOPSIS Expands sub-components of a hardware description using their definitions. \LIBRARY unwind \DESCRIBE {UNFOLD_RIGHT_RULE thl} behaves as follows: { A |- !z1 ... zr. t = ?y1 ... yp. t1 /\ ... /\ tn -------------------------------------------------------- B u A |- !z1 ... zr. t = ?y1 ... yp. t1' /\ ... /\ tn' } \noindent where each {ti'} is the result of rewriting {ti} with the theorems in {thl}. The set of assumptions {B} is the union of the instantiated assumptions of the theorems used for rewriting. If none of the rewrites are applicable to a {ti}, it is unchanged. \FAILURE Fails if the second argument is not of the required form, though either or both of {r} and {p} may be zero. \EXAMPLE { #UNFOLD_RIGHT_RULE [ASSUME "!in out. INV(in,out) = !(t:num). out t = ~(in t)"] # (ASSUME "!(in:num->bool) out. BUF(in,out) = ?l. INV(in,l) /\ INV(l,out)");; .. |- !in out. BUF(in,out) = (?l. (!t. l t = ~in t) /\ (!t. out t = ~l t)) } \SEEALSO UNFOLD_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNWIND_ALL_BUT_CONV.doc0000640000212700021270000000221505072361422022760 0ustar cammcamm\DOC UNWIND_ALL_BUT_CONV \TYPE {UNWIND_ALL_BUT_CONV : (string list -> conv)} \SYNOPSIS Unwinds all lines of a device (except those in the argument list) as much as possible. \LIBRARY unwind \DESCRIBE {UNWIND_ALL_BUT_CONV l} when applied to the following term: { "t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn" } \noindent returns a theorem of the form: { |- t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn = t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn' } \noindent where {ti'} (for {1 <= i <= n}) is {ti} rewritten with the equations {eqni} ({1 <= i <= m}). These equations are those conjuncts with line name not in {l} (and which are equations). \FAILURE Never fails but may loop indefinitely. \EXAMPLE { #UNWIND_ALL_BUT_CONV [`l2`] # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + ((l2(x + 2)) - 1)) /\ (!x. l2 x = 7) } \SEEALSO UNWIND_ONCE_CONV, UNWIND_CONV, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNWIND_ALL_BUT_RIGHT_RULE.doc0000640000212700021270000000252205072361423023721 0ustar cammcamm\DOC UNWIND_ALL_BUT_RIGHT_RULE \TYPE {UNWIND_ALL_BUT_RIGHT_RULE : (string list -> thm -> thm)} \SYNOPSIS Unwinds all lines of a device (except those in the argument list) as much as possible. \LIBRARY unwind \DESCRIBE {UNWIND_ALL_BUT_RIGHT_RULE l} behaves as follows: { A |- !z1 ... zr. t = (?l1 ... lp. t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn) --------------------------------------------------------------------- A |- !z1 ... zr. t = (?l1 ... lp. t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn') } \noindent where {ti'} (for {1 <= i <= n}) is {ti} rewritten with the equations {eqni} ({1 <= i <= m}). These equations are those conjuncts with line name not in {l} (and which are equations). \FAILURE Fails if the argument theorem is not of the required form, though either or both of {p} and {r} may be zero. May loop indefinitely. \EXAMPLE { #UNWIND_ALL_BUT_RIGHT_RULE [`l2`] # (ASSUME # "!f. IMP(f) = # ?l2 l1. # (!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)");; . |- !f. IMP f = (?l2 l1. (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + ((l2(x + 2)) - 1)) /\ (!x. l2 x = 7)) } \SEEALSO UNWIND_AUTO_RIGHT_RULE, UNWIND_ALL_BUT_CONV, UNWIND_AUTO_CONV, UNWIND_ONCE_CONV, UNWIND_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNWIND_AUTO_CONV.doc0000640000212700021270000000225205072361423022410 0ustar cammcamm\DOC UNWIND_AUTO_CONV \TYPE {UNWIND_AUTO_CONV : conv} \SYNOPSIS Automatic unwinding of equations defining wire values in a standard device specification. \LIBRARY unwind \DESCRIBE {UNWIND_AUTO_CONV "?l1 ... lm. t1 /\ ... /\ tn"} returns a theorem of the form: { |- (?l1 ... lm. t1 /\ ... /\ tn) = (?l1 ... lm. t1' /\ ... /\ tn') } \noindent where {tj'} is {tj} rewritten with equations selected from the {ti}'s. The function decides which equations to use for rewriting by performing a loop analysis on the graph representing the dependencies of the lines. By this means the term can be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE Fails if there is more than one equation for any line variable. \EXAMPLE { #UNWIND_AUTO_CONV # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = 7 - 1) /\ (!x. f x = 7 + (7 - 1)) /\ (!x. l2 x = 7) } \SEEALSO UNWIND_ONCE_CONV, UNWIND_CONV, UNWIND_ALL_BUT_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNWIND_AUTO_RIGHT_RULE.doc0000640000212700021270000000255105072361423023351 0ustar cammcamm\DOC UNWIND_AUTO_RIGHT_RULE \TYPE {UNWIND_AUTO_RIGHT_RULE : (thm -> thm)} \SYNOPSIS Automatic unwinding of equations defining wire values in a standard device specification. \LIBRARY unwind \DESCRIBE {UNWIND_AUTO_RIGHT_RULE} behaves as follows: { A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ tn ---------------------------------------------------- A |- !z1 ... zr. t = ?l1 ... lm. t1' /\ ... /\ tn' } \noindent where {tj'} is {tj} rewritten with equations selected from the {ti}'s. The function decides which equations to use for rewriting by performing a loop analysis on the graph representing the dependencies of the lines. By this means the term can be unwound as much as possible without the risk of looping. The user is left to deal with the recursive equations. \FAILURE Fails if there is more than one equation for any line variable, or if the argument theorem is not of the required form, though either or both of {m} and {r} may be zero. \EXAMPLE { #UNWIND_AUTO_RIGHT_RULE # (ASSUME # "!f. IMP(f) = # ?l2 l1. # (!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)");; . |- !f. IMP f = (?l2 l1. (!x. l1 x = 7 - 1) /\ (!x. f x = 7 + (7 - 1)) /\ (!x. l2 x = 7)) } \SEEALSO UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_CONV, UNWIND_ONCE_CONV, UNWIND_CONV. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNWIND_CONV.doc0000640000212700021270000000222705072361423021562 0ustar cammcamm\DOC UNWIND_CONV \TYPE {UNWIND_CONV : ((term -> bool) -> conv)} \SYNOPSIS Unwinds device behaviour using selected line equations until no change. \LIBRARY unwind \DESCRIBE {UNWIND_CONV p "t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn"} returns a theorem of the form: { |- t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn = t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn' } \noindent where {ti'} (for {1 <= i <= n}) is {ti} rewritten with the equations {eqni} ({1 <= i <= m}). These equations are the conjuncts for which the predicate {p} is true. The {ti} terms are the conjuncts for which {p} is false. The rewriting is repeated until no changes take place. \FAILURE Never fails but may loop indefinitely. \EXAMPLE { #UNWIND_CONV (\tm. mem (line_name tm) [`l1`;`l2`]) # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = (l2 x) - 1) /\ (!x. f x = 7 + (7 - 1)) /\ (!x. l2 x = 7) } \SEEALSO UNWIND_ONCE_CONV, UNWIND_ALL_BUT_CONV, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/UNWIND_ONCE_CONV.doc0000640000212700021270000000304705072361423022367 0ustar cammcamm\DOC UNWIND_ONCE_CONV \TYPE {UNWIND_ONCE_CONV : ((term -> bool) -> conv)} \SYNOPSIS Basic conversion for parallel unwinding of equations defining wire values in a standard device specification. \LIBRARY unwind \DESCRIBE {UNWIND_ONCE_CONV p tm} unwinds the conjunction {tm} using the equations selected by the predicate {p}. {tm} should be a conjunction, equivalent under associative-commutative reordering to: { t1 /\ t2 /\ ... /\ tn } \noindent {p} is used to partition the terms {ti} for {1 <= i <= n} into two disjoint sets: { REW = {{ti | p ti}} OBJ = {{ti | ~p ti}} } \noindent The terms {ti} for which {p} is true are then used as a set of rewrite rules (thus they should be equations) to do a single top-down parallel rewrite of the remaining terms. The rewritten terms take the place of the original terms in the input conjunction. For example, if {tm} is: { t1 /\ t2 /\ t3 /\ t4 } \noindent and {REW = {{t1,t3}}} then the result is: { |- t1 /\ t2 /\ t3 /\ t4 = t1 /\ t2' /\ t3 /\ t4' } \noindent where {ti'} is {ti} rewritten with the equations {REW}. \FAILURE Never fails. \EXAMPLE { #UNWIND_ONCE_CONV (\tm. mem (line_name tm) [`l1`;`l2`]) # "(!(x:num). l1 x = (l2 x) - 1) /\ # (!x. f x = (l2 (x+1)) + (l1 (x+2))) /\ # (!x. l2 x = 7)";; |- (!x. l1 x = (l2 x) - 1) /\ (!x. f x = (l2(x + 1)) + (l1(x + 2))) /\ (!x. l2 x = 7) = (!x. l1 x = (l2 x) - 1) /\ (!x. f x = 7 + ((l2(x + 2)) - 1)) /\ (!x. l2 x = 7) } \SEEALSO UNWIND_CONV, UNWIND_ALL_BUT_CONV, UNWIND_AUTO_CONV, UNWIND_ALL_BUT_RIGHT_RULE, UNWIND_AUTO_RIGHT_RULE. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/line_name.doc0000640000212700021270000000044705072361424021663 0ustar cammcamm\DOC line_name \TYPE {line_name : (term -> string)} \SYNOPSIS Computes the line name of an equation. \LIBRARY unwind \DESCRIBE {line_name "!y1 ... ym. f x1 ... xn = t"} returns the string {`f`}. \FAILURE Fails if the argument term is not of the specified form. \SEEALSO line_var. \ENDDOC hol88-2.02.19940316/Library/unwind/help/entries/line_var.doc0000640000212700021270000000045105072361424021526 0ustar cammcamm\DOC line_var \TYPE {line_var : (term -> term)} \SYNOPSIS Computes the line variable of an equation. \LIBRARY unwind \DESCRIBE {line_var "!y1 ... ym. f x1 ... xn = t"} returns the variable {"f"}. \FAILURE Fails if the argument term is not of the specified form. \SEEALSO line_name. \ENDDOC hol88-2.02.19940316/Library/unwind/Makefile0000640000212700021270000000300705071603546016302 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: unwind # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o *_ml.l @echo "===> library unwind: all object code deleted" clobber: rm -f *_ml.o *_ml.l @echo "===> library unwind: all object code deleted" # ===================================================================== # Entries for individual files. # ===================================================================== unwinding_ml.o: unwinding.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `unwinding`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: unwinding_ml.o @echo "===> library unwind rebuilt" hol88-2.02.19940316/Library/unwind/READ-ME0000640000212700021270000000212505071603546015577 0ustar cammcamm+ ===================================================================== + | | | LIBRARY : unwind | | | | DESCRIPTION : derived inference rules for expanding and simplifying | | hardware structural specifications. | | | + ===================================================================== + + --------------------------------------------------------------------- + | | | FILES: | | | + --------------------------------------------------------------------- + unwinding.ml definitions of derived rules + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clean" 3) type "make all" + --------------------------------------------------------------------- + | | | TO USE THE LIBRARY: | | | + --------------------------------------------------------------------- + Load unwind.ml hol88-2.02.19940316/Library/unwind/unwind.ml0000640000212700021270000000200005071603547016471 0ustar cammcamm% ===================================================================== % % FILE : unwind.ml % % DESCRIPTION : loads the library "unwind" into hol. % % % % AUTHOR : R.J.Boulton % % DATE : 3rd September 1991 % % ===================================================================== % % --------------------------------------------------------------------- % % Add the unwind help files to online help. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/unwind/help/entries/` in print_string `Updating help search path`; print_newline(); set_help_search_path (union [path] (help_search_path()));; % --------------------------------------------------------------------- % % Load the compiled code into ml. % % --------------------------------------------------------------------- % let path st = library_pathname() ^ `/unwind/` ^ st in load(path `unwinding`, get_flag_value `print_lib`);; hol88-2.02.19940316/Library/unwind/unwinding.ml0000640000212700021270000017262405233025660017205 0ustar cammcamm%****************************************************************************% % FILE : unwinding.ml % % DESCRIPTION : Rules for unfolding, unwinding, pruning, etc. % % % % READS FILES : % % WRITES FILES : % % % % AUTHOR : Originally written for LCF-LSM by Mike Gordon (MJCG). % % 21.May.1985 : Additions by Tom Melham (TFM). % % 10.Mar.1988 : Modifications by David Shepherd (DES) of INMOS. % % 24.Mar.1988 : Bug fixes by David Shepherd (DES). % % 23.Apr.1990 : Modifications by Tom Melham (TFM). % % 22.Aug.1991 : Additions and tidying-up by Richard Boulton (RJB). % % % % LAST MODIFIED : R.J.Boulton % % DATE : 21st July 1992 % %****************************************************************************% %============================================================================% % Tools for manipulating device implementations `by hand' % %============================================================================% %----------------------------------------------------------------------------% % DEPTH_FORALL_CONV : conv -> conv % % % % DEPTH_FORALL_CONV conv "!x1 ... xn. body" applies conv to "body" and % % returns a theorem of the form: % % % % |- (!x1 ... xn. body) = (!x1 ... xn. body') % %----------------------------------------------------------------------------% letrec DEPTH_FORALL_CONV conv tm = if (is_forall tm) then RAND_CONV (ABS_CONV (DEPTH_FORALL_CONV conv)) tm else conv tm;; %----------------------------------------------------------------------------% % DEPTH_EXISTS_CONV : conv -> conv % % % % DEPTH_EXISTS_CONV conv "?x1 ... xn. body" applies conv to "body" and % % returns a theorem of the form: % % % % |- (?x1 ... xn. body) = (?x1 ... xn. body') % %----------------------------------------------------------------------------% letrec DEPTH_EXISTS_CONV conv tm = if (is_exists tm) then RAND_CONV (ABS_CONV (DEPTH_EXISTS_CONV conv)) tm else conv tm;; %----------------------------------------------------------------------------% % FLATTEN_CONJ_CONV : conv % % % % "t1 /\ ... /\ tn" % % ----> % % |- t1 /\ ... /\ tn = u1 /\ ... /\ un % % % % where the RHS of the equation is a flattened version of the LHS. % %----------------------------------------------------------------------------% let FLATTEN_CONJ_CONV t = CONJUNCTS_CONV (t,list_mk_conj (conjuncts t));; %============================================================================% % Moving universal quantifiers in and out of conjunctions % %============================================================================% %----------------------------------------------------------------------------% % CONJ_FORALL_ONCE_CONV : conv % % % % "(!x. t1) /\ ... /\ (!x. tn)" % % ----> % % |- (!x. t1) /\ ... /\ (!x. tn) = !x. t1 /\ ... /\ tn % % % % where the original term can be an arbitrary tree of /\s, not just linear. % % The structure of the tree is retained in both sides of the equation. % % % % To avoid deriving incompatible theorems for IMP_ANTISYM_RULE when one or % % more of the ti's is a conjunction, the original term is broken up as well % % as the theorem. If this were not done, the conversion would fail in such % % cases. % %----------------------------------------------------------------------------% let CONJ_FORALL_ONCE_CONV t = letrec conj_tree_map f t th = (let t1,t2 = dest_conj t and th1,th2 = CONJ_PAIR th in CONJ (conj_tree_map f t1 th1) (conj_tree_map f t2 th2) ) ? (f th) in (let conjs = conjuncts t in if (length conjs = 1) then REFL t else let var = case (setify (map (fst o dest_forall) conjs)) of [x] . x | (_) . fail in let th = GEN var (conj_tree_map (SPEC var) t (ASSUME t)) in let th1 = DISCH t th and th2 = DISCH (concl th) (conj_tree_map (GEN var) t (SPEC var (ASSUME (concl th)))) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `CONJ_FORALL_ONCE_CONV`;; %----------------------------------------------------------------------------% % FORALL_CONJ_ONCE_CONV : conv % % % % "!x. t1 /\ ... /\ tn" % % ----> % % |- !x. t1 /\ ... /\ tn = (!x. t1) /\ ... /\ (!x. tn) % % % % where the original term can be an arbitrary tree of /\s, not just linear. % % The structure of the tree is retained in both sides of the equation. % %----------------------------------------------------------------------------% let FORALL_CONJ_ONCE_CONV t = letrec conj_tree_map f th = (let th1,th2 = CONJ_PAIR th in CONJ (conj_tree_map f th1) (conj_tree_map f th2) ) ? (f th) in (let var = fst (dest_forall t) in let th = conj_tree_map (GEN var) (SPEC var (ASSUME t)) in let th1 = DISCH t th and th2 = DISCH (concl th) (GEN var (conj_tree_map (SPEC var) (ASSUME (concl th)))) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `FORALL_CONJ_ONCE_CONV`;; %----------------------------------------------------------------------------% % CONJ_FORALL_CONV : conv % % % % "(!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn)" % % ----> % % |- (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) = % % !x1 ... xm. t1 /\ ... /\ tn % % % % where the original term can be an arbitrary tree of /\s, not just linear. % % The structure of the tree is retained in both sides of the equation. % %----------------------------------------------------------------------------% letrec CONJ_FORALL_CONV tm = (if (length (conjuncts tm) = 1) then fail else (CONJ_FORALL_ONCE_CONV THENC (RAND_CONV (ABS_CONV CONJ_FORALL_CONV))) tm ) ? REFL tm;; %----------------------------------------------------------------------------% % FORALL_CONJ_CONV : conv % % % % "!x1 ... xm. t1 /\ ... /\ tn" % % ----> % % |- !x1 ... xm. t1 /\ ... /\ tn = % % (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) % % % % where the original term can be an arbitrary tree of /\s, not just linear. % % The structure of the tree is retained in both sides of the equation. % %----------------------------------------------------------------------------% letrec FORALL_CONJ_CONV tm = if (is_forall tm) then (RAND_CONV (ABS_CONV FORALL_CONJ_CONV) THENC FORALL_CONJ_ONCE_CONV) tm else REFL tm;; %----------------------------------------------------------------------------% % CONJ_FORALL_RIGHT_RULE : thm -> thm % % % % A |- !z1 ... zr. % % t = ?y1 ... yp. (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) % % ------------------------------------------------------------------- % % A |- !z1 ... zr. t = ?y1 ... yp. !x1 ... xm. t1 /\ ... /\ tn % % % %----------------------------------------------------------------------------% let CONJ_FORALL_RIGHT_RULE th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (DEPTH_EXISTS_CONV CONJ_FORALL_CONV))) th ? failwith `CONJ_FORALL_RIGHT_RULE`;; %----------------------------------------------------------------------------% % FORALL_CONJ_RIGHT_RULE : thm -> thm % % % % A |- !z1 ... zr. t = ?y1 ... yp. !x1 ... xm. t1 /\ ... /\ tn % % ------------------------------------------------------------------- % % A |- !z1 ... zr. % % t = ?y1 ... yp. (!x1 ... xm. t1) /\ ... /\ (!x1 ... xm. tn) % % % %----------------------------------------------------------------------------% let FORALL_CONJ_RIGHT_RULE th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (DEPTH_EXISTS_CONV FORALL_CONJ_CONV))) th ? failwith `FORALL_CONJ_RIGHT_RULE`;; %============================================================================% % Rules for unfolding % %============================================================================% %----------------------------------------------------------------------------% % UNFOLD_CONV : thm list -> conv % % % % UNFOLD_CONV thl % % % % "t1 /\ ... /\ tn" % % ----> % % B |- t1 /\ ... /\ tn = t1' /\ ... /\ tn' % % % % where each ti' is the result of rewriting ti with the theorems in thl. The % % set of assumptions B is the union of the instantiated assumptions of the % % theorems used for rewriting. If none of the rewrites are applicable to a % % ti, it is unchanged. % %----------------------------------------------------------------------------% let UNFOLD_CONV thl = let net = mk_conv_net thl in let REWRITES_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm in let THENQC conv1 conv2 tm = (let th1 = conv1 tm in ((th1 TRANS (conv2 (rhs (concl th1)))) ? th1)) ? (conv2 tm) in letrec CONJ_TREE_CONV conv tm = if (is_conj tm) then THENQC (RATOR_CONV (RAND_CONV (CONJ_TREE_CONV conv))) (RAND_CONV (CONJ_TREE_CONV conv)) tm else conv tm in \t. if (null thl) then REFL t else CONJ_TREE_CONV (REWRITES_CONV net) t ? REFL t;; %----------------------------------------------------------------------------% % UNFOLD_RIGHT_RULE : thm list -> thm -> thm % % % % UNFOLD_RIGHT_RULE thl % % % % A |- !z1 ... zr. t = ?y1 ... yp. t1 /\ ... /\ tn % % -------------------------------------------------------- % % B u A |- !z1 ... zr. t = ?y1 ... yp. t1' /\ ... /\ tn' % % % % where each ti' is the result of rewriting ti with the theorems in thl. The % % set of assumptions B is the union of the instantiated assumptions of the % % theorems used for rewriting. If none of the rewrites are applicable to a % % ti, it is unchanged. % %----------------------------------------------------------------------------% let UNFOLD_RIGHT_RULE thl th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (DEPTH_EXISTS_CONV (UNFOLD_CONV thl)))) th ? failwith `UNFOLD_RIGHT_RULE`;; %============================================================================% % Rules for unwinding device implementations % %============================================================================% %----------------------------------------------------------------------------% % line_var : term -> term % % % % line_var "!y1 ... ym. f x1 ... xn = t" ----> "f" % %----------------------------------------------------------------------------% let line_var tm = (fst o strip_comb o lhs o snd o strip_forall) tm ? failwith `line_var`;; %----------------------------------------------------------------------------% % line_name : term -> string % % % % line_name "!y1 ... ym. f x1 ... xn = t" ----> `f` % %----------------------------------------------------------------------------% let line_name tm = (fst o dest_var o line_var) tm ? failwith `line_name`;; %----------------------------------------------------------------------------% % UNWIND_ONCE_CONV : (term -> bool) -> conv % % % % Basic conversion for parallel unwinding of equations defining wire values % % in a standard device specification. % % % % USAGE: UNWIND_ONCE_CONV p tm % % % % DESCRIPTION: tm should be a conjunction of terms, equivalent under % % associative-commutative reordering to: % % % % t1 /\ t2 /\ ... /\ tn. % % % % The function p:term->bool is a predicate which will be % % used to partition the terms ti for 1 <= i <= n into two % % disjoint sets: % % % % REW = {ti | p ti} and OBJ = {ti | ~p ti} % % % % The terms ti for which p is true are then used as a set % % of rewrite rules (thus they should be equations) to do a % % single top-down parallel rewrite of the remaining terms. % % The rewritten terms take the place of the original terms % % in the input conjunction. % % % % For example, if tm is: % % % % t1 /\ t2 /\ t3 /\ t4 % % % % and REW = {t1,t3} then the result is: % % % % |- t1 /\ t2 /\ t3 /\ t4 = t1 /\ t2' /\ t3 /\ t4' % % % % where ti' is ti rewritten with the equations REW. % % % % IMPLEMENTATION NOTE: % % % % The assignment: % % % % let pf,fn,eqns = trav p tm [] % % % % makes % % % % eqns = a list of theorems constructed by assuming each term for % % which p is true, i.e., eqns = the list of rewrites. % % % % fn = a function which, when applied to a rewriting conversion % % will reconstruct the original term in the original structure, % % but with the subterms for which p is not true rewritten % % using the supplied conversion. % % % % pf = a function which maps |- tm to [|- t1;...;|- tj] where each % % ti is a term for which p is true. % %----------------------------------------------------------------------------% let UNWIND_ONCE_CONV = let REWRITES_CONV net = \tm. FIRST_CONV (lookup_term net tm) tm in let AND = mk_const (`/\\`,":bool->bool->bool") in letrec trav p tm rl = (let (l,r) = dest_conj tm in let (pf2,fn2,pf1,fn1,rew) = (I # (I # trav p l)) (trav p r rl) in let pf = $@ o (pf1 # pf2) o CONJ_PAIR in (pf,(\rf. MK_COMB ((AP_TERM AND (fn1 rf)),(fn2 rf))),rew) ) ? if ((p tm) ? false) then ((\th.[th]),(\rf. REFL tm),(ASSUME tm . rl)) else ((\th.[]),(\rf. rf tm),rl) in (\p tm. let (pf,fn,eqns) = trav p tm [] in let rconv = ONCE_DEPTH_CONV (REWRITES_CONV (mk_conv_net eqns)) in let th = fn rconv in let l,r = (dest_eq (concl th)) in let lth = ASSUME l and rth = ASSUME r in let imp1 = DISCH l (EQ_MP (itlist PROVE_HYP (pf lth) th) lth) and imp2 = DISCH r (EQ_MP (SYM (itlist PROVE_HYP (pf rth) th)) rth) in IMP_ANTISYM_RULE imp1 imp2 ) ? failwith `UNWIND_ONCE_CONV`;; %----------------------------------------------------------------------------% % UNWIND_CONV : (term -> bool) -> conv % % % % Unwind device behaviour using line equations eqnx selected by p until no % % change. % % % % WARNING -- MAY LOOP! % % % % UNWIND_CONV p % % % % "t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn" % % ----> % % |- t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn = % % t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn' % % % % where ti' (for 1 <= i <= n) is ti rewritten with the equations % % eqni (1 <= i <= m). These equations are the conjuncts for which the % % predicate p is true. The ti terms are the conjuncts for which p is false. % % The rewriting is repeated until no changes take place. % %----------------------------------------------------------------------------% letrec UNWIND_CONV p tm = let th = UNWIND_ONCE_CONV p tm in if lhs (concl th) = rhs (concl th) then th else th TRANS (UNWIND_CONV p (rhs (concl th)));; %----------------------------------------------------------------------------% % UNWIND_ALL_BUT_CONV : string list -> conv % % % % Unwind all lines (except those in the list l) as much as possible. % % % % WARNING -- MAY LOOP! % % % % UNWIND_ALL_BUT_CONV l % % % % "t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn" % % ----> % % |- t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn = % % t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn' % % % % where ti' (for 1 <= i <= n) is ti rewritten with the equations % % eqni (1 <= i <= m). These equations are those conjuncts with line name not % % in l (and which are equations). % %----------------------------------------------------------------------------% let UNWIND_ALL_BUT_CONV l tm = (let line_names = subtract (mapfilter line_name (conjuncts tm)) l in let p line = \tm. (line_name tm) = line in let itfn line = \th. th TRANS (UNWIND_CONV (p line) (rhs (concl th))) in itlist itfn line_names (REFL tm) ) ? failwith `UNWIND_ALL_BUT_CONV`;; %----------------------------------------------------------------------------% % UNWIND_AUTO_CONV : conv % % % % "?l1 ... lm. t1 /\ ... /\ tn" % % ----> % % |- (?l1 ... lm. t1 /\ ... /\ tn) = (?l1 ... lm. t1' /\ ... /\ tn') % % % % where tj' is tj rewritten with equations selected from the ti's. The % % function decides which equations to use by performing a loop analysis on % % the graph representing the dependencies of the lines. By this means the % % term can be unwound as much as possible without the risk of looping. The % % user is left to deal with the recursive equations. % % % % There is some inefficiency in that certain lines may be used in unwinding % % even though they do not appear in any RHS's. % % % % The algorithms used for loop analysis in this function have exponential % % complexity in the number of lines. However, steps are taken to limit this % % as much as possible. The internal function `next_combination' computes % % combinations of a list, but only as they are required. This puts the % % burden on time resources rather than space resources. The computation time % % would be less if a complete list of combinations were computed in one go, % % but the list generated might exhaust memory. The first argument to % % `next_combination' is the list to find the combinations of. The second % % argument is the reverse of the previous combination. Initially this should % % be the empty list. The result of a call is the reverse of the next % % combination. The function assumes that the source list is a set. % % % % Amongst other things, the internal function `graph_of_term' rearranges the % % lines in the graph representation so that external lines come first. It is % % important that the number of internal lines left unwound because of loops % % is minimised since it is the internal lines that are existentially % % quantified. Further manipulations by the user should be easier if any % % loops remaining do not involve existentially quantified variables. % % % % The algorithm for breaking loops is: % % % % 1. Isolate any loops of length one. Each such loop involves only one line % % so must be broken at that line. % % % % 2. Eliminate from consideration the single element loops and any other % % loop that will be broken by the elements in those loops. % % % % 3. Determine those loops that consist entirely of internal lines. All % % other loops can be broken at an external line. A minimal set of % % internal lines that break all the exclusively internal loops is then % % computed. This may not be the only minimal set. % % % % 4. Any loop broken by the minimal set of internal lines is eliminated from % % consideration. A list of external lines appearing in these remaining % % loops is computed. From these external lines a minimal set that breaks % % all the remaining loops is computed. This set will only be minimal % % relative to the choice of minimal set of internals. A different choice % % for the latter might have produced a smaller set of external lines. % % % % 5. The three lists of lines computed in 1-4 are concatenated and returned. % %----------------------------------------------------------------------------% let UNWIND_AUTO_CONV = let graph_of_term tm = (let internals,t = strip_exists tm in let (lines,rhs_frees) = split (mapfilter ((((assert is_var) o fst o strip_comb) # frees) o dest_eq o snd o strip_forall) (conjuncts t)) in if (distinct lines) then let graph = combine (lines,map (intersect lines) rhs_frees) in let (intern,extern) = partition (\p. mem (fst p) internals) graph in extern @ intern else fail) in letrec loops_containing_line line graph chain = (let successors = map fst (filter (\(_,predecs). mem (hd chain) predecs) graph) in let not_in_chain = filter (\line. not (mem line chain)) successors in let new_chains = map (\line. line.chain) not_in_chain in let new_loops = flat (map (loops_containing_line line graph) new_chains) in if (mem line successors) then (rev chain).new_loops else new_loops) in letrec chop_at x l = (if (hd l = x) then ([],l) else let (l1,l2) = chop_at x (tl l) in ((hd l).l1,l2)) in let equal_loops lp1 lp2 = (if (set_equal lp1 lp2) then let (before,rest) = chop_at (hd lp1) lp2 in lp1 = (rest @ before) else false) in letrec distinct_loops lps = (if (null lps) then [] else let (h.t) = lps in if (exists (\lp. equal_loops lp h) t) then distinct_loops t else h.(distinct_loops t)) in let loops_of_graph graph = (distinct_loops (flat (map (\line. loops_containing_line line graph [line]) (map fst graph)))) in letrec list_after x l = (if (x = hd l) then tl l else list_after x (tl l)) in letrec rev_front_of l n front = (if (n < 0) then fail if (n = 0) then front else rev_front_of (tl l) (n - 1) ((hd l).front)) in letrec next_comb_at_this_level source n (h.t) = (let l = list_after h source in if (length l > n) then (rev_front_of l (n + 1) []) @ t else next_comb_at_this_level source (n + 1) t) in let next_combination source previous = ((next_comb_at_this_level source 0 previous) ? (rev_front_of source ((length previous) + 1) [])) in letrec break_all_loops lps lines previous = (let comb = next_combination lines previous in if (forall (\lp. not (null (intersect lp comb))) lps) then comb else break_all_loops lps lines comb) in let breaks internals graph = (let loops = loops_of_graph graph in let single_el_loops = filter (\l. length l = 1) loops in let single_breaks = flat single_el_loops in let loops' = filter (null o (intersect single_breaks)) loops in let only_internal_loops = filter (\l. null (subtract l internals)) loops' in let only_internal_lines = end_itlist union only_internal_loops ? [] in let internal_breaks = break_all_loops only_internal_loops only_internal_lines [] ? [] in let external_loops = filter (null o (intersect internal_breaks)) loops' in let external_lines = subtract (end_itlist union external_loops ? []) internals in let external_breaks = break_all_loops external_loops external_lines [] ? [] in single_breaks @ (rev internal_breaks) @ (rev external_breaks)) in letrec conv dependencies used t = (let vars = map fst (filter ((\l. null (subtract l used)) o snd) dependencies) in if (null vars) then REFL t else ((UNWIND_ONCE_CONV (\tm. mem (line_var tm) vars)) THENC (conv (filter (\p. not (mem (fst p) vars)) dependencies) (used @ vars))) t) in \tm. (let internals = fst (strip_exists tm) and graph = graph_of_term tm in let brks = breaks internals graph in let dependencies = map (I # (\l. subtract l brks)) (filter (\p. not (mem (fst p) brks)) graph) in DEPTH_EXISTS_CONV (conv dependencies []) tm ) ? failwith `UNWIND_AUTO_CONV`;; %----------------------------------------------------------------------------% % UNWIND_ALL_BUT_RIGHT_RULE : string list -> thm -> thm % % % % Unwind all lines (except those in the list l) as much as possible. % % % % WARNING -- MAY LOOP! % % % % UNWIND_ALL_BUT_RIGHT_RULE l % % % % A |- !z1 ... zr. % % t = % % (?l1 ... lp. t1 /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn) % % --------------------------------------------------------------------- % % A |- !z1 ... zr. % % t = % % (?l1 ... lp. t1' /\ ... /\ eqn1 /\ ... /\ eqnm /\ ... /\ tn') % % % % where ti' (for 1 <= i <= n) is ti rewritten with the equations % % eqni (1 <= i <= m). These equations are those conjuncts with line name not % % in l (and which are equations). % %----------------------------------------------------------------------------% let UNWIND_ALL_BUT_RIGHT_RULE l th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (DEPTH_EXISTS_CONV (UNWIND_ALL_BUT_CONV l)))) th ? failwith `UNWIND_ALL_BUT_RIGHT_RULE`;; %----------------------------------------------------------------------------% % UNWIND_AUTO_RIGHT_RULE : thm -> thm % % % % A |- !z1 ... zr. t = ?l1 ... lm. t1 /\ ... /\ tn % % ---------------------------------------------------- % % A |- !z1 ... zr. t = ?l1 ... lm. t1' /\ ... /\ tn' % % % % where tj' is tj rewritten with equations selected from the ti's. The % % function decides which equations to use by performing a loop analysis on % % the graph representing the dependencies of the lines. By this means the % % equations can be unwound as much as possible without the risk of looping. % % The user is left to deal with the recursive equations. % %----------------------------------------------------------------------------% let UNWIND_AUTO_RIGHT_RULE th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV UNWIND_AUTO_CONV)) th ? failwith `UNWIND_AUTO_RIGHT_RULE`;; %============================================================================% % Rules for pruning % %============================================================================% %----------------------------------------------------------------------------% % EXISTS_DEL1_CONV : conv % % % % "?x. t" % % ----> % % |- (?x. t) = t % % % % provided x is not free in t. % % % % Deletes one existential quantifier. % %----------------------------------------------------------------------------% let EXISTS_DEL1_CONV tm = (let x,t = dest_exists tm in let th = ASSUME t in let th1 = DISCH tm (CHOOSE (x, ASSUME tm) th) and th2 = DISCH t (EXISTS (tm,x) th) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `EXISTS_DEL1_CONV`;; %----------------------------------------------------------------------------% % EXISTS_DEL_CONV : conv % % % % "?x1 ... xn. t" % % ----> % % |- (?x1 ... xn. t) = t % % % % provided x1,...,xn are not free in t. % % % % Deletes existential quantifiers. The conversion fails if any of the x's % % appear free in t. It does not perform a partial deletion; for example, if % % x1 and x2 do not appear free in t but x3 does, the function will fail; it % % will not return |- ?x1 ... xn. t = ?x3 ... xn. t. % %----------------------------------------------------------------------------% let EXISTS_DEL_CONV tm = letrec terms_and_vars tm = (let x,tm' = dest_exists tm in (tm,x).(terms_and_vars tm') ) ? [] in (let txs = terms_and_vars tm in let t = snd (dest_exists (fst (last txs))) ? tm in let th = ASSUME t in let th1 = DISCH tm (itlist (\(tm,x). CHOOSE (x, ASSUME tm)) txs th) and th2 = DISCH t (itlist EXISTS txs th) in IMP_ANTISYM_RULE th1 th2 ) ? failwith `EXISTS_DEL_CONV`;; %----------------------------------------------------------------------------% % EXISTS_EQN_CONV : conv % % % % "?l. !y1 ... ym. l x1 ... xn = t" % % ----> % % |- (?l. !y1 ... ym. l x1 ... xn = t) = T % % % % provided l is not free in t. Both m and n may be zero. % %----------------------------------------------------------------------------% let EXISTS_EQN_CONV t = (let l,ys,t1,t2 = (I # ((I # dest_eq) o strip_forall)) (dest_exists t) in let xs = snd ((assert (curry $= l) # I) (strip_comb t1)) in let t3 = list_mk_abs (xs,t2) in let th1 = GENL ys (RIGHT_CONV_RULE LIST_BETA_CONV (REFL (list_mk_comb (t3,xs)))) in EQT_INTRO (EXISTS (t,t3) th1) ) ? failwith `EXISTS_EQN_CONV`;; %----------------------------------------------------------------------------% % PRUNE_ONCE_CONV : conv % % % % Prunes one hidden variable. % % % % "?l. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp" % % ----> % % |- (?l. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp) = % % (t1 /\ ... /\ ti /\ t(i+1) /\ ... /\ tp) % % % % where eq has the form "!y1 ... ym. l x1 ... xn = b" and l does not appear % % free in the ti's or in b. The conversion works if eq is not present, % % i.e. if l is not free in any of the conjuncts, but does not work if l % % appears free in more than one of the conjuncts. Each of m, n and p may be % % zero. % %----------------------------------------------------------------------------% let PRUNE_ONCE_CONV tm = (let x,t = dest_exists tm in let l1,l2 = partition (free_in x) (conjuncts t) in if (null l1) then EXISTS_DEL1_CONV tm else let [eq] = l1 in let th1 = EXISTS_EQN_CONV (mk_exists (x,eq)) in if (null l2) then th1 else let conj = list_mk_conj l2 in let th2 = AP_THM (AP_TERM "$/\" th1) conj in let th3 = EXISTS_EQ x (CONJUNCTS_CONV (t,mk_conj(eq,conj))) in let th4 = RIGHT_CONV_RULE EXISTS_AND_CONV th3 in th4 TRANS th2 TRANS (CONJUNCT1 (SPEC conj AND_CLAUSES)) ) ? failwith `PRUNE_ONCE_CONV`;; %----------------------------------------------------------------------------% % PRUNE_ONE_CONV : string -> conv % % % % Prunes one hidden variable. % % % % PRUNE_ONE_CONV `lj` % % % % "?l1 ... lj ... lr. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp" % % ----> % % |- (?l1 ... lj ... lr. t1 /\ ... /\ ti /\ eq /\ t(i+1) /\ ... /\ tp) = % % (?l1 ... l(j-1) l(j+1) ... lr. % % t1 /\ ... /\ ti /\ t(i+1) /\ ... /\ tp) % % % % where eq has the form "!y1 ... ym. lj x1 ... xn = b" and lj does not % % appear free in the ti's or in b. The conversion works if eq is not % % present, i.e. if lj is not free in any of the conjuncts, but does not work % % if lj appears free in more than one of the conjuncts. Each of m, n and p % % may be zero. % % % % If there is more than one line with the specified name (but with different % % types), the one that appears outermost in the existential quantifications % % is pruned. % %----------------------------------------------------------------------------% letrec PRUNE_ONE_CONV v tm = (let x,tm' = dest_exists tm in if (fst (dest_var x) = v) then if (is_exists tm') then (SWAP_EXISTS_CONV THENC (RAND_CONV (ABS_CONV (PRUNE_ONE_CONV v)))) tm else PRUNE_ONCE_CONV tm else RAND_CONV (ABS_CONV (PRUNE_ONE_CONV v)) tm ) ? failwith `PRUNE_ONE_CONV`;; %----------------------------------------------------------------------------% % PRUNE_SOME_CONV : string list -> conv % % % % Prunes several hidden variables. % % % % PRUNE_SOME_CONV [`li1`;...;`lik`] % % % % "?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp" % % ----> % % |- (?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp) = % % (?li(k+1) ... lir. t1 /\ ... /\ tp) % % % % where for 1 <= j <= k, each eqnij has the form: % % % % "!y1 ... ym. lij x1 ... xn = b" % % % % and lij does not appear free in any of the other conjuncts or in b. % % The li's are related by the equation: % % % % {li1,...,lik} u {li(k+1),...,lir} = {l1,...,lr} % % % % The conversion works if one or more of the eqnij's are not present, % % i.e. if lij is not free in any of the conjuncts, but does not work if lij % % appears free in more than one of the conjuncts. p may be zero, that is, % % all the conjuncts may be eqnij's. In this case the body of the result will % % be T (true). Also, for each eqnij, m and n may be zero. % % % % If there is more than one line with a specified name (but with different % % types), the one that appears outermost in the existential quantifications % % is pruned. If such a line name is mentioned twice in the list, the two % % outermost occurrences of lines with that name will be pruned, and so on. % %----------------------------------------------------------------------------% letrec PRUNE_SOME_CONV vs tm = (if (null vs) then REFL tm else (PRUNE_SOME_CONV (tl vs) THENC PRUNE_ONE_CONV (hd vs)) tm ) ? failwith `PRUNE_SOME_CONV`;; %----------------------------------------------------------------------------% % PRUNE_CONV : conv % % % % Prunes all hidden variables. % % % % "?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp" % % ----> % % |- (?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp) = % % (t1 /\ ... /\ tp) % % % % where each eqni has the form "!y1 ... ym. li x1 ... xn = b" and li does % % not appear free in any of the other conjuncts or in b. The conversion % % works if one or more of the eqni's are not present, i.e. if li is not free % % in any of the conjuncts, but does not work if li appears free in more than % % one of the conjuncts. p may be zero, that is, all the conjuncts may be % % eqni's. In this case the result will be simply T (true). Also, for each % % eqni, m and n may be zero. % %----------------------------------------------------------------------------% letrec PRUNE_CONV tm = (if (is_exists tm) then (RAND_CONV (ABS_CONV PRUNE_CONV) THENC PRUNE_ONCE_CONV) tm else REFL tm ) ? failwith `PRUNE_CONV`;; %----------------------------------------------------------------------------% % PRUNE_SOME_RIGHT_RULE : string list -> thm -> thm % % % % Prunes several hidden variables. % % % % PRUNE_SOME_RIGHT_RULE [`li1`;...;`lik`] % % % % A |- !z1 ... zr. % % t = ?l1 ... lr. t1 /\ ... /\ eqni1 /\ ... /\ eqnik /\ ... /\ tp % % ----------------------------------------------------------------------- % % A |- !z1 ... zr. t = ?li(k+1) ... lir. t1 /\ ... /\ tp % % % % where for 1 <= j <= k, each eqnij has the form: % % % % "!y1 ... ym. lij x1 ... xn = b" % % % % and lij does not appear free in any of the other conjuncts or in b. % % The li's are related by the equation: % % % % {li1,...,lik} u {li(k+1),...,lir} = {l1,...,lr} % % % % The rule works if one or more of the eqnij's are not present, i.e. if lij % % is not free in any of the conjuncts, but does not work if lij appears free % % in more than one of the conjuncts. p may be zero, that is, all the % % conjuncts may be eqnij's. In this case the conjunction will be transformed % % to T (true). Also, for each eqnij, m and n may be zero. % % % % If there is more than one line with a specified name (but with different % % types), the one that appears outermost in the existential quantifications % % is pruned. If such a line name is mentioned twice in the list, the two % % outermost occurrences of lines with that name will be pruned, and so on. % %----------------------------------------------------------------------------% let PRUNE_SOME_RIGHT_RULE vs th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (PRUNE_SOME_CONV vs))) th ? failwith `PRUNE_SOME_RIGHT_RULE`;; %----------------------------------------------------------------------------% % PRUNE_RIGHT_RULE : thm -> thm % % % % Prunes all hidden variables. % % % % A |- !z1 ... zr. % % t = ?l1 ... lr. t1 /\ ... /\ eqn1 /\ ... /\ eqnr /\ ... /\ tp % % --------------------------------------------------------------------- % % A |- !z1 ... zr. t = t1 /\ ... /\ tp % % % % where each eqni has the form "!y1 ... ym. li x1 ... xn = b" and li does % % not appear free in any of the other conjuncts or in b. The rule works if % % one or more of the eqni's are not present, i.e. if li is not free in any % % of the conjuncts, but does not work if li appears free in more than one of % % the conjuncts. p may be zero, that is, all the conjuncts may be eqni's. In % % this case the result will be simply T (true). Also, for each eqni, m and n % % may be zero. % %----------------------------------------------------------------------------% let PRUNE_RIGHT_RULE th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV PRUNE_CONV)) th ? failwith `PRUNE_RIGHT_RULE`;; %============================================================================% % Functions which do unfolding, unwinding and pruning % %============================================================================% %----------------------------------------------------------------------------% % EXPAND_ALL_BUT_CONV : string list -> thm list -> conv % % % % Unfold with the theorems thl, then unwind all lines (except those in the % % list) as much as possible and prune the unwound lines. % % % % WARNING -- MAY LOOP! % % % % EXPAND_ALL_BUT_CONV [`li(k+1)`;...;`lim`] thl % % % % "?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn" % % ----> % % B |- (?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn) = % % (?li(k+1) ... lim. t1' /\ ... /\ tn') % % % % where each ti' is the result of rewriting ti with the theorems in thl. The % % set of assumptions B is the union of the instantiated assumptions of the % % theorems used for rewriting. If none of the rewrites are applicable to a % % conjunct, it is unchanged. Those conjuncts that after rewriting are % % equations for the lines li1,...,lik (they are denoted by ui1,...,uik) are % % used to unwind and the lines li1,...,lik are then pruned. If this is not % % possible the function will fail. It is also possible for the function to % % attempt unwinding indefinitely (to loop). % % % % The li's are related by the equation: % % % % {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} % %----------------------------------------------------------------------------% let EXPAND_ALL_BUT_CONV l thl tm = (DEPTH_EXISTS_CONV ((UNFOLD_CONV thl) THENC (UNWIND_ALL_BUT_CONV l)) THENC (\tm. let var_names = map (fst o dest_var) (fst (strip_exists tm)) in PRUNE_SOME_CONV (subtract var_names l) tm)) tm ? failwith `EXPAND_ALL_BUT_CONV`;; %----------------------------------------------------------------------------% % EXPAND_AUTO_CONV : thm list -> conv % % % % Unfold with the theorems thl, then unwind as much as possible and prune % % the unwound lines. % % % % EXPAND_AUTO_CONV thl % % % % "?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn" % % ----> % % B |- (?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn) = % % (?li(k+1) ... lim. t1' /\ ... /\ tn') % % % % where each ti' is the result of rewriting ti with the theorems in thl. The % % set of assumptions B is the union of the instantiated assumptions of the % % theorems used for rewriting. If none of the rewrites are applicable to a % % conjunct, it is unchanged. After rewriting the function decides which of % % the resulting terms to use for unwinding by performing a loop analysis on % % the graph representing the dependencies of the lines. % % % % Suppose the function decides to unwind the lines li1,...,lik using the % % terms ui1',...,uik' respectively. Then after unwinding the lines % % li1,...,lik are pruned (provided they have been eliminated from the RHS's % % of the conjuncts that are equations, and from the whole of any other % % conjuncts) resulting in the elimination of ui1',...,uik'. % % % % The li's are related by the equation: % % % % {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} % % % % The loop analysis allows the term to be unwound as much as possible % % without the risk of looping. The user is left to deal with the recursive % % equations. % %----------------------------------------------------------------------------% let EXPAND_AUTO_CONV thl tm = (DEPTH_EXISTS_CONV (UNFOLD_CONV thl) THENC UNWIND_AUTO_CONV THENC (\tm. let internals,conjs = (I # conjuncts) (strip_exists tm) in let vars = flat (map (frees o (\tm. rhs tm ? tm) o snd o strip_forall) conjs) in PRUNE_SOME_CONV (map (fst o dest_var) (subtract internals vars)) tm)) tm ? failwith `EXPAND_AUTO_CONV`;; %----------------------------------------------------------------------------% % EXPAND_ALL_BUT_RIGHT_RULE : string list -> thm list -> thm -> thm % % % % Unfold with the theorems thl, then unwind all lines (except those in the % % list) as much as possible and prune the unwound lines. % % % % WARNING -- MAY LOOP! % % % % EXPAND_ALL_BUT_RIGHT_RULE [`li(k+1)`;...;`lim`] thl % % % % A |- !z1 ... zr. % % t = ?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn % % ----------------------------------------------------------------------- % % B u A |- !z1 ... zr. t = ?li(k+1) ... lim. t1' /\ ... /\ tn' % % % % where each ti' is the result of rewriting ti with the theorems in thl. The % % set of assumptions B is the union of the instantiated assumptions of the % % theorems used for rewriting. If none of the rewrites are applicable to a % % conjunct, it is unchanged. Those conjuncts that after rewriting are % % equations for the lines li1,...,lik (they are denoted by ui1,...,uik) are % % used to unwind and the lines li1,...,lik are then pruned. If this is not % % possible the function will fail. It is also possible for the function to % % attempt unwinding indefinitely (to loop). % % % % The li's are related by the equation: % % % % {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} % %----------------------------------------------------------------------------% let EXPAND_ALL_BUT_RIGHT_RULE l thl th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (EXPAND_ALL_BUT_CONV l thl))) th ? failwith `EXPAND_ALL_BUT_RIGHT_RULE`;; %----------------------------------------------------------------------------% % EXPAND_AUTO_RIGHT_RULE : thm list -> thm -> thm % % % % Unfold with the theorems thl, then unwind as much as possible and prune % % the unwound lines. % % % % EXPAND_AUTO_RIGHT_RULE thl % % % % A |- !z1 ... zr. % % t = ?l1 ... lm. t1 /\ ... /\ ui1 /\ ... /\ uik /\ ... /\ tn % % ----------------------------------------------------------------------- % % B u A |- !z1 ... zr. t = ?li(k+1) ... lim. t1' /\ ... /\ tn' % % % % where each ti' is the result of rewriting ti with the theorems in thl. The % % set of assumptions B is the union of the instantiated assumptions of the % % theorems used for rewriting. If none of the rewrites are applicable to a % % conjunct, it is unchanged. After rewriting the function decides which of % % the resulting terms to use for unwinding by performing a loop analysis on % % the graph representing the dependencies of the lines. % % % % Suppose the function decides to unwind the lines li1,...,lik using the % % terms ui1',...,uik' respectively. Then after unwinding the lines % % li1,...,lik are pruned (provided they have been eliminated from the RHS's % % of the conjuncts that are equations, and from the whole of any other % % conjuncts) resulting in the elimination of ui1',...,uik'. % % % % The li's are related by the equation: % % % % {li1,...,lik} u {li(k+1),...,lim} = {l1,...,lm} % % % % The loop analysis allows the term to be unwound as much as possible % % without the risk of looping. The user is left to deal with the recursive % % equations. % %----------------------------------------------------------------------------% let EXPAND_AUTO_RIGHT_RULE thl th = CONV_RULE (DEPTH_FORALL_CONV (RAND_CONV (EXPAND_AUTO_CONV thl))) th ? failwith `EXPAND_AUTO_RIGHT_RULE`;; hol88-2.02.19940316/Library/string/0000750000212700021270000000000005533117174014643 5ustar cammcammhol88-2.02.19940316/Library/string/Manual/0000750000212700021270000000000005535606224016061 5ustar cammcammhol88-2.02.19940316/Library/string/Manual/Makefile0000640000212700021270000000377005267300007017521 0ustar cammcamm# ===================================================================== # Makefile for the string library documentation # ===================================================================== # --------------------------------------------------------------------- # Pathname to the string help files # --------------------------------------------------------------------- Help=../help # --------------------------------------------------------------------- # Pathname to the doc-to-tex script and doc-to-tex.sed file # --------------------------------------------------------------------- DOCTOTEX=../../../Manual/Reference/bin/doc-to-tex DOCTOTEXSED=../../../Manual/Reference/bin/doc-to-tex.sed # --------------------------------------------------------------------- # Pathname to the makeindex script # --------------------------------------------------------------------- MAKEINDEX=../../../Manual/LaTeX/makeindex ../../../ default: @echo "INSTRUCTIONS: Type \"make all\" to make the documentation" # --------------------------------------------------------------------- # Remove all trace of previous LaTeX jobs # --------------------------------------------------------------------- clean: rm -f *.dvi *.aux *.toc *.log *.idx *.ilg @echo "\begin{theindex}" > index.tex @echo "\mbox{}" >> index.tex @echo "\end{theindex}" >> index.tex tex: ids theorems @echo "TeX files made" ids: @echo "\chapter{ML Functions in the string Library}">entries.tex @echo "\input{entries-intro}" >> entries.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex theorems: @echo "\chapter{Pre-proved Theorems}" > theorems.tex @echo "\input{theorems-intro}" >> theorems.tex @echo "\section{Definitions}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/defs theorems.tex @echo "\section{Theorems}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms theorems.tex index: ${MAKEINDEX} string.idx index.tex string: latex string.tex all: make clean; make tex; make string; make index; make string hol88-2.02.19940316/Library/string/Manual/index.tex0000640000212700021270000000245305535606225017720 0ustar cammcamm\begin{theindex} \item \verb+"`+$\dots$\verb+`"+ (string constants), 5--6 \item {\ptt ``\_DEF}, 14 \indexspace \item {\ptt ASCII\_11}, 2, 3, 6, 14 \item {\ptt ascii\_Axiom}, 1--2, 14 \item {\ptt ascii\_CASES}, 2, 14 \item {\ptt ASCII\_DEF}, 13 \item {\ptt ascii\_EQ\_CONV}, 3, 9 \item {\ptt ascii\_Induct}, 2, 15 \item {\ptt ascii\_ISO\_DEF}, 13 \item {\ptt ascii\_TY\_DEF}, 13 \indexspace \item case analysis \subitem on type {\tt ascii}, 2 \subitem on type {\tt string}, 4 \indexspace \item function definitions \subitem on type {\tt ascii}, 2 \subitem on type {\tt string}, 4 \indexspace \item {\ptt load\_string}, 8, 10 \indexspace \item {\ptt NOT\_EMPTY\_STRING}, 4, 15 \item {\ptt NOT\_STRING\_EMPTY}, 4, 15 \indexspace \item string constants, 5--6 \item {\ptt STRING\_11}, 4, 6, 15 \item {\ptt string\_Axiom}, 3--4, 15 \item {\ptt string\_CASES}, 4, 15 \item {\ptt string\_CONV}, 5--6, 10 \item {\ptt STRING\_DEF}, 13 \item {\ptt string\_EQ\_CONV}, 6, 11 \item {\ptt string\_Induct}, 4, 15 \item {\ptt string\_ISO\_DEF}, 14 \item {\ptt string\_TY\_DEF}, 14 \item structural induction, 4 \indexspace \item theorems \subitem about the type {\tt ascii}, 2 \subitem about the type {\tt string}, 4 \end{theindex} hol88-2.02.19940316/Library/string/Manual/string.log0000640000212700021270000000345505535606243020103 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:25 **string.tex (string.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file string.idx (string.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) (title.tex [1 ] [2]) (string.toc) \tf@toc=\write4 [3 ] [4 ] (description.tex Chapter 1. [1 ] [2] [3] [4] [5] [6] [7]) [8] (entries.tex Chapter 2. (entries-intro.tex) [9 ] [10]) [11] (theorems.tex [12 ] Chapter 3. (theorems-intro.tex) [13] [14]) [15] (references.tex [16 ]) [17] (index.tex [18 ]) (string.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) ) Here is how much of TeX's memory you used: 466 strings out of 11977 3898 string characters out of 87025 39305 words of memory out of 262141 2290 multiletter control sequences out of 9500 19640 words of font info for 75 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 18i,12n,19p,250b,561s stack positions out of 300i,100n,60p,3000b,4000s Output written on string.dvi (22 pages, 41752 bytes). hol88-2.02.19940316/Library/string/Manual/string.idx0000640000212700021270000000615105535606243020102 0ustar cammcamm\indexentry{ascii\_Axiom@{\ptt ascii\_Axiom}|(}{1} \indexentry{function definitions!on type {\tt ascii}|(}{2} \indexentry{ascii\_Axiom@{\ptt ascii\_Axiom}|)}{2} \indexentry{function definitions!on type {\tt ascii}|)}{2} \indexentry{theorems!about the type {\tt ascii}|(}{2} \indexentry{ASCII\_11@{\ptt ASCII\_11}}{2} \indexentry{ascii\_Induct@{\ptt ascii\_Induct}}{2} \indexentry{case analysis!on type {\tt ascii}|(}{2} \indexentry{ascii\_CASES@{\ptt ascii\_CASES}}{2} \indexentry{case analysis!on type {\tt ascii}|)}{2} \indexentry{theorems!about the type {\tt ascii}|)}{2} \indexentry{ascii\_EQ\_CONV@{\ptt ascii\_EQ\_CONV}}{3} \indexentry{ASCII\_11@{\ptt ASCII\_11}}{3} \indexentry{string\_Axiom@{\ptt string\_Axiom}|(}{3} \indexentry{function definitions!on type {\tt string}|(}{4} \indexentry{string\_Axiom@{\ptt string\_Axiom}|)}{4} \indexentry{function definitions!on type {\tt string}|)}{4} \indexentry{theorems!about the type {\tt string}|(}{4} \indexentry{NOT\_EMPTY\_STRING@{\ptt NOT\_EMPTY\_STRING}}{4} \indexentry{NOT\_STRING\_EMPTY@{\ptt NOT\_STRING\_EMPTY}}{4} \indexentry{STRING\_11@{\ptt STRING\_11}}{4} \indexentry{structural induction|(}{4} \indexentry{case analysis!on type {\tt string}|(}{4} \indexentry{string\_Induct@{\ptt string\_Induct}}{4} \indexentry{string\_CASES@{\ptt string\_CASES}}{4} \indexentry{structural induction|)}{4} \indexentry{case analysis!on type {\tt string}|)}{4} \indexentry{theorems!about the type {\tt string}|)}{4} \indexentry{string constants|(}{5} \indexentry{\\\@\verb+""`+$\dots$\verb+`""+ (string constants)|(}{5} \indexentry{string\_CONV@{\ptt string\_CONV}|(}{5} \indexentry{string constants|)}{6} \indexentry{\\\@\verb+""`+$\dots$\verb+`""+ (string constants)|)}{6} \indexentry{string\_CONV@{\ptt string\_CONV}|)}{6} \indexentry{string\_EQ\_CONV@{\ptt string\_EQ\_CONV}|(}{6} \indexentry{STRING\_11@{\ptt STRING\_11}}{6} \indexentry{ASCII\_11@{\ptt ASCII\_11}}{6} \indexentry{string\_EQ\_CONV@{\ptt string\_EQ\_CONV}|)}{6} \indexentry{load\_string@{\ptt load\_string}|(}{8} \indexentry{load\_string@{\ptt load\_string}|)}{8} \indexentry{ascii\_EQ\_CONV@{\ptt ascii\_EQ\_CONV}}{9} \indexentry{load\_string@{\ptt load\_string}}{10} \indexentry{string\_CONV@{\ptt string\_CONV}}{10} \indexentry{string\_EQ\_CONV@{\ptt string\_EQ\_CONV}}{11} \indexentry{ASCII\_DEF@{\ptt ASCII\_DEF}}{13} \indexentry{ascii\_ISO\_DEF@{\ptt ascii\_ISO\_DEF}}{13} \indexentry{ascii\_TY\_DEF@{\ptt ascii\_TY\_DEF}}{13} \indexentry{STRING\_DEF@{\ptt STRING\_DEF}}{13} \indexentry{string\_ISO\_DEF@{\ptt string\_ISO\_DEF}}{14} \indexentry{string\_TY\_DEF@{\ptt string\_TY\_DEF}}{14} \indexentry{``\_DEF@{\ptt ``\_DEF}}{14} \indexentry{ASCII\_11@{\ptt ASCII\_11}}{14} \indexentry{ascii\_Axiom@{\ptt ascii\_Axiom}}{14} \indexentry{ascii\_CASES@{\ptt ascii\_CASES}}{14} \indexentry{ascii\_Induct@{\ptt ascii\_Induct}}{15} \indexentry{NOT\_EMPTY\_STRING@{\ptt NOT\_EMPTY\_STRING}}{15} \indexentry{NOT\_STRING\_EMPTY@{\ptt NOT\_STRING\_EMPTY}}{15} \indexentry{STRING\_11@{\ptt STRING\_11}}{15} \indexentry{string\_Axiom@{\ptt string\_Axiom}}{15} \indexentry{string\_CASES@{\ptt string\_CASES}}{15} \indexentry{string\_Induct@{\ptt string\_Induct}}{15} hol88-2.02.19940316/Library/string/Manual/entries-intro.tex0000640000212700021270000000032205026467703021405 0ustar cammcammThis chapter provides documentation on all the \ML\ functions that are made available in \HOL\ when the \ml{string} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/string/Manual/string.aux0000640000212700021270000000021205535606243020103 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{theorems.aux} \@input{references.aux} \@input{index.aux} hol88-2.02.19940316/Library/string/Manual/title.aux0000640000212700021270000000077305535606230017726 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/string/Manual/title.tex0000640000212700021270000000353405027126050017720 0ustar cammcamm% ===================================================================== % % Standard titlepage for string library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL string Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf T.\ F.\ Melham \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf June 1991 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ T.\ F.\ Melham 1991 \end{center} \newpage hol88-2.02.19940316/Library/string/Manual/string.tex0000640000212700021270000000474405104507605020116 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: string library (standard latex style) % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{description} % --------------------------------------------------------------------- % Reference manual entries for functions % --------------------------------------------------------------------- \include{entries} % --------------------------------------------------------------------- % Listing of theorems % --------------------------------------------------------------------- \include{theorems} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/string/Manual/references.tex0000640000212700021270000000072505104510101020705 0ustar cammcamm\begin{thebibliography}{99} \bibitem{description} % OK University of Cambridge, {\small DSTO} and {\small SRI} International, {\it The HOL System: DESCRIPTION}, (1991). \bibitem{melham} % OK T.F.\ Melham, `Automating Recursive Type Definitions in Higher Order Logic', in: {\it Current Trends in Hardware Verification and Automated Theorem Proving\/}, edited by G.\ Birtwistle and P.A.\ Subrahmanyam (Springer-Verlag, 1989), pp.\ 341--386. \end{thebibliography} hol88-2.02.19940316/Library/string/Manual/string.dvi0000640000212700021270000012143005535606243020076 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1025‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘^æóHò"VáG cmbx10ëHThe– ‰‹HOL“string“LibraryŽŸI­Û’ÃÔÊó7ò"Vff cmbx10âT.–…F.“MelhamŽ ‡&‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’Ø•¼June‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’˜Nþž£hó+X«Q cmr12ÖcŽŽŽ’”ëmó-!",š cmsy10Ø ŽŽŽŽ’¤ÖÖT.–ê¨F.“Melham“1991ŽŽŽŒ‹É ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFLÛ1Ž‘ŸôThe–€string“Library’@§Å1ŽŽ¤‘ŸôÖ1.1Ž‘,¦JAscii–ê¨c¬rharacter“coSŽdes‘¬§‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ߎŒ‹‹ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸGëHThe– ‰‹string“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–8\došSŽcumen¬rt“describ˜es“the“facilities“proš¬rvided“b˜y“the“ó(ßêþÓascii– T=“ASCII–¿ªbool“bool“bool“bool“bool“bool“bool“boolŽŽŽŽŽŽŽ¡ÖThe–<:simple“enš¬rumerated“t˜ypšSŽe“ÓasciiŽ‘%6ÆÖdescrib˜ed“bš¬ry“this“equation“pro˜vides“a“represen˜tationŽ¤in–nlogic“for“the“set“of“all“8-bit“ascii“cš¬rharacter“coSŽdes.‘Ã"Eac˜h“c˜haracter“is“represen˜ted“b˜y“aŽ¡v‘ÿXäalue–£Þobtained“bš¬ry“applying“the“function“ÓASCIIŽ‘$Öto“the“eigh˜t“b•SŽo“olean–£Þv‘ÿXäalues“of“its“standardŽ¡ascii–wc¬rharacter“coSŽde.‘¼MThe“letter“`a',›akfor“example,˜has“the“8-bit“coSŽde“`01100001'“and“isŽ¡represenš¬rted–ê¨formally“in“logic“b˜y“the“termŽ¤‘ÁžV½‘>þÓ"ASCII–¿ªF“T“T“F“F“F“F“T"ŽŽŽŽŽŽŽ¡ÖOf–BYcourse,‘XEanš¬ry“other“ascii“c˜haracter“coSŽde“can“lik˜ewise“bSŽe“represen˜ted“in“logic“b˜y“a“v‘ÿXäalueŽ¤of–ê¨tš¬rypSŽe“ÓasciiŽ‘$“¢Öconstructed“using“the“function“constan˜t“ÓASCIIŽ‘ ¨úÖ.Ž¡‘ aThe–Ãëtš¬rypSŽe“ÓasciiŽ‘&F(Öand“the“constan˜t“ÓASCIIŽ‘&F(Öare“de ned“formally“in“the“library“using“theŽ¡function‘€#Ódefine_typeŽ‘H<”Öfrom–€#the“ÍHOL“Örecursivš¬re“t˜ypSŽes“pac˜k‘ÿXäage“(see“[1Ž‘ßü,“2Ž‘ `]).‘ùRThis“giv˜es“theŽ¡follo¬rwing–Çítheorem,›Îßcalled“Óascii_AxiomŽ‘C;Ö,˜as“an“abstract“cš¬rharacterization“of“the“t˜ypSŽe“ÓasciiŽ‘ †?Ö:Ž¤&Ÿ@UŸåi‘>þÓ|-–¿ª!f.“?!fn:ascii->*.Ž¤ ‘3ýP!b0–¿ªb1“b2“b3“b4“b5“b6“b7.Ž¡‘?|¤fn(ASCII–¿ªb0“b1“b2“b3“b4“b5“b6“b7)“=“f“b0“b1“b2“b3“b4“b5“b6“b7ŽŽŽŽŽŽŽ¡ÖThis–#simply“saš¬rys“that“functions“on“v‘ÿXäalues“of“t˜ypSŽe“ÓasciiŽ‘'^Öma˜y“bšSŽe“uniquely“sp˜eci ed“b¬ryŽŸde ning–Ëthem“in“terms“of“the“eighš¬rt“b•SŽo“olean–Ëv‘ÿXäalues“from“whic˜h“these“v‘ÿXäalues“are“constructed.ŽŽŸ$ý’óŸÛ1ŽŽŒ‹ÿ ÌU ýFÓŸú™š‘êñëÛ2’‹GChapter–€1.‘ €The“string“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâ1.1.1Ž‘‹lF‘þž¸unction–…de nitions“on“tŠ=ypuÂe“óIßê€ùÌÍŸYœ„BÚ•ffŸÇ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±Ÿýóp®0J cmsl10È1ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªBIT1“=Ž¤ ‘"‹new_recursive_definition–¿ªfalse“ascii_Axiom“`BIT1`Ž¡‘"‹"BIT1(ASCII–¿ªb1“b2“b3“b4“b5“b6“b7“b8)“=“b1";;Ž¡‘ÌÍBIT1‘¿ª=Ž¡‘ÌÍ|-–¿ª!b1“b2“b3“b4“b5“b6“b7“b8.“BIT1(ASCII“b1“b2“b3“b4“b5“b6“b7“b8)“=“b1ŽŽ’Æq°„BÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ3+ÿ‘êñëÖIn–wÐfact,‘ŽÈanš¬ry“function“whatsoSŽev˜er“on“the“ÓasciiŽ‘#­òÖis“de nable“using“the“theorem“Óascii_AxiomŽŽ¡‘êñëÖand–ê¨the“rule“Ónew_recursive_definitionŽ’â˜Ö.ŽŸ"ˆì‘êñëâ1.1.2Ž‘‹lTheorems–…abšuÂout“the“tŠ=yp˜e“ëIasciiŽ¦‘êñëÖIn–ßKaddition“to“Óascii_AxiomŽ‘E™Ö,‘\ssevš¬reral“standard“theorems“abSŽout“the“de ned“t˜ypSŽe“ÓasciiŽŽ¡‘êñëÖpro•¬rv“ed–å using“the“recursivš¬re“t˜ypSŽes“pac˜k‘ÿXäage“are“a˜v‘ÿXäailable“as“built-in“theorems“of“the“ÓstringŽŽ¡‘êñëÖlibrary‘ÿV.‘2ßThey–Ø¥are“all“set“up“to“autoload,›Ü?if“pSŽossible,˜when“the“library“is“loaded“in¬rto“ÍHOLÖ.Ž¡‘öSzThe–ê¨theorem“ÓASCII_11Ž‘5Ò Östates“that“the“function“ÓASCIIŽ‘$“¢Öis“injectiv¬re:Ž¤3ò@Ÿ@UŸËi‘0éÓ|-–¿ª!b0“b1“b2“b3“b4“b5“b6“b7“b0'“b1'“b2'“b3'“b4'“b5'“b6'“b7'.Ž¤ ‘oç(ASCII–¿ªb0“b1“b2“b3“b4“b5“b6“b7“=“ASCII“b0'“b1'“b2'“b3'“b4'“b5'“b6'“b7')Ž¡‘ï;=Ž¡‘oç(b0–¿ª=“b0')“/\“(b1“=“b1')“/\“(b2“=“b2')“/\“(b3“=“b3')“/\Ž¡‘oç(b4–¿ª=“b4')“/\“(b5“=“b5')“/\“(b6“=“b6')“/\“(b7“=“b7')ŽŽŽŽŽŽŽ¡‘êñëÖThis–¤theorem“alloš¬rws“one“to“pro˜v˜e“equalit˜y“or“inequalit˜y“of“ascii“c˜haracter“coSŽdes;‘ã¢it“alsoŽ¤‘êñëforms–Ä2the“basis“for“the“decision-proSŽcedure“Óascii_EQ_CONVŽ‘TDÖexplained“in“section“1.1.3.‘Å~AŽ¡‘êñëdegenerate–’8`structural“induction'“theorem“for“the“t¬rypSŽe“ÓasciiŽ‘ PŠÖ,›£ècalled“Óascii_InductŽ‘HŽ0Ö,˜is“alsoŽ¡‘êñëa¬rv‘ÿXäailable–ê¨in“the“library:Ž¤&ò@Ÿ@UŸåi‘0éÓ|-–¿ª!P.“(!b0“b1“b2“b3“b4“b5“b6“b7.“P(ASCII“b0“b1“b2“b3“b4“b5“b6“b7))Ž¤ ‘5íã==>Ž¡‘*n(!a.–¿ªP“a)ŽŽŽŽŽŽŽ¡‘êñëÖThis– 8is“in“the“standard“form“used“bš¬ry“the“recursiv˜e“t˜ypSŽes“pac˜k‘ÿXäage“and“can“therefore“bSŽe“usedŽ©‘êñëwith‘ŸÓINDUCT_THENŽ‘Dz€Öif–Ÿdesired.‘Ê[Finally‘ÿV,‘áithere“is“the“trivial“case“analysis“theorem“Óascii_CASESŽ‘AÛgÖ:Ž¤ûŸ@UŸÿi‘0éÓ|-–¿ª!a.“?b0“b1“b2“b3“b4“b5“b6“b7.“a“=“ASCII“b0“b1“b2“b3“b4“b5“b6“b7ŽŽŽŽŽŽŽ¡‘êñëÖThis–Ðstates“that“evš¬rery“v‘ÿXäalue“of“t˜ypšSŽe“ÓasciiŽ‘%ÝòÖcan“b˜e“constructed“using“the“function“ÓASCIIŽŽ¦‘êñëÖand–•¼can“bSŽe“used,›Àfor“example,˜with“ÓSTRUCT_CASES_TACŽ‘e&Öto“replace“v‘ÿXäariables“ranging“o•¬rv“erŽ¦‘êñëÓasciiŽ‘ šåÖb¬ry–ê¨v‘ÿXäalues“explicitly“constructed“with“ÓASCIIŽ‘ ¨úÖ.ŽŽŽŒ‹7 ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Character‘€strings’:D„3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaâ1.1.3Ž‘E`âDecision–…prošuÂcedure“for“ascii“co˜de“equalitŠ=yŽŸÀ‘ÇaÖThe‘n«ÓstringŽ‘-[RÖlibrary–n«proš¬rvides“a“highly“optimized“con˜v˜ersion“for“pro˜ving“equalit˜y“or“in-Ž¤‘Çaequalitš¬ry–å«of“constan˜t“terms“that“represen˜t“ascii“c˜haracter“coSŽdes,‘$kin“the“form“of“applica-Ž¡‘Çations–/of“the“constructor“ÓASCIIŽ‘%ˆÖto“the“b•SŽo“olean–/constanš¬rts“ÓTŽ‘àÖand“ÓFŽ‘ îÅÖ.‘:This“con˜v˜ersion,‘@8calledŽ¡‘ÇaÓascii_EQ_CONDŽ‘]ƒÖ,–ê¨expšSŽects“its“term“argumen¬rt“to“b˜e“an“equation“of“the“form:Ž¤„äŸDŸþ34‘*_Ó"ASCII‘¿ª×aŸÌÌó |{Ycmr8¸1ŽŽ‘jY×aŸÌ̸2ŽŽ‘'×aŸÌ̸3ŽŽ‘7¿·×aŸÌ̸4ŽŽ‘Hjf×aŸÌ̸5ŽŽ‘Y×aŸÌ̸6ŽŽ‘i¿Ä×aŸÌ̸7ŽŽ‘zjs×aŸÌ̸8ŽŽ’‹"Ó=–¿ªASCII“×bŸÌ̸1ŽŽ‘>B×bŸÌ̸2ŽŽ‘$¼Ú×bŸÌ̸3ŽŽ‘4;r×bŸÌ̸4ŽŽ‘Cº ×bŸÌ̸5ŽŽ‘S8¢×bŸÌ̸6ŽŽ‘b·:×bŸÌ̸7ŽŽ‘r5Ò×bŸÌ̸8ŽŽ‘{ôÀÓ"ŽŽŽŽŽŽŽ¡‘ÇaÖwhere–Šðeac¬rh“of“×aŸÌ̸1Ž–ÀÖ,‘ž×:–ÿþ:“:ŽŽ‘h³Ö,›ž×aŸÌ̸8Ž“Ö,˜×bŸÌ̸1Ž“Ö,˜×:–ÿþ:“:ŽŽ‘h³Ö,˜×bŸÌ̸8Ž‘JôÖis–Šðeither“the“constanš¬rt“ÓTŽ‘ ÕŠÖor“the“constan˜t“ÓFŽ‘ JšÖ.‘øGiv˜en“suc˜hŽ¤‘Çaan›W@equation,‘rfÓascii_EQ_CONDŽ‘S…HÖpro•¬rv“es˜that˜it˜is˜equal˜to˜true˜(ÓTŽ‘¿ªÖ)˜if˜the˜left˜and˜righ“t-handŽ¡‘Çasides–oMrepresenš¬rt“the“same“ascii“coSŽde“or“false“(ÓFŽ‘¿ªÖ)“otherwise.‘ÂThe“follo˜wing“session“illustratesŽ¡‘Çathe–ê¨use“of“the“con•¬rv“ersion:ŽŸ-X•‘ÇaŸÛ’µ‰ffÇ IŸ>€ùÌÍŸYœ„BÚ•ffŸÇ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#ascii_EQ_CONV–¿ª"ASCII“T“T“F“T“T“F“T“T“=“ASCII“T“T“F“T“T“F“T“T";;Ž¤ ‘ÌÍ|-–¿ª(ASCII“T“T“F“T“T“F“T“T“=“ASCII“T“T“F“T“T“F“T“T)“=“TŽŸ‘ÌÍ#ascii_EQ_CONV–¿ª"ASCII“T“T“F“T“T“F“T“T“=“ASCII“T“T“F“T“T“F“T“F";;Ž¡‘ÌÍ|-–¿ª(ASCII“T“T“F“T“T“F“T“T“=“ASCII“T“T“F“T“T“F“T“F)“=“FŽŽ’Æq°„BÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ/­è‘ÇaÖThe›;¬con•¬rv“ersion˜is˜highly˜optimised˜and˜using˜it˜can˜bSŽe˜considerably˜faster˜than˜pro“vingŽ¡‘Çaequalitš¬ry–ê¨or“inequalit˜y“b˜y‘ÿV,“for“example,“rewriting“with“the“theorem“ÓASCII_11Ž‘1çøÖ.ŽŸ'`‘Çaç1.2Ž‘@ åCharacter‘Ÿ¼stringsŽŸâ#‘ÇaÖThe–xPtheory“ÓstringŽ‘+nœÖin“the“library“de nes“a“logical“tš¬rypSŽe“of“ascii“c˜haracter“strings.‘á×TheseŽ¡‘Çaare–Àç(pSŽossibly“emptš¬ry)“sequences“of“c˜haracter“coSŽdes,‘öwand“the“theory“ÓasciiŽ‘&@ Öis“a“paren˜t“ofŽ¡‘Çathe–Dtheory“ÓstringŽ‘&—@Ö.‘ĵThe“tš¬rypSŽe“of“ascii“c˜haracter“strings,›$ëcalled“ÓstringŽ‘&—@Ö,˜is“de ned“formallyŽ¡‘Çain–ê¨the“library“using“Ódefine_typeŽ‘C&öÖ,“with“the“recursivš¬re“spSŽecifying“equation“sho˜wn“bSŽelo˜w.Ž¤„䟟ý‘‘*_Óstring– T=“``“|“STRING–¿ªascii“stringŽŽŽŽŽŽŽ¡‘ÇaÖEvš¬rery–’úv‘ÿXäalue“of“t˜ypSŽe“ÓstringŽ‘+£ðÖconsists“of“a“ nite“sequence“of“ascii“c˜haracter“coSŽdes.‘1×TheseŽ¤‘Çasequences– eare“constructed“using“the“function“ÓSTRINGŽ‘+¾ÆÖfrom“the“emptš¬ry“string“represen˜tedŽ¡‘Çabš¬ry–ê¨the“constan˜t“Ó``Ž‘iüÖ.‘8àF‘ÿVor“example,“the“c˜haracter“string“`ab'“is“represen˜ted“in“logic“b˜y:Ž¤„äŸ@UŸÿi‘*_Ó"STRING–¿ª(ASCII“F“T“T“F“F“F“F“T)“(STRING“(ASCII“F“T“T“F“F“F“T“F)“``)"ŽŽŽŽŽŽŽ¡‘ÇaÖAnš¬ry–ê¨ nite“string“of“ascii“c˜haracters“can“bSŽe“represen˜ted“in“logic“in“a“similar“w˜a˜y‘ÿV.Ž¤‘(ðThe–*tš¬rypSŽe“ÓstringŽ‘(Ò"Öis“de ned“in“the“library“using“the“recursiv˜e“t˜ypSŽes“pac˜k‘ÿXäage.‘ø®An“abstractŽ¡‘Çacš¬rharacterization–:îof“the“t˜ypSŽe“ÓstringŽ‘'¸êÖ,‘Žÿin“the“standard“form“used“b˜y“the“recursiv˜e“t˜ypSŽesŽ¡‘Çapacš¬rk‘ÿXäage,–ê¨is“pro˜vided“b˜y“the“theorem“Óstring_AxiomŽ‘Hæ Ö:Ž¤„äŸ@UŸÿi‘*_Ó|-–¿ª!e“f.“?!“fn.“(fn“``“=“e)“/\“(!a“s.“fn(STRING“a“s)“=“f(fn“s)a“s)ŽŽŽŽŽŽŽ¡‘ÇaÖThis–ºtheorem,‘ÃÑwhicš¬rh“is“pro˜v˜ed“automatically“b˜y“Ódefine_typeŽ‘BöiÖ,‘ÃÑstates“the“v‘ÿXäalidit˜y“of“prim-ŽŸ‘Çaitiv•¬re›ê¨recursiv“e˜de nitions˜on˜the˜t“ypSŽe˜ÓstringŽ‘&h¤Ö.ŽŽŽŒ‹+  ÌU ýFÓŸú™š‘êñëÛ4’‹GChapter–€1.‘ €The“string“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâ1.2.1Ž‘‹lF‘þž¸unction–…de nitions“on“tŠ=ypuÂe“ëIstringŽ©J/‘êñëÖThe–§theorem“Óstring_AxiomŽ‘JKÖis“in“the“standard“form“accepted“b¬ry“Ónew_recursive_definitionŽŽ¤‘êñëÖand–A©can“therefore“bšSŽe“used“to“de ne“functions“o•¬rv“er‘A©t“yp˜e‘A©ÓstringŽ‘)NÖb“y›A©primitiv“e˜recursion.‘‹F‘ÿVorŽ¡‘êñëexample,–ê¨one“can“de ne“the“length“of“a“string“as“follo¬rws.ŽŸ4·í‘êñëŸâµ‰ffÇ IŸ1€ùÌÍŸYœ„5Ú•ffŸÔ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªLEN“=Ž¤ ‘"‹new_recursive_definition–¿ªfalse“string_Axiom“`LEN`Ž¡‘"‹"(LEN–¿ª``“=“0)“/\“(LEN“(STRING“a“s)“=“(LEN“s)“+“1)";;Ž¡‘ÌÍLEN–¿ª=“|-“(LEN“``“=“0)“/\“(!a“s.“LEN(STRING“a“s)“=“(LEN“s)“+“1)ŽŽ’Æq°„5Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ3ö‘êñëÖOther–Wšforms“of“primitivš¬re“recursiv˜e“de nition“ma˜y“also“bSŽe“made“using“Óstring_AxiomŽ‘M«,ÖandŽ¡‘êñëÓnew_recursive_definitionŽ‘téÛÖ;–ê¨see“the“ÍHOL“Ösystem“doSŽcumen¬rtation“for“details.ŽŸ'v)‘êñëâ1.2.2Ž‘‹lTheorems–…abšuÂout“the“tŠ=yp˜e“ëIstringŽ¦‘êñëÖF‘ÿVor–4the“recursivš¬re“t˜ypSŽe“ÓstringŽ‘&±þÖ,‘FYthe“library“pro˜vides“as“built-in“all“the“standard“theoremsŽ¡‘êñëproš¬rv‘ÿXäable–kûusing“the“recursiv˜e“t˜ypSŽes“pac˜k‘ÿXäage.‘¦These“theorems,‘…Qwhic˜h“are“set“up“to“autoloadŽ¡‘êñëwhen–Mthe“library“is“loaded,‘e©include“theorems“stating“the“distinctness“of“empt¬ry“and“non-Ž¡‘êñëempt¬ry‘ê¨strings:ŽŸ/¹ŸPáŸäõQ‘0éÓNOT_STRING_EMPTY‘>þ|-–¿ª!a“s.“~(``“=“STRING“a“s)ŽŸ‘0éNOT_EMPTY_STRING‘>þ|-–¿ª!a“s.“~(STRING“a“s“=“``)ŽŽŽŽŽŽŽŸ.LÜ‘êñëÖThe–ê¨library“also“conš¬rtains“a“theorem“stating“that“the“constructor“ÓSTRINGŽ‘*SLÖis“injectiv˜e:ŽŸ#èŸPáŸþõQ‘0éÓSTRING_11‘>þ|-–¿ª!a“s“a'“s'.“(STRING“a“s“=“STRING“a'“s')“=“(a=a')“/\“(s=s')ŽŽŽŽŽŽŽŸ"M ‘êñëÖThis–½9theorem,‘ÆOwhic¬rh“can“bšSŽe“used“to“reason“ab˜out“the“equalitš¬ry“of“c˜haracter“strings,‘ÆOformsŽ¡‘êñëthe–ùybasis“of“the“equalitš¬ry“con˜v˜ersion“describšSŽed“in“section“1.2.4“b˜elo¬rw.‘eRAlso“built-in“areŽ¡‘êñëtheorems–yfor“doing“proSŽofs“bš¬ry“structural“induction“on“t˜ypSŽe“ÓstringŽ‘*†îÖand“for“empt˜y“vs“non-Ž¡‘êñëemptš¬ry–ê¨case“analysis“on“c˜haracter“strings:ŽŸ/ÀÙŸŸã‘‘0éÓstring_Induct–¿ª|-“!P.“P“``“/\“(!s.“P“s“==>“(!a.P(STRING“a“s)))“==>“(!s.“P“s)ŽŸ‘0éstring_CASES‘ T|-–¿ª!s.“(s“=“``)“\/“(?s'“a.“s“=“STRING“a“s')ŽŽŽŽŽŽŽŸ.þü‘êñëÖThe–[Ìtheorem“Óstring_InductŽ‘Us:Öis“in“the“correct“form“for“use“with“the“built-in“inductionŽ¡‘êñëtactic‘ðIÓINDUCT_THENŽ‘C,—Ö,‘ñ²and–ðIthe“theorem“Óstring_CASESŽ‘LÜŠÖma¬ry“bSŽe“used“with“ÓSTRUCT_CASES_TACŽ‘_êéÖ.Ž¡‘êñëSee–ê¨the“ÍHOL“Ömanš¬rual“for“details“of“these“t˜w˜o“functions.ŽŽŽŒ‹:L ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Character‘€strings’:D„5Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaâ1.2.3Ž‘E`âString‘…constanŠ=tsŽŸ‚‘ÇaÖT‘ÿVo–Ö9proš¬rvide“a“concise“notation“for“strings“in“the“ÍHOL“Ölogic,‘ÚOthe“system“parser“and“prett˜y-Ž¤‘Çaprinš¬rter–ÇÌsuppSŽorts“a“notation“for“ó.›»ˆ@ cmti12Ùstring‘'Üc‘ÿffonstants‘Å©Öis“in˜troSŽduced.‘×ìA‘Ç‚string“constan˜t“is“a“logicalŽ¡‘Çaconstanš¬rt–´Ëof“t˜ypšSŽe“ÓstringŽ‘+ç’Öwritten“b˜et•¬rw“een–´Ësingle“quotes“as“follo•¬rws:‘Í&Ó"`×cŸÌ̸1Ž‘À×:–ÿþ:“:Ž‘Š cŸÌÌó×2cmmi8¹nŽŽ‘&PÓ`"Ž‘DÜÖ.‘—ISuc“h‘´ËaŽ¡‘Çaterm–Ýshould“bšSŽe“regarded“as“an“ob‘§ject“language“abbreviation“for“the“v‘ÿXäalue“of“t¬ryp˜e“ÓstringŽŽ¡‘ÇaÖthat–¢Zrepresenš¬rts“the“ascii“c˜haracter“string“`×cŸÌ̸1Ž‘À×:–ÿþ:“:Ž‘Š cŸÌ̹nŽ‘¨PÖ'.‘ _öF‘ÿVor“example,‘Gthe“string“constan˜tŽ¡‘ÇaÓ"`ab`"Ž‘90Öis–ê¨(conceptually)“de ned“formally“b¬ry:ŽŸsÖŸ@UŸÿi‘*_Ó|-–¿ª`ab`“=“STRING(ASCII“F“T“T“F“F“F“F“T)(STRING(ASCII“F“T“T“F“F“F“T“F)``)ŽŽŽŽŽŽŽŸE[‘ÇaÖand–ê¨abbreviates“the“term“of“tš¬rypSŽe“ÓstringŽ‘*SLÖthat“represen˜ts“the“string“`ab'.ŽŸ.{‘(ðThe–˜®ÍHOL“Öparser“and“prett•¬ry-prin“ter–˜®suppSŽorts“the“c¬rharacter“string“notation“only“whenŽ¡‘Çathe‘ê«ÓstringŽ‘,SRÖlibrary–ê«has“bSŽeen“loaded.‘8èThis“is“illustrated“bš¬ry“the“follo˜wing“session,‘*«whic˜hŽ¡‘Çab•SŽegins›ê¨b“efore˜the˜library˜has˜b“een˜loaded.ŽŸ*_‡‘ÇaŸçÐ ‰ffÇ IŸ&QÌÍŸYœ„*_íffŸß÷!’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#"`abc`";;Ž¤ ‘ÌÍtype–¿ª":string"“not“defined“--“load“library“string?Ž¡‘ÌÍskipping:–¿ª“"“;;“parse“failedŽŽ’Æq°„*_íffŽŽŸÀ‰ffÇ IŽŽŽŸ*1 ‘ÇaÖHere,‘N cš¬rharacter–:*string“constan˜ts“lik˜e“Ó"`abc`"Ž‘0±úÖdo“not“parse,‘N since“the“logical“t˜ypSŽe“ÓstringŽŽ¡‘ÇaÖis–òŒnot“presenš¬rt“in“the“curren˜t“theory‘ÿV.‘PBut“the“string“notation“bSŽecomes“a˜v‘ÿXäailable“when“theŽ¡‘Çalibrary–ê¨is“loaded:ŽŸFº‘ÇaŸÌ Ö‰ffÇ IŸ]d·ÌÍŸYœ„a¾SffŸ¨˜»’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`string`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ª`string`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#"`abc`";;Ž¡‘ÌÍ"`abc`"–¿ª:“termŽŽ’Æq°„a¾SffŽŽŸÀ‰ffÇ IŽŽŽŸEà>‘ÇaÖNote–ê¨that“terms“in“the“ÍHOL“Ölogic“likš¬re“Ó"`abc`"Ž‘0öÖare“in“fact“Ùc‘ÿffonstants‘è…Öof“t˜ypSŽe“ÓstringŽ‘&h¤Ö:ŽŸ7y"‘ÇaŸÚÐ ‰ffÇ IŸ@QÌÍŸYœ„D_íffŸÅ÷!’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#is_const‘¿ª"`abc`";;Ž¤ ‘ÌÍtrue–¿ª:“boolŽŸ‘ÌÍ#type_of‘¿ª"`abc`";;Ž¡‘ÌÍ":string"–¿ª:“typeŽŽ’Æq°„D_íffŽŽŸÀ‰ffÇ IŽŽŽŸ71 ‘(ðÖLik•¬re›Ln“umerals˜in˜ÍHOLÖ,˜strings˜written˜in˜this˜notation˜form˜an˜in nite˜family˜of˜de nedŽ¡‘Çaconstan•¬rts.‘@þAs›í]suc“h,‘. their˜de nitions˜are˜not˜directly˜a“v‘ÿXäailable˜as˜theorems˜stored˜in˜aŽ¡‘Çatheory‘ÿV.‘ÔInstead,‘øa–áOde ning“equation“for“anš¬ry“giv˜en“string“constan˜t“can“bSŽe“generated“asŽ¡‘Çarequired– Tusing“the“ÓstringŽ‘(”¤Ölibrary“con•¬rv“ersion‘ TÓstring_CONVŽ‘BG¢Ö.‘îoThis– TexpSŽects“its“term“argumen¬rtŽŽŽŒ‹E( ÌU ýFÓŸú™š‘êñëÛ6’‹GChapter–€1.‘ €The“string“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖto–¡bSŽe“a“non-emptš¬ry“ascii“c˜haracter“string“constan˜t,›`for“example“Ó"`a`"Ž‘ ¿óÖ,˜Ó"`b`"Ž‘ ŲÖ,˜or“Ó"`abc`"Ž‘,?GÖ.Ž¤‘êñëGiv•¬ren›&8suc“h˜a˜term,‘5the˜con“v“ersion˜returns˜a˜theorem˜that˜de nes˜this˜constan“t˜in˜termsŽ¡‘êñëof–ê¨a“shorter“string.‘8àThis“is“bSŽest“illustrated“b¬ry“an“example:ŽŸIŒR‘êñëŸÈµ‰ffÇ IŸe€ùÌÍŸYœ„iÚ•ffŸ |y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ4ŽŽŽŽŸÿ@T‘ÌÍÓ#string_CONV‘¿ª"`abc`";;Ž¤ ‘ÌÍ|-–¿ª`abc`“=“STRING(ASCII“F“T“T“F“F“F“F“T)`bc`Ž©‘ÌÍ#string_CONV‘¿ª"`bc`";;Ž¡‘ÌÍ|-–¿ª`bc`“=“STRING(ASCII“F“T“T“F“F“F“T“F)`c`Ž¦‘ÌÍ#string_CONV‘¿ª"`c`";;Ž¡‘ÌÍ|-–¿ª`c`“=“STRING(ASCII“F“T“T“F“F“F“T“T)``ŽŽ’Æq°„iÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸIoç‘êñëÖHere,‘•~w•¬re›sSha“v“e˜used˜Óstring_CONVŽ‘H"ôÖto˜iterativ“ely˜unfold˜the˜formal˜de nition˜of˜the˜stringŽ¡‘êñëconstanš¬rt‘ê¨Ó"`abc`"Ž‘,(NÖ.‘8àNote–ê¨that“Óstring_CONVŽ‘GžÖfails“on“the“empt˜y“string“Ó"``"Ž‘éPÖ.ŽŸ#yá‘êñëâ1.2.4Ž‘‹lDecision–…prouÂcedure“for“string“equalitŠ=yŽŸùÆ‘êñëÖThe‘ÅïÓstringŽ‘* ÚÖlibrary–Åïincludes“an“optimized“con•¬rv“ersion–Åïfor“proš¬rving“equalit˜y“or“inequalit˜y“ofŽ¡‘êñëstring–žêconstanš¬rts“This“con˜v˜ersion“is“called“Óstring_EQ_CONDŽ‘T6Ö.‘¡Its“term“argumen˜t“is“expSŽectedŽ¡‘êñëto–ê¨bšSŽe“an“equation“b˜et•¬rw“een›ê¨c“haracter˜strings˜of˜the˜follo“wing˜form:ŽŸãMžV½‘0éÓ"`×:–ÿþ:“:ŽŽ› Ê Ó`–¿ª=“`×:–ÿþ:“:ŽŽ˜Ó`"ŽŽŽŽŽŽŽŸÆã‘êñëÖGiv•¬ren›Ì{suc“h˜an˜equation,‘DïÓstring_EQ_CONVŽ‘\Œ¶Öpro“v“es˜that˜it˜is˜equal˜to˜true˜if˜the˜stringŽ¡‘êñëconstanš¬rts–[{on“the“left“and“righ˜t-hand“sides“are“iden˜tical“or“equal“to“false“otherwise.‘‹YTheŽ¡‘êñëfollo¬rwing–ê¨session“illustrates“Óstring_EQ_CONVŽ‘XPœÖin“use:ŽŸ]%í‘êñ럴’µ‰ffÇ I Œ€ùÌÍŸYœ„Ú•ff ÿy|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ5ŽŽŽŽŸÿ@T‘ÌÍÓ#string_EQ_CONV–¿ª"`abc`“=“`abc`";;Ž¤ ‘ÌÍ|-–¿ª(`abc`“=“`abc`)“=“TŽ©‘ÌÍ#string_EQ_CONV–¿ª"`abc`“=“`abd`";;Ž¡‘ÌÍ|-–¿ª(`abc`“=“`abd`)“=“FŽ¦‘ÌÍ#string_EQ_CONV–¿ª"``“=“`abc`";;Ž¡‘ÌÍ|-–¿ª(``“=“`abc`)“=“FŽ¦‘ÌÍ#string_EQ_CONV–¿ª"`abc`“=“`abcdef`";;Ž¡‘ÌÍ|-–¿ª(`abc`“=“`abcdef`)“=“FŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ\ïç‘êñëÖUse–Úof“this“con•¬rv“ersion,›ôwhic“h–Úis“highly“optimised“for“spSŽeed,˜is“to“bSŽe“preferred“to“otherŽ¡‘êñëslo•¬rw“er–¿àmethoSŽds“for“proš¬rving“equalit˜y“or“inequalit˜y“of“string“constan˜ts,‘û¢for“example“rewritingŽ¡‘êñëwith–Äçthe“theorems“ÓSTRING_11Ž‘;FÈÖand“ÓASCII_11Ž‘1Â7Ö.‘,JThe“depth“con•¬rv“ersion‘ÄçÓONCE_DEPTH_CONVŽ‘]ÄÄÖma“yŽ¡‘êñëbšSŽe–R used“with“Óstring_EQ_CONVŽ‘Y ŒÖto“reduce“to“true“or“false“all“the“equations“b˜et•¬rw“een‘R stringŽ¡‘êñëconstan¬rts–ê¨that“oSŽccur“in“a“term.ŽŽŽŒ‹Qƒ ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €Using–€the“library’;«F7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç1.3Ž‘@ åUsing–Ÿ¼the“libraryŽŸâ#‘ÇaÖThe‘rÓstringŽ‘+cÖlibrary–ris“loaded“in¬rto“a“user's“ÍHOL“Ösession“using“the“function“Óload_libraryŽŽ¤‘ÇaÖ(see–Ó:the“ÍHOL“Öman¬rual“for“a“general“description“of“library“loading).‘1The“ rst“action“in“theŽ¡‘Çaload–bsequence“initiated“bš¬ry“Óload_libraryŽ‘MÀÖis“to“upSŽdate“the“in˜ternal“ÍHOL“Ösearc˜h“paths.‘ŸAŽ¡‘Çapathname–Ø to“the“ÓstringŽ‘,.Ölibrary“is“added“to“the“searcš¬rh“path,‘bso“that“theorems“ma˜y“bSŽeŽ¡‘Çaautoloaded–ýMfrom“the“library“theories“ÓasciiŽ‘$¸ìÖand“ÓstringŽ‘&{IÖ;‘Ÿand“the“ÍHOL“Öhelp“searc¬rh“path“isŽ¡‘ÇaupSŽdated–ê¨with“a“pathname“to“online“help“ les“for“the“ÍML“Öfunctions“in“the“library‘ÿV.Ž¡‘(ðAfter–pbupšSŽdating“searc¬rh“paths,‘ˆÖthe“load“sequence“for“ÓstringŽ‘)^ÀÖdep˜ends“on“the“curren¬rt“stateŽ¡‘Çaof–çthe“ÍHOL“Ösession.‘7±If“the“system“is“in“draft“moSŽde,‘çÑthe“library“theory“ÓstringŽ‘*L2Öis“added“asŽ¡‘Çaa–\tnew“parenš¬rt“to“the“curren˜t“theory‘ÿV.‘ŽEIf“the“system“is“not“in“draft“moSŽde,‘xçbut“the“curren˜tŽ¡‘Çatheory–&‹is“an“ancestor“of“the“ÓstringŽ‘*ËÖtheory“in“the“library“(e.g.“the“user“is“in“a“fresh“ÍHOLŽ¡‘ÇaÖsession)–n}then“the“ÓstringŽ‘+ZöÖtheory“is“made“inš¬rto“the“curren˜t“theory‘ÿV.‘Ä^In“bSŽoth“cases,‘rthe“ÍMLŽ¡‘ÇaÖfunctions–½ýin“the“library“are“loaded“in¬rto“ÍHOL‘³HÖand“the“theorems“in“the“library“theories“areŽ¡‘Çaset–èup“to“bšSŽe“autoloaded“on“demand.‘8The“ÓstringŽ‘*N Ölibrary“is“at“this“p˜oinš¬rt“fully“loaded“in˜toŽ¡‘Çathe–ê¨user's“ÍHOL“Ösession.ŽŸ"Ó‘Çaâ1.3.1Ž‘E`âExample‘…sessionŽŸÀ‘ÇaÖThe–kñfolloš¬rwing“session“sho˜ws“ho˜w“the“ÓstringŽ‘+UÞÖlibrary“ma˜y“bSŽe“loaded“using“Óload_libraryŽ‘IgéÖ.Ž¡‘ÇaSupp•SŽose,›6b“eginning–ÿçin“a“fresh“ÍHOL“Ösession,˜the“user“wishes“to“create“a“theory“ÓfooŽ‘>ÌÖwhoseŽ¡‘Çaparenš¬rts–ê¨include“the“theories“in“the“ÓstringŽ‘*SLÖlibrary‘ÿV.‘8àThis“ma˜y“bSŽe“done“as“follo˜ws:ŽŸ?±.‘ÇaŸË¬ ‰ffÇ IŸ^NNÌÍŸYœ„b§êffŸ§¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#new_theory‘¿ª`foo`;;Ž¤ ‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#load_library‘¿ª`string`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¡‘ÌÍLibrary–¿ª`string`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„b§êffŽŽŸÀ‰ffÇ IŽŽŽ©?—“‘ÇaÖLoading–œthe“library“while“drafting“the“theory“ÓfooŽ‘vþÖmakš¬res“the“library“theory“ÓstringŽ‘+µüÖin˜toŽ¡‘Çaa–¿parenš¬rt“of“ÓfooŽ‘þÖ.‘¶1The“same“e ect“could“ha˜v˜e“bSŽeen“ac˜hiev˜ed“(in“a“fresh“session)“b˜y“ rstŽ¡‘Çaloading–ê¨the“library“and“then“creating“ÓfooŽ‘)¦Ö:Ž¦‘ÇaŸË¬ ‰ffÇ IŸ^NNÌÍŸYœ„b§êffŸ§¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`string`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ª`string`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#new_theory‘¿ª`foo`;;Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„b§êffŽŽŸÀ‰ffÇ IŽŽŽ¦‘ÇaÖHere,‘Üthe–x”theory“ÓstringŽ‘-o$Öis“ rst“made“the“curren¬rt“theory“of“the“new“session.‘ â£It“thenŽ¡‘Çaautomatically–ê¨bSŽecomes“a“parenš¬rt“of“ÓfooŽ‘NÖwhen“this“theory“is“created“b˜y“Ónew_theoryŽ‘=gLÖ.ŽŽŽŒ‹\Ž ÌU ýFÓŸú™š‘êñëÛ8’‹GChapter–€1.‘ €The“string“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖNo¬rw,‘ÌïsuppšSŽose–Åthat“ÓfooŽ‘ÊÖhas“b˜een“created“as“sho¬rwn“ab˜o•¬rv“e,‘Ìïand–Åthe“user“do˜es“some“w¬rorkŽ¤‘êñëin–»¾this“theory‘ÿV,‘Å quits“ÍHOL‘± Öand“in“a“later“session“wishes“to“load“the“theory“ÓfooŽ‘ú¼Ö.‘)=This“m¬rustŽ¡‘êñëbSŽe–ê¨done“b¬ry“Ù rst‘ìÖloading“the“ÓstringŽ‘*SLÖlibrary“and“Ùthen‘ÐXÖloading“the“theory“ÓfooŽ‘)¦Ö.ŽŸK©J‘êñëŸÅ, ‰ffÇ IŸkNNÌÍŸYœ„o§êffŸš¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`string`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ª`string`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#load_theory‘¿ª`foo`;;Ž¡‘ÌÍTheory–¿ªfoo“loadedŽ¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„o§êffŽŽŸÀ‰ffÇ IŽŽŽŸK¯‘êñëÖThis–§_sequence“of“actions“ensures“that“the“system“can“ nd“the“paren¬rt“theory“ÓstringŽ‘)̺ÖwhenŽ¡‘êñëit–ê¨comes“to“load“ÓfooŽ‘)¦Ö,“since“loading“the“library“upSŽdates“the“searc¬rh“path.ŽŸ"Ê«‘êñëâ1.3.2Ž‘‹lThe–…ëIload‘è;‰ff‰7Ž‘qrstring“âfunctionŽŸÀ‘êñëÖThe‘Ý·ÓstringŽ‘,9jÖlibrary–Ý·maš¬ry“in“man˜y“cases“simply“bSŽe“loaded“in˜to“the“system“as“illustratedŽ¡‘êñëbš¬ry–àUthe“examples“giv˜en“abSŽo˜v˜e.‘5oThere“are,–âfho˜w˜ev˜er,“certain–àUsituations“in“whic˜h“the“ÓstringŽŽ¡‘êñëÖlibrary–š]cannot“bšSŽe“fully“loaded“at“the“time“when“the“Óload_libraryŽ‘N0²Öis“used.‘HThis“o˜ccursŽ¡‘êñëwhen–¤wthe“system“is“not“in“draft“moSŽde“and“the“curren¬rt“theory“is“not“an“ancestor“of“theŽ¡‘êñëtheory‘ò¡ÓstringŽ‘'pÖ.‘PÌIn–ò¡this“case,‘4 loading“the“library“can“and“will“upSŽdate“the“searc¬rh“paths,Ž¡‘êñëas–6pusual.‘7But“the“ÓstringŽ‘*êÜÖtheory“in“the“library“can“neither“bSŽe“made“inš¬rto“a“paren˜t“of“theŽ¡‘êñëcurrenš¬rt–ÍÜtheory“nor“can“it“bSŽe“made“the“curren˜t“theory‘ÿV.‘/GThis“means“that“autoloading“fromŽ¡‘êñëthe–..library“cannot“at“this“stage“bšSŽe“activ‘ÿXäated.‘ qNor“can“the“ÍML“Öco˜de“in“the“library“b˜eŽ¡‘êñëloaded–ê¨in¬rto“ÍHOLÖ,“since“it“requires“access“to“some“of“the“theorems“in“the“library‘ÿV.Ž¡‘öSzIn–1Tthe“situation“describšSŽed“ab˜o•¬rv“e|when–1Tthe“system“is“not“in“draft“mo˜de“and“the“curren¬rtŽ¡‘êñëtheory– is“not“an“ancestor“of“the“theory“ÓstringŽ‘&ŠÖ|the“library“load“sequence“de nes“an“ÍMLŽ¡‘êñëÖfunction–n0called“Óload_stringŽ‘F®Öin“the“currenš¬rt“ÍHOL“Ösession.‘cIf“at“a“future“pSŽoin˜t“in“the“sessionŽ¡‘êñëthe‘>TÓstringŽ‘(ú¤Ötheory–>T(noš¬rw“accessible“via“the“searc˜h“path)“bSŽecomes“an“ancestor“of“the“curren˜tŽ¡‘êñëtheory›ÿV,–ê¨this“function“can“then“bSŽe“used“to“complete“loading“of“the“library˜.‘8àEv‘ÿXäaluatingŽ¤ŸŸý‘‘0éÓload_string();;ŽŽŽŽŽŽŽ¡‘êñëÖin–Àqsucš¬rh“a“con˜text“loads“the“ÍML“Öfunctions“of“the“ÓstringŽ‘+þÞÖlibrary“in˜to“ÍHOL“Öand“activ‘ÿXäatesŽ¤‘êñëautoloading–R(from“its“theory“ les.‘o`The“function“Óload_stringŽ‘GàžÖfails“if“the“theory“ÓstringŽ‘+"LÖisŽ¡‘êñënot–ê¨a“parenš¬rt“of“the“curren˜t“theory‘ÿV.Ž¡‘öSzNote–¡'that“the“function“Óload_stringŽ‘F~œÖbSŽecomes“a¬rv‘ÿXäailable“when“loading“the“ÓstringŽ‘)ÀJÖlibraryŽ¡‘êñëonly–yÏif“the“ÓstringŽ‘+qšÖtheory“at“that“pšSŽoin¬rt“can“neither“b˜e“made“inš¬rto“a“new“paren˜t“(i.e.“theŽ¡‘êñësystem–ê¨is“not“in“draft“mošSŽde)“nor“b˜e“made“the“curren¬rt“theory‘ÿV.ŽŽŽŒ‹ i" ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|ŸGëHML– ‰‹F‘ýunctions“in“the“string“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–úcš¬rhapter“pro˜vides“doSŽcumen˜tation“on“all“the“ÍML“Öfunctions“that“are“made“a˜v‘ÿXäailable“inŽ¤ÍHOL–O}Öwhen“the“ÓstringŽ‘+öÖlibrary“is“loaded.‘g^This“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“online“viaŽ¡the‘ê¨ÓhelpŽ‘ÓøÖfacilit¬ry‘ÿV.ŽŸ'ßuŸ-pŸé8ö‰ffÇBXŸÇ ÌÍŸÇ „'ŽffŸñ•‘ÌÍóJßêþÓ"ASCII–¿ªa1“a2“a3“a4“a5“a6“a7“a8“=“ASCII“b1“b2“b3“b4“b5“b6“b7“b8"ŽŸÏéÖwhere–eacš¬rh“of“Óa1Ö,– Õ...,“Óa8Ö,“Ób1Ö,“...,“Ób8–Öis“either“the“constan˜t“ÓT‘ùÖor“the“constan˜t“ÓFÖ.“Giv˜en“suc˜hŽ¡a–ê¨term,“the“con•¬rv“ersion‘ê¨returns:Ž¦‘>þÓ|-–¿ª(ASCII“a1“a2“a3“a4“a5“a6“a7“a8“=“ASCII“b1“b2“b3“b4“b5“b6“b7“b8)“=“TŽŸÏéÖif–ê¨Óai“Öis“idenš¬rtical“to“Óbi“Öfor“i“from“1“to“8.‘8àOtherwise,“the“con˜v˜ersion“returns:Ž¦‘>þÓ|-–¿ª(ASCII“a1“a2“a3“a4“a5“a6“a7“a8“=“ASCII“b1“b2“b3“b4“b5“b6“b7“b8)“=“FŽŸ'o»âF‘þž¸ailureŽ¡ÖF‘ÿVails–ê¨if“applied“to“a“term“that“is“not“of“the“form“shoš¬rwn“abSŽo˜v˜e.ŽŸŸÒâSee‘…alsoŽŸ ™šÓstring_EQ_CONV.ŽŽŸ$ý’óŸÛ9ŽŽŒ‹ v5 ÌU ýFÓŸú™š‘êñëÛ10’ŸT‚Chapter–€2.‘ €ML“F‘þàunctions“in“the“string“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ «‘êñëŸè[»‰ffÇBXŸ¤EÌÍŸ¤D„)H‰ffŸïd‘ÌÍëJload_stringŽŽ’ÆÛò„)H‰ffŽŽŸ ª‰ffÇBXŽŽŽŸ/ù‘êñëÓload_string–¿ª:“(void“->“void)Ž©)Ö‘êñëâSynopsisŽ¤‘êñëÖLoads–„IML‘ƒßfunctions“in“the“string“library“and“sets“up“autoloading“of“theorems“in“theŽ¡‘êñëlibrary‘ÿV.Ž¦‘êñëâDescriptionŽ¡‘êñëÖIf–hthe“user“is“not“in“draft“moSŽde,‘àor“the“curren¬rt“theory“is“not“an“ancestor“of“the“library“theoryŽ¡‘êñëÓstringÖ,‘then–êIthe“con•¬rten“ts–êIof“the“string“library“cannot“immediately“bSŽe“made“a¬rv‘ÿXäailable“whenŽ¡‘êñëthe–Nlibrary“is“loaded,‘¡“since“the“theory“Óstring“Öcan“neither“bSŽe“made“a“parenš¬rt“of“the“curren˜tŽ¡‘êñëtheory–7Ãnor“loaded“using“Óload_theoryÖ.‘ 0In“this“case,‘K the“library“load“sequence“de nes“theŽ¡‘êñëfunction–N8Óload_stringÖ.‘»Calling“this“function“when“the“library“theory“Óstring“Öis“an“ancestorŽ¡‘êñëof–|ýthe“curren¬rt“theory“completes“the“library“load“sequence“for“the“string“library‘ÿV,‘¡’makingŽ¡‘êñëa¬rv›ÿXäailable–ê¨the“ML“functions“in“the“library“and“activ˜ating“autoloading“of“theorems.Ž¦‘êñëâF‘þž¸ailureŽ¡‘êñëÖF›ÿVails–ê¨if“the“theory“Óstring“Öis“not“an“ancestor“of“the“curren¬rt“theory˜.ŽŸ&}‚Ÿ «‘êñëŸè[»‰ffÇBXŸ¤EÌÍŸ¤D„)H‰ffŸïd‘ÌÍëJstring_CONVŽŽ’ÆÛò„)H‰ffŽŽŸ ª‰ffÇBXŽŽŽŸ/g‘êñëÓstring_CONV–¿ª:“convŽ¦‘êñëâSynopsisŽ¡‘êñëÖAxiom-scš¬rheme–ê¨for“c˜haracter“string“constan˜ts.Ž¦‘êñëâDescriptionŽ¡‘êñëÖThe›Šþcon•¬rv“ersion˜Óstring_CONV‘ŠæÖexpSŽects˜its˜term˜argumen“t˜to˜bSŽe˜a˜non-empt“y˜ascii˜c“haracterŽ¡‘êñëstring–h¾constanš¬rt“(for“example:‘÷ëÓ"`a`"Ö,–‚¹Ó"`b`"Ö,“Ó"`abc`"Ö).‘ ’Giv˜en–h¾suc˜h“a“term,‘‚¹for“example“theŽ¡‘êñëterm–[åÓ"`abc`"Ö,‘x4the“con•¬rv“ersion–[åreturns“a“theorem“that“de nes“this“constan¬rt“in“terms“of“aŽ¡‘êñëshorter‘ê¨string:ŽŸ.…‘ü0éÓ|-–¿ª`abc`“=“STRING(ASCII“F“T“T“F“F“F“F“T)`bc`ŽŸ”ë‘êñëÖwhere›SÑÓ(ASCII–¿ªF“T“T“F“F“F“F“T)‘S¶Öis˜the˜ascii˜c•¬rharacter˜coSŽde˜for˜the˜ rst˜c“haracter˜in˜theŽ¡‘êñësupplied–ê¨string“(in“this“case“Ó`a`Ö).ŽŽŽŒ‹ |¿ ÌU ýFÓŸú™š‘ÇaÛstring‘ÏZ‰ff ÏŽ–Ü)EQ‘ÏZ‰ff ÏŽ“CONV’RKÚ11Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâF‘þž¸ailureŽ¤‘ÇaÖF‘ÿVails–+if“applied“to“a“term“that“is“not“of“the“form“shoš¬rwn“abSŽo˜v˜e“or“if“applied“to“the“empt˜yŽ¡‘Çastring‘ê¨Ó"``"Ö.Ž¤‘ÇaâSee‘…alsoŽŸ ™š‘ÇaÓstring_EQ_CONV.ŽŸ)Ÿ «‘ÇaŸè[»‰ffÇBXŸ¤EÌÍŸ¤D„)H‰ffŸïd‘ÌÍëJstring_EQ_CONVŽŽ’ÆÛò„)H‰ffŽŽŸ ª‰ffÇBXŽŽŽŸ0»»‘ÇaÓstring_EQ_CONV–¿ª:“convŽ¡‘ÇaâSynopsisŽ©‘ÇaÖDecision-proSŽcedure–ê¨for“equalitš¬ry“of“string“constan˜ts.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖThe›=žcon•¬rv“ersion˜Óstring_EQ_CONV‘=GÖexpSŽects˜its˜term˜argumen“t˜to˜b•SŽe˜an˜equation˜b“et•¬rw“eenŽ¦‘Çacš¬rharacter–ñ¼string“constan˜ts“(for“example:‘GÓ"`a`"Ö,–ó€Ó"`b`"Ö,“Ó"`abc`"Ö,“etc).‘NGiv˜en–ñ¼suc˜h“a“term,Ž¦‘Çathe›ê¨con•¬rv“ersion˜Óstring_EQ_CONV˜Öreturns:Ž©™š‘$_Ó|-–¿ª(lhs“=“rhs)“=“TŽ¡‘ÇaÖif–ê¨Ólhs“Öand“Órhs“Öare“idenš¬rtical“c˜haracter“strings.‘8àOtherwise,“the“con˜v˜ersion“returns:Ž¦‘$_Ó|-–¿ª(lhs“=“rhs)“=“FŽŸ(‘ÇaâF‘þž¸ailureŽŸ‘ÇaÖF‘ÿVails–ê¨if“applied“to“a“term“that“is“not“of“the“form“spšSŽeci ed“ab˜o•¬rv“e.Ž¡‘ÇaâExampleŽ¦‘ÇaÓ#string_EQ_CONV–¿ª"`aax`“=“`aay`";;Ž¤ ™š‘Ça|-–¿ª(`aax`“=“`aay`)“=“FŽŸ(‘ÇaâSee‘…alsoŽ¡‘ÇaÓascii_EQ_CONV.ŽŽŽŒ‹ …< ÌU ýFÓŸú™š‘êñëÛ12’ŸT‚Chapter–€2.‘ €ML“F‘þàunctions“in“the“string“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹ Ši ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…3Ž‘ÇaŸ Ì̉Ç>|ŸGëHPre-pro–ÿ4‰v“ed‘ ‰‹TheoremsŽŸÖx‰Ç>|Ÿ:UTÖThe–³ sections“that“follo¬rw“list“all“the“de nitions“and“theorems“in“the“ÓstringŽ‘)ä<Ölibrary‘ÿV.‘&]WhenŽ¤the–Hlibrary“is“loaded,‘?õall“the“non-de nitional“theorems“in“the“library“are“set“up“to“autoloadŽ¡when–ç,their“names“are“menš¬rtioned“in“ÍMLÖ.“The“de nitions,–çÞho˜w˜ev˜er,“do–ç,not“autoload,‘çÞsinceŽ¡they–ûare“of“vš¬rery“limited“utilit˜y“to“the“user.‘iúF‘ÿVor“con˜v˜enience,‘?de nitions“and“theoremsŽ¡are–é˜listed“separately‘ÿV.‘8…The“name“of“the“theory“in“whicš¬rh“eac˜h“theorem“is“stored“is“giv˜en“inŽ¡paren¬rtheses–ê¨after“the“name“of“the“theorem.ŽŸ(Vç3.1Ž‘-C„De nitionsŽŸ'C²ÓASCII_DEF‘ ¿øÖ(ÓasciiÖ)Ž¤ ™š‘9óÓ|-–¿ª!b0“b1“b2“b3“b4“b5“b6“b7.Ž¡‘%8›ASCII–¿ªb0“b1“b2“b3“b4“b5“b6“b7“=Ž¡‘%8›ABS_ascii(Node(b0,b1,b2,b3,b4,b5,b6,b7)[])Ž©aascii_ISO_DEF‘ ¿øÖ(ÓasciiÖ)Ž¡‘9óÓ|-–¿ª(!a.“ABS_ascii(REP_ascii“a)“=“a)“/\Ž¡‘xñ(!r.Ž¡‘*øETRPŽ¡‘*øE(\v‘¿ªtl.Ž¡‘6w™(?b0–¿ªb1“b2“b3“b4“b5“b6“b7.“v“=“b0,b1,b2,b3,b4,b5,b6,b7)“/\Ž¡‘6w™(LENGTH–¿ªtl“=“0))Ž¡‘*øEr‘¿ª=Ž¡‘*øE(REP_ascii(ABS_ascii–¿ªr)“=“r))Ž¦ascii_TY_DEF‘ ¿øÖ(ÓasciiÖ)Ž¡‘9óÓ|-‘¿ª?rep.Ž¡‘%8›TYPE_DEFINITIONŽ¡‘%8›(TRPŽ¡‘*øE(\v‘¿ªtl.Ž¡‘6w™(?b0–¿ªb1“b2“b3“b4“b5“b6“b7.“v“=“b0,b1,b2,b3,b4,b5,b6,b7)“/\Ž¡‘6w™(LENGTH–¿ªtl“=“0)))Ž¡‘%8›repŽ¦STRING_DEF‘ ¿øÖ(ÓstringÖ)Ž¡‘9óÓ|-–¿ª!a“s.“STRING“a“s“=“ABS_string(Node(INR“a)[REP_string“s])ŽŽŸ$ý’烈Û13ŽŽŒ‹‹ ÌU ýFÓŸú™š‘êñëÛ14’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓstring_ISO_DEF‘ ¿øÖ(ÓstringÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª(!a.“ABS_string(REP_string“a)“=“a)“/\Ž¡‘ jÜ(!r.Ž¡‘ê0TRPŽ¡‘ê0(\v‘¿ªtl.Ž¡‘!i„(v–¿ª=“INL“one)“/\“(LENGTH“tl“=“0)“\/Ž¡‘!i„(?a.–¿ªv“=“INR“a)“/\“(LENGTH“tl“=“SUC“0))Ž¡‘ê0r‘¿ª=Ž¡‘ê0(REP_string(ABS_string–¿ªr)“=“r))Ž©a‘êñëstring_TY_DEF‘ ¿øÖ(ÓstringÖ)Ž¡‘ù+ÞÓ|-‘¿ª?rep.Ž¡‘*†TYPE_DEFINITIONŽ¡‘*†(TRPŽ¡‘ê0(\v‘¿ªtl.Ž¡‘!i„(v–¿ª=“INL“one)“/\“(LENGTH“tl“=“0)“\/Ž¡‘!i„(?a.–¿ªv“=“INR“a)“/\“(LENGTH“tl“=“SUC“0)))Ž¡‘*†repŽ¦‘êñë``_DEF‘ ¿øÖ(ÓstringÖ)Ž¡‘ù+ÞÓ|-–¿ª``“=“ABS_string(Node(INL“one)[]))ŽŸ(V‘êñëç3.2Ž‘5oTheoremsŽŸ'C²‘êñëÓASCII_11‘ ¿øÖ(ÓasciiÖ)Ž¡‘ù+ÞÓ|-–¿ª!b0“b1“b2“b3“b4“b5“b6“b7“b0'“b1'“b2'“b3'“b4'“b5'“b6'“b7'.Ž¡‘*†(ASCII–¿ªb0“b1“b2“b3“b4“b5“b6“b7“=Ž¡‘ê0ASCII–¿ªb0'“b1'“b2'“b3'“b4'“b5'“b6'“b7')“=Ž¡‘*†(b0–¿ª=“b0')“/\Ž¡‘*†(b1–¿ª=“b1')“/\Ž¡‘*†(b2–¿ª=“b2')“/\Ž¡‘*†(b3–¿ª=“b3')“/\Ž¡‘*†(b4–¿ª=“b4')“/\Ž¡‘*†(b5–¿ª=“b5')“/\Ž¡‘*†(b6–¿ª=“b6')“/\Ž¡‘*†(b7–¿ª=“b7')Ž¦‘êñëascii_Axiom‘ ¿øÖ(ÓasciiÖ)Ž¡‘ù+ÞÓ|-‘¿ª!f.Ž¡‘*†?!‘¿ªfn.Ž¡‘ê0!b0–¿ªb1“b2“b3“b4“b5“b6“b7.Ž¡‘©Úfn(ASCII–¿ªb0“b1“b2“b3“b4“b5“b6“b7)“=“f“b0“b1“b2“b3“b4“b5“b6“b7Ž¦‘êñëascii_CASES‘ ¿øÖ(ÓasciiÖ)Ž¡‘ù+ÞÓ|-–¿ª!a.“?b0“b1“b2“b3“b4“b5“b6“b7.“a“=“ASCII“b0“b1“b2“b3“b4“b5“b6“b7ŽŽŽŒ‹ö ÌU ýFÓŸú™š‘ÇaÛ3.2.‘ €Theorems’`2f15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓascii_Induct‘ ¿øÖ(ÓasciiÖ)Ž¤ ™š‘!TÓ|-‘¿ª!P.Ž¡‘7ÿü(!b0–¿ªb1“b2“b3“b4“b5“b6“b7.“P(ASCII“b0“b1“b2“b3“b4“b5“b6“b7))“==>Ž¡‘7ÿü(!a.–¿ªP“a)Ž©a‘ÇaNOT_EMPTY_STRING‘ ¿øÖ(ÓstringÖ)Ž¡‘!TÓ|-–¿ª!a“s.“~(STRING“a“s“=“``)Ž¦‘ÇaNOT_STRING_EMPTY‘ ¿øÖ(ÓstringÖ)Ž¡‘!TÓ|-–¿ª!a“s.“~(``“=“STRING“a“s)Ž¦‘ÇaSTRING_11‘ ¿øÖ(ÓstringÖ)Ž¡‘!TÓ|-–¿ª!a“s“a'“s'.“(STRING“a“s“=“STRING“a'“s')“=“(a“=“a')“/\“(s“=“s')Ž¦‘Çastring_Axiom‘ ¿øÖ(ÓstringÖ)Ž¡‘!TÓ|-–¿ª!e“f.“?!“fn.“(fn“``“=“e)“/\“(!a“s.“fn(STRING“a“s)“=“f(fn“s)a“s)Ž¦‘Çastring_CASES‘ ¿øÖ(ÓstringÖ)Ž¡‘!TÓ|-–¿ª!s.“(s“=“``)“\/“(?s'“a.“s“=“STRING“a“s')Ž¦‘Çastring_Induct‘ ¿øÖ(ÓstringÖ)Ž¡‘!TÓ|-–¿ª!P.“P“``“/\“(!s.“P“s“==>“(!a.“P(STRING“a“s)))“==>“(!s.“P“s)ŽŽŽŒ‹–m ÌU ýFÓŸú™š‘êñëÛ16’ðD,Chapter›€3.‘ €Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹™· ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸGëHReferencesŽŸ‰Ç>|Ÿ;‘ßüÖ[1]ŽŽ‘' Univ•¬rersit“y–º¥of“Cam¬rbridge,‘÷sÍDSTO›ºXÖand“ÍSRI˜ÖIn¬rternational,‘÷sÙThe‘ÅHOL‘~System:‘Ú±DESCRIP-Ž¤‘' TIONÖ,‘ê¨(1991).ŽŸ‘ßü[2]ŽŽ‘' T.F.–tMelham,‘Ê'`Automating“Recursivš¬re“T˜ypSŽe“De nitions“in“Higher“Order“Logic',‘Ê'in:Ž¡‘' ÙCurr–ÿffent› T‘ÿ™r“ends˜in˜Har“dwar“e˜V‘ÿ™eri c“ation˜and˜A³2utomate“d˜The“or“em˜Pr“oving‘ ‚Ö,‘EeditedŽ¡‘' bš¬ry–ê¨G.“Birt˜wistle“and“P‘ÿV.A.“Subrahman˜y˜am“(Springer-V‘ÿVerlag,“1989),“pp.“341{386.ŽŽŸ$ý’烈Û17ŽŽŒ‹šG ÌU ýFÓ ”/ß ýáä‘êñ럳¸ä‰Ç>|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘êñëÜ"`×:–ÿþ:“:Ž‘ Ê Ü`"–ê¨Ö(string“constan¬rts),“5{6Ž¤8‘êñëÜ``_DEFÖ,‘ê¨14Ž©J‡‘êñëÜASCII_11Ö,–ê¨2,“3,“6,“14Ž¡‘êñëÜascii_AxiomÖ,–ê¨1{2,“14Ž¡‘êñëÜascii_CASESÖ,–ê¨2,“14Ž¡‘êñëÜASCII_DEFÖ,‘ê¨13Ž¡‘êñëÜascii_EQ_CONVÖ,–ê¨3,“9Ž¡‘êñëÜascii_InductÖ,–ê¨2,“15Ž¡‘êñëÜascii_ISO_DEFÖ,‘ê¨13Ž¡‘êñëÜascii_TY_DEFÖ,‘ê¨13Ž¦‘êñëcase‘ê¨analysisŽ¡‘þñëon–ê¨t¬rypSŽe“ÜasciiÖ,“2Ž¡‘þñëon–ê¨t¬rypSŽe“ÜstringÖ,“4Ž¦‘êñëfunction‘ê¨de nitionsŽ¡‘þñëon–ê¨t¬rypSŽe“ÜasciiÖ,“2Ž¡‘þñëon–ê¨t¬rypSŽe“ÜstringÖ,“4Ž¦‘êñëÜload_stringÖ,–ê¨8,“10Ž¦‘êñëÜNOT_EMPTY_STRINGÖ,–ê¨4,“15Ž¡‘êñëÜNOT_STRING_EMPTYÖ,–ê¨4,“15Ž¦‘êñëstring–ê¨constan¬rts,“5{6Ž¡‘êñëÜSTRING_11Ö,–ê¨4,“6,“15Ž¡‘êñëÜstring_AxiomÖ,–ê¨3{4,“15Ž¡‘êñëÜstring_CASESÖ,–ê¨4,“15Ž¡‘êñëÜstring_CONVÖ,–ê¨5{6,“10Ž¡‘êñëÜSTRING_DEFÖ,‘ê¨13Ž¡‘êñëÜstring_EQ_CONVÖ,–ê¨6,“11Ž¡‘êñëÜstring_InductÖ,–ê¨4,“15Ž¡‘êñëÜstring_ISO_DEFÖ,‘ê¨14Ž¡‘êñëÜstring_TY_DEFÖ,‘ê¨14ŽŽŽ þä’à)structural–ê¨induction,“4ŽŸ’à)theoremsŽ¤’ô)abšSŽout–ê¨the“t¬ryp˜e“ÜasciiÖ,“2Ž¡’ô)abšSŽout–ê¨the“t¬ryp˜e“ÜstringÖ,“4ŽŽŽŽŽŽŸ$ý’ÇÑ)Û18ŽŽŒøœ¶ƒ’À;èÌUÚÝ óJßê*. !b0 b1 b2 b3 b4 b5 b6 b7. fn(ASCII b0 b1 b2 b3 b4 b5 b6 b7) = f b0 b1 b2 b3 b4 b5 b6 b7 \end{verbatim}\end{hol} \noindent This simply says that functions on values of type \ml{ascii} may be uniquely specified by defining them in terms of the eight boolean values from which these values are constructed. \subsection{Function definitions on type {\tt ascii}}% \index{function definitions!on type {\tt ascii}|(} The theorem \ml{ascii\_Axiom}, having been proved using the recursive types package, is in the right form for use with the derived rule of definition \ml{new\_recursive\_definition}. For example, once the \ml{string} library is loaded into \HOL, one can use this rule of definition to define a function that selects the high-order bit of an ascii character code: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #let BIT1 = new_recursive_definition false ascii_Axiom `BIT1` "BIT1(ASCII b1 b2 b3 b4 b5 b6 b7 b8) = b1";; BIT1 = |- !b1 b2 b3 b4 b5 b6 b7 b8. BIT1(ASCII b1 b2 b3 b4 b5 b6 b7 b8) = b1 \end{verbatim}\end{session} \noindent In fact, any function whatsoever on the \ml{ascii} is definable using the theorem \ml{ascii\_Axiom} and the rule \ml{new\_recursive\_definition}. \index{ascii\_Axiom@{\ptt ascii\_Axiom}|)} \index{function definitions!on type {\tt ascii}|)} \subsection{Theorems about the type {\tt ascii}}% \index{theorems!about the type {\tt ascii}|(} In addition to \ml{ascii\_Axiom}, several standard theorems about the defined type \ml{ascii} proved using the recursive types package are available as built-in theorems of the \ml{string} library. They are all set up to autoload, if possible, when the library is loaded into \HOL. The theorem \ml{ASCII\_{11}}\index{ASCII\_11@{\ptt ASCII\_11}} states that the function \ml{ASCII} is injective: \begin{hol} \begin{verbatim} |- !b0 b1 b2 b3 b4 b5 b6 b7 b0' b1' b2' b3' b4' b5' b6' b7'. (ASCII b0 b1 b2 b3 b4 b5 b6 b7 = ASCII b0' b1' b2' b3' b4' b5' b6' b7') = (b0 = b0') /\ (b1 = b1') /\ (b2 = b2') /\ (b3 = b3') /\ (b4 = b4') /\ (b5 = b5') /\ (b6 = b6') /\ (b7 = b7') \end{verbatim}\end{hol} \noindent This theorem allows one to prove equality or inequality of ascii character codes; it also forms the basis for the decision-procedure \ml{ascii\_EQ\_CONV} explained in section~\ref{ascii-eq-conv}. A degenerate `structural induction' theorem for the type \ml{ascii}, called \ml{ascii\_Induct}\index{ascii\_Induct@{\ptt ascii\_Induct}}, is also available in the library: \begin{hol} \begin{verbatim} |- !P. (!b0 b1 b2 b3 b4 b5 b6 b7. P(ASCII b0 b1 b2 b3 b4 b5 b6 b7)) ==> (!a. P a) \end{verbatim}\end{hol} \noindent This is in the standard form used by the recursive types package and can therefore be used with \ml{INDUCT\_THEN} if desired. Finally, there is the\index{case analysis!on type {\tt ascii}|(} trivial case analysis theorem \ml{ascii\_CASES}\index{ascii\_CASES@{\ptt ascii\_CASES}}: \begin{hol} \begin{verbatim} |- !a. ?b0 b1 b2 b3 b4 b5 b6 b7. a = ASCII b0 b1 b2 b3 b4 b5 b6 b7 \end{verbatim}\end{hol} \noindent This states that every value of type \ml{ascii} can be constructed using the function \ml{ASCII} and can be used, for example, with \ml{STRUCT\_CASES\_TAC} to replace variables ranging over \ml{ascii} by values explicitly constructed with\index{case analysis!on type {\tt ascii}|)} \ml{ASCII}\index{theorems!about the type {\tt ascii}|)}. \subsection{Decision procedure for ascii code equality}\label{ascii-eq-conv}% \index{ascii\_EQ\_CONV@{\ptt ascii\_EQ\_CONV}} The \ml{string} library provides a highly optimized conversion for proving equality or inequality of constant terms that represent ascii character codes, in the form of applications of the constructor \ml{ASCII} to the boolean constants \ml{T} and \ml{F}. This conversion, called \ml{ascii\_EQ\_COND}, expects its term argument to be an equation of the form: \begin{hol}\begin{alltt} "ASCII \m{a\sb{1}} \m{a\sb{2}} \m{a\sb{3}} \m{a\sb{4}} \m{a\sb{5}} \m{a\sb{6}} \m{a\sb{7}} \m{a\sb{8}} = ASCII \m{b\sb{1}} \m{b\sb{2}} \m{b\sb{3}} \m{b\sb{4}} \m{b\sb{5}} \m{b\sb{6}} \m{b\sb{7}} \m{b\sb{8}}" \end{alltt}\end{hol} \noindent where each of $a_1$, \dots, $a_8$, $b_1$, \dots, $b_8$ is either the constant \ml{T} or the constant \ml{F}. Given such an equation, \ml{ascii\_EQ\_COND} proves that it is equal to true (\ml{T}) if the left and right-hand sides represent the same ascii code or false (\ml{F}) otherwise. The following session illustrates the use of the conversion: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #ascii_EQ_CONV "ASCII T T F T T F T T = ASCII T T F T T F T T";; |- (ASCII T T F T T F T T = ASCII T T F T T F T T) = T #ascii_EQ_CONV "ASCII T T F T T F T T = ASCII T T F T T F T F";; |- (ASCII T T F T T F T T = ASCII T T F T T F T F) = F \end{verbatim}\end{session} \noindent The conversion is highly optimised and using it can be considerably faster than proving equality or inequality by, for example, rewriting with the theorem \ml{ASCII\_{11}}\index{ASCII\_11@{\ptt ASCII\_11}}. \section{Character strings} The theory \ml{string} in the library defines a logical type of ascii character strings. These are (possibly empty) sequences of character codes, and the theory \ml{ascii} is a parent of the theory \ml{string}. The type of ascii character strings, called \ml{string}, is defined formally in the library using \ml{define\_type}, with the recursive specifying equation shown below. \begin{hol}\begin{verbatim} string = `` | STRING ascii string \end{verbatim}\end{hol} \noindent Every value of type \ml{string} consists of a finite sequence of ascii character codes. These sequences are constructed using the function \ml{STRING} from the empty string represented by the constant \ml{``}. For example, the character string `ab' is represented in logic by: \begin{hol}\begin{verbatim} "STRING (ASCII F T T F F F F T) (STRING (ASCII F T T F F F T F) ``)" \end{verbatim}\end{hol} \noindent Any finite string of ascii characters can be represented in logic in a similar way. The type \ml{string} is defined in the library using the recursive types package. An abstract characterization of the type \ml{string}, in the standard form used by the recursive types package, is provided by the theorem \ml{string\_Axiom}\index{string\_Axiom@{\ptt string\_Axiom}|(}: \begin{hol} \begin{verbatim} |- !e f. ?! fn. (fn `` = e) /\ (!a s. fn(STRING a s) = f(fn s)a s) \end{verbatim}\end{hol} \noindent This theorem, which is proved automatically by \ml{define\_type}, states the validity of primitive recursive definitions on the type \ml{string}. \subsection{Function definitions on type {\tt string}}% \index{function definitions!on type {\tt string}|(} The theorem \ml{string\_Axiom} is in the standard form accepted by \ml{new\_recursive\_definition} and can therefore be used to define functions over type \ml{string} by primitive recursion. For example, one can define the length of a string as follows. \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #let LEN = new_recursive_definition false string_Axiom `LEN` "(LEN `` = 0) /\ (LEN (STRING a s) = (LEN s) + 1)";; LEN = |- (LEN `` = 0) /\ (!a s. LEN(STRING a s) = (LEN s) + 1) \end{verbatim}\end{session} \noindent Other forms of primitive recursive definition may also be made using \ml{string\_Axiom} and \ml{new\_recursive\_definition}; see the \HOL\ system documentation for details.\index{string\_Axiom@{\ptt string\_Axiom}|)}% \index{function definitions!on type {\tt string}|)} \subsection{Theorems about the type {\tt string}}% \index{theorems!about the type {\tt string}|(} For the recursive type \ml{string}, the library provides as built-in all the standard theorems provable using the recursive types package. These theorems, which are set up to autoload when the library is loaded, include theorems stating the distinctness of empty and non-empty strings: \begin{hol} \index{NOT\_EMPTY\_STRING@{\ptt NOT\_EMPTY\_STRING}} \index{NOT\_STRING\_EMPTY@{\ptt NOT\_STRING\_EMPTY}} \begin{verbatim} NOT_STRING_EMPTY |- !a s. ~(`` = STRING a s) NOT_EMPTY_STRING |- !a s. ~(STRING a s = ``) \end{verbatim}\end{hol} \noindent The library also contains a theorem stating that the constructor \ml{STRING} is injective: \begin{hol} \index{STRING\_11@{\ptt STRING\_11}} \begin{verbatim} STRING_11 |- !a s a' s'. (STRING a s = STRING a' s') = (a=a') /\ (s=s') \end{verbatim}\end{hol} \noindent This theorem, which can be used to reason about the equality of character strings, forms the basis of the equality conversion described in section~\ref{string-eq-conv} below. Also\index{structural induction|(} built-in are theorems for doing proofs by structural induction on type \ml{string} and \index{case analysis!on type {\tt string}|(} for empty vs non-empty case analysis on character strings: \begin{hol} \index{string\_Induct@{\ptt string\_Induct}} \index{string\_CASES@{\ptt string\_CASES}} \begin{verbatim} string_Induct |- !P. P `` /\ (!s. P s ==> (!a.P(STRING a s))) ==> (!s. P s) string_CASES |- !s. (s = ``) \/ (?s' a. s = STRING a s') \end{verbatim}\end{hol} \noindent The theorem \ml{string\_Induct} is in the correct form for use with the built-in induction tactic \ml{INDUCT\_THEN}, and the theorem \ml{string\_CASES} may be used with \ml{STRUCT\_CASES\_TAC}. See the \HOL\ manual for details of these two functions. \index{structural induction|)} \index{case analysis!on type {\tt string}|)} \index{theorems!about the type {\tt string}|)} \subsection{String constants} \index{string constants|(} \index{\\\@\verb+""`+$\dots$\verb+`""+ (string constants)|(} To provide a concise notation for strings in the \HOL\ logic, the system parser and pretty-printer supports a notation for {\it string constants\/} is introduced. A string constant is a logical constant of type \ml{string} written between single quotes as follows: \ml{"`\m{c\sb{1}\ldots c\sb{n}}`"}. Such a term should be regarded as an object language abbreviation for the value of type \ml{string} that represents the ascii character string `$c_1\dots c_n$'. For example, the string constant \ml{"`ab`"} is (conceptually) defined formally by: \begin{hol}\begin{verbatim} |- `ab` = STRING(ASCII F T T F F F F T)(STRING(ASCII F T T F F F T F)``) \end{verbatim}\end{hol} \noindent and abbreviates the term of type \ml{string} that represents the string `ab'. The \HOL\ parser and pretty-printer supports the character string notation only when the \ml{string} library has been loaded. This is illustrated by the following session, which begins before the library has been loaded. \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #"`abc`";; type ":string" not defined -- load library string? skipping: " ;; parse failed \end{verbatim}\end{session} \noindent Here, character string constants like \ml{"`abc`"} do not parse, since the logical type \ml{string} is not present in the current theory. But the string notation becomes available when the library is loaded: \begin{session}\begin{alltt} #load_library `string`;; \(\vdots\) Library `string` loaded. () : void #"`abc`";; "`abc`" : term \end{alltt}\end{session} \noindent Note that terms in the \HOL\ logic like \ml{"`abc`"} are in fact {\it constants\/} of type \ml{string}: \begin{session}\begin{verbatim} #is_const "`abc`";; true : bool #type_of "`abc`";; ":string" : type \end{verbatim}\end{session} Like\index{string\_CONV@{\ptt string\_CONV}|(} numerals in \HOL, strings written in this notation form an infinite family of defined constants. As such, their definitions are not directly available as theorems stored in a theory. Instead, a defining equation for any given string constant can be generated as required using the \ml{string} library conversion \ml{string\_CONV}. This\pagebreak[3] expects its term argument to be a non-empty ascii character string constant, for example \ml{"`a`"}, \ml{"`b`"}, or \ml{"`abc`"}. Given such a term, the conversion returns a theorem that defines this constant in terms of a shorter string. This is best illustrated by an example: \begin{session}\begin{verbatim} #string_CONV "`abc`";; |- `abc` = STRING(ASCII F T T F F F F T)`bc` #string_CONV "`bc`";; |- `bc` = STRING(ASCII F T T F F F T F)`c` #string_CONV "`c`";; |- `c` = STRING(ASCII F T T F F F T T)`` \end{verbatim}\end{session} \noindent Here, we have used \ml{string\_CONV} to iteratively unfold the formal definition of the string constant \ml{"`abc`"}. Note that \ml{string\_CONV} fails on the empty string \ml{"``"}. \index{string constants|)} \index{\\\@\verb+""`+$\dots$\verb+`""+ (string constants)|)} \index{string\_CONV@{\ptt string\_CONV}|)} \subsection{Decision procedure for string equality}\label{string-eq-conv}% \index{string\_EQ\_CONV@{\ptt string\_EQ\_CONV}|(} The \ml{string} library includes an optimized conversion for proving equality or inequality of string constants This conversion is called \ml{string\_EQ\_COND}. Its term argument is expected to be an equation between character strings of the following form: \begin{hol}\begin{alltt} "`\m{\ldots}` = `\m{\ldots}`" \end{alltt}\end{hol} \noindent Given such an equation, \ml{string\_EQ\_CONV} proves that it is equal to true if the string constants on the left and right-hand sides are identical or equal to false otherwise. The following session illustrates \ml{string\_EQ\_CONV} in use: \begin{session}\begin{verbatim} #string_EQ_CONV "`abc` = `abc`";; |- (`abc` = `abc`) = T #string_EQ_CONV "`abc` = `abd`";; |- (`abc` = `abd`) = F #string_EQ_CONV "`` = `abc`";; |- (`` = `abc`) = F #string_EQ_CONV "`abc` = `abcdef`";; |- (`abc` = `abcdef`) = F \end{verbatim}\end{session} \noindent Use of this conversion, which is highly optimised for speed, is to be preferred to other slower methods for proving equality or inequality of string constants, for example rewriting with the theorems \ml{STRING\_{11}}\index{STRING\_11@{\ptt STRING\_11}} and \ml{ASCII\_{11}}\index{ASCII\_11@{\ptt ASCII\_11}}. The depth conversion \ml{ONCE\_DEPTH\_CONV} may be used with \ml{string\_EQ\_CONV} to reduce to true or false all the equations between string constants that\pagebreak[3] occur in a term.\index{string\_EQ\_CONV@{\ptt string\_EQ\_CONV}|)} \section{Using the library} The \ml{string} library is loaded into a user's \HOL\ session using the function \ml{load\_library} (see the \HOL\ manual for a general description of library loading). The first action in the load sequence initiated by \ml{load\_library} is to update the internal \HOL\ search paths. A pathname to the \ml{string} library is added to the search path, so that theorems may be autoloaded from the library theories \ml{ascii} and \ml{string}; and the \HOL\ help search path is updated with a pathname to online help files for the \ML\ functions in the library. After updating search paths, the load sequence for \ml{string} depends on the current state of the \HOL\ session. If the system is in draft mode, the library theory \ml{string} is added as a new parent to the current theory. If the system is not in draft mode, but the current theory is an ancestor of the \ml{string} theory in the library (e.g.\ the user is in a fresh \HOL\ session) then the \ml{string} theory is made into the current theory. In both cases, the \ML\ functions in the library are loaded into \HOL\, and the theorems in the library theories are set up to be autoloaded on demand. The \ml{string} library is at this point fully loaded into the user's \HOL\ session. \subsection{Example session} The following session shows how the \ml{string} library may be loaded using \ml{load\_library}. Suppose, beginning in a fresh \HOL\ session, the user wishes to create a theory \ml{foo} whose parents include the theories in the \ml{string} library. This may be done as follows: \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #new_theory `foo`;; () : void #load_library `string`;; \(\vdots\) Library `string` loaded. () : void \end{alltt}\end{session} \noindent Loading the library while drafting the theory \ml{foo} makes the library theory \ml{string} into a parent of \ml{foo}. The same effect could have been achieved (in a fresh session) by first loading the library and then creating \ml{foo}: \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #load_library `string`;; \(\vdots\) Library `string` loaded. () : void #new_theory `foo`;; () : void \end{alltt}\end{session} \noindent Here, the theory \ml{string} is first made the current theory of the new session. It then automatically becomes a parent of \ml{foo} when this theory is created by\pagebreak[3] \ml{new\_theory}. Now, suppose that \ml{foo} has been created as shown above, and the user does some work in this theory, quits \HOL\, and in a later session wishes to load the theory \ml{foo}. This must be done by {\it first\/} loading the \ml{string} library and {\it then\/} loading the theory \ml{foo}. \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #load_library `string`;; \(\vdots\) Library `string` loaded. () : void #load_theory `foo`;; Theory foo loaded () : void \end{alltt}\end{session} \noindent This sequence of actions ensures that the system can find the parent theory \ml{string} when it comes to load \ml{foo}, since loading the library updates the search path. \subsection{The {\tt load\_string} function}% \index{load\_string@{\ptt load\_string}|(} The \ml{string} library may in many cases simply be loaded into the system as illustrated by the examples given above. There are, however, certain situations in which the \ml{string} library cannot be fully loaded at the time when the \ml{load\_library} is used. This occurs when the system is not in draft mode and the current theory is not an ancestor of the theory \ml{string}. In this case, loading the library can and will update the search paths, as usual. But the \ml{string} theory in the library can neither be made into a parent of the current theory nor can it be made the current theory. This means that autoloading from the library cannot at this stage be activated. Nor can the \ML\ code in the library be loaded into \HOL, since it requires access to some of the theorems in the library. In the situation described above---when the system is not in draft mode and the current theory is not an ancestor of the theory \ml{string}---the library load sequence defines an \ML\ function called \ml{load\_string} in the current \HOL\ session. If at a future point in the session the \ml{string} theory (now accessible via the search path) becomes an ancestor of the current theory, this function can then be used to complete loading of the library. Evaluating \begin{hol}\begin{verbatim} load_string();; \end{verbatim}\end{hol} \noindent in such a context loads the \ML\ functions of the \ml{string} library into \HOL\ and activates autoloading from its theory files. The function \ml{load\_string} fails if the theory \ml{string} is not a parent of the current theory. Note that the function \ml{load\_string} becomes available when loading the \ml{string} library only if the \ml{string} theory at that point can neither be made into a new parent (i.e.\ the system is not in draft mode) nor be made the current theory. \index{load\_string@{\ptt load\_string}|)} hol88-2.02.19940316/Library/string/Manual/entries.tex0000640000212700021270000001030505535606175020261 0ustar cammcamm\chapter{ML Functions in the string Library} \input{entries-intro} \DOC{ascii\_EQ\_CONV} \TYPE {\small\verb%ascii_EQ_CONV : conv%}\egroup \SYNOPSIS Decision-procedure for equality of ascii character constants. \DESCRIBE The conversion {\small\verb%ascii_EQ_CONV%} implements a decision procedure for the equality of ascii character constants built up from boolean constants {\small\verb%T%} and {\small\verb%F%} using the constructor {\small\verb%ASCII%}. The conversion expects its term argument to be an equation of the form: {\par\samepage\setseps\small \begin{verbatim} "ASCII a1 a2 a3 a4 a5 a6 a7 a8 = ASCII b1 b2 b3 b4 b5 b6 b7 b8" \end{verbatim} } \noindent where each of {\small\verb%a1%}, ..., {\small\verb%a8%}, {\small\verb%b1%}, ..., {\small\verb%b8%} is either the constant {\small\verb%T%} or the constant {\small\verb%F%}. Given such a term, the conversion returns: {\par\samepage\setseps\small \begin{verbatim} |- (ASCII a1 a2 a3 a4 a5 a6 a7 a8 = ASCII b1 b2 b3 b4 b5 b6 b7 b8) = T \end{verbatim} } \noindent if {\small\verb%ai%} is identical to {\small\verb%bi%} for i from 1 to 8. Otherwise, the conversion returns: {\par\samepage\setseps\small \begin{verbatim} |- (ASCII a1 a2 a3 a4 a5 a6 a7 a8 = ASCII b1 b2 b3 b4 b5 b6 b7 b8) = F \end{verbatim} } \FAILURE Fails if applied to a term that is not of the form shown above. \SEEALSO string_EQ_CONV. \ENDDOC \DOC{load\_string} \TYPE {\small\verb%load_string : (void -> void)%}\egroup \SYNOPSIS Loads ML functions in the string library and sets up autoloading of theorems in the library. \DESCRIBE If the user is not in draft mode, or the current theory is not an ancestor of the library theory {\small\verb%string%}, then the contents of the string library cannot immediately be made available when the library is loaded, since the theory {\small\verb%string%} can neither be made a parent of the current theory nor loaded using {\small\verb%load_theory%}. In this case, the library load sequence defines the function {\small\verb%load_string%}. Calling this function when the library theory {\small\verb%string%} is an ancestor of the current theory completes the library load sequence for the string library, making available the ML functions in the library and activating autoloading of theorems. \FAILURE Fails if the theory {\small\verb%string%} is not an ancestor of the current theory. \ENDDOC \DOC{string\_CONV} \TYPE {\small\verb%string_CONV : conv%}\egroup \SYNOPSIS Axiom-scheme for character string constants. \DESCRIBE The conversion {\small\verb%string_CONV%} expects its term argument to be a non-empty ascii character string constant (for example: {\small\verb%"`a`"%}, {\small\verb%"`b`"%}, {\small\verb%"`abc`"%}). Given such a term, for example the term {\small\verb%"`abc`"%}, the conversion returns a theorem that defines this constant in terms of a shorter string: {\par\samepage\setseps\small \begin{verbatim} |- `abc` = STRING(ASCII F T T F F F F T)`bc` \end{verbatim} } \noindent where {\small\verb%(ASCII F T T F F F F T)%} is the ascii character code for the first character in the supplied string (in this case {\small\verb%`a`%}). \FAILURE Fails if applied to a term that is not of the form shown above or if applied to the empty string {\small\verb%"``"%}. \SEEALSO string_EQ_CONV. \ENDDOC \DOC{string\_EQ\_CONV} \TYPE {\small\verb%string_EQ_CONV : conv%}\egroup \SYNOPSIS Decision-procedure for equality of string constants. \DESCRIBE The conversion {\small\verb%string_EQ_CONV%} expects its term argument to be an equation between character string constants (for example: {\small\verb%"`a`"%}, {\small\verb%"`b`"%}, {\small\verb%"`abc`"%}, etc). Given such a term, the conversion {\small\verb%string_EQ_CONV%} returns: {\par\samepage\setseps\small \begin{verbatim} |- (lhs = rhs) = T \end{verbatim} } \noindent if {\small\verb%lhs%} and {\small\verb%rhs%} are identical character strings. Otherwise, the conversion returns: {\par\samepage\setseps\small \begin{verbatim} |- (lhs = rhs) = F \end{verbatim} } \FAILURE Fails if applied to a term that is not of the form specified above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #string_EQ_CONV "`aax` = `aay`";; |- (`aax` = `aay`) = F \end{verbatim} } \SEEALSO ascii_EQ_CONV. \ENDDOC hol88-2.02.19940316/Library/string/Manual/theorems.tex0000640000212700021270000000501605535606201020427 0ustar cammcamm\chapter{Pre-proved Theorems} \input{theorems-intro} \section{Definitions} \THEOREM ASCII\_DEF ascii |- !b0 b1 b2 b3 b4 b5 b6 b7. ASCII b0 b1 b2 b3 b4 b5 b6 b7 = ABS_ascii(Node(b0,b1,b2,b3,b4,b5,b6,b7)[]) \ENDTHEOREM \THEOREM ascii\_ISO\_DEF ascii |- (!a. ABS_ascii(REP_ascii a) = a) /\ (!r. TRP (\v tl. (?b0 b1 b2 b3 b4 b5 b6 b7. v = b0,b1,b2,b3,b4,b5,b6,b7) /\ (LENGTH tl = 0)) r = (REP_ascii(ABS_ascii r) = r)) \ENDTHEOREM \THEOREM ascii\_TY\_DEF ascii |- ?rep. TYPE_DEFINITION (TRP (\v tl. (?b0 b1 b2 b3 b4 b5 b6 b7. v = b0,b1,b2,b3,b4,b5,b6,b7) /\ (LENGTH tl = 0))) rep \ENDTHEOREM \THEOREM STRING\_DEF string |- !a s. STRING a s = ABS_string(Node(INR a)[REP_string s]) \ENDTHEOREM \THEOREM string\_ISO\_DEF string |- (!a. ABS_string(REP_string a) = a) /\ (!r. TRP (\v tl. (v = INL one) /\ (LENGTH tl = 0) \/ (?a. v = INR a) /\ (LENGTH tl = SUC 0)) r = (REP_string(ABS_string r) = r)) \ENDTHEOREM \THEOREM string\_TY\_DEF string |- ?rep. TYPE_DEFINITION (TRP (\v tl. (v = INL one) /\ (LENGTH tl = 0) \/ (?a. v = INR a) /\ (LENGTH tl = SUC 0))) rep \ENDTHEOREM \THEOREM ``\_DEF string |- `` = ABS_string(Node(INL one)[])) \ENDTHEOREM \section{Theorems} \THEOREM ASCII\_11 ascii |- !b0 b1 b2 b3 b4 b5 b6 b7 b0' b1' b2' b3' b4' b5' b6' b7'. (ASCII b0 b1 b2 b3 b4 b5 b6 b7 = ASCII b0' b1' b2' b3' b4' b5' b6' b7') = (b0 = b0') /\ (b1 = b1') /\ (b2 = b2') /\ (b3 = b3') /\ (b4 = b4') /\ (b5 = b5') /\ (b6 = b6') /\ (b7 = b7') \ENDTHEOREM \THEOREM ascii\_Axiom ascii |- !f. ?! fn. !b0 b1 b2 b3 b4 b5 b6 b7. fn(ASCII b0 b1 b2 b3 b4 b5 b6 b7) = f b0 b1 b2 b3 b4 b5 b6 b7 \ENDTHEOREM \THEOREM ascii\_CASES ascii |- !a. ?b0 b1 b2 b3 b4 b5 b6 b7. a = ASCII b0 b1 b2 b3 b4 b5 b6 b7 \ENDTHEOREM \THEOREM ascii\_Induct ascii |- !P. (!b0 b1 b2 b3 b4 b5 b6 b7. P(ASCII b0 b1 b2 b3 b4 b5 b6 b7)) ==> (!a. P a) \ENDTHEOREM \THEOREM NOT\_EMPTY\_STRING string |- !a s. ~(STRING a s = ``) \ENDTHEOREM \THEOREM NOT\_STRING\_EMPTY string |- !a s. ~(`` = STRING a s) \ENDTHEOREM \THEOREM STRING\_11 string |- !a s a' s'. (STRING a s = STRING a' s') = (a = a') /\ (s = s') \ENDTHEOREM \THEOREM string\_Axiom string |- !e f. ?! fn. (fn `` = e) /\ (!a s. fn(STRING a s) = f(fn s)a s) \ENDTHEOREM \THEOREM string\_CASES string |- !s. (s = ``) \/ (?s' a. s = STRING a s') \ENDTHEOREM \THEOREM string\_Induct string |- !P. P `` /\ (!s. P s ==> (!a. P(STRING a s))) ==> (!s. P s) \ENDTHEOREM hol88-2.02.19940316/Library/string/Manual/entries.aux0000640000212700021270000000133605535606241020254 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {2}ML Functions in the string Library}{9}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \global\@namedef{cp@entries}{ \setcounter{page}{12} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{2} \setcounter{section}{0} \setcounter{subsection}{2} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/string/Manual/theorems.aux0000640000212700021270000000163205535606242020431 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {3}Pre-proved Theorems}{13}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.1}Definitions}{13}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.2}Theorems}{14}} \global\@namedef{cp@theorems}{ \setcounter{page}{16} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{2} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/string/Manual/references.aux0000640000212700021270000000116505535606242020725 0ustar cammcamm\relax \bibcite{description}{1} \bibcite{melham}{2} \@writefile{toc}{\string\contentsline\space {chapter}{References}{17}} \global\@namedef{cp@references}{ \setcounter{page}{18} \setcounter{equation}{0} \setcounter{enumi}{2} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{2} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/string/Manual/index.aux0000640000212700021270000000107605535606243017715 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{Index}{18}} \global\@namedef{cp@index}{ \setcounter{page}{19} \setcounter{equation}{0} \setcounter{enumi}{2} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{2} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/string/help/0000750000212700021270000000000005227250233015565 5ustar cammcammhol88-2.02.19940316/Library/string/help/defs/0000750000212700021270000000000005227267054016517 5ustar cammcammhol88-2.02.19940316/Library/string/help/defs/ASCII_DEF.doc0000640000212700021270000000022505026435556020515 0ustar cammcamm\THEOREM ASCII_DEF ascii |- !b0 b1 b2 b3 b4 b5 b6 b7. ASCII b0 b1 b2 b3 b4 b5 b6 b7 = ABS_ascii(Node(b0,b1,b2,b3,b4,b5,b6,b7)[]) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/defs/ascii_ISO_DEF.doc0000640000212700021270000000036405026435556021473 0ustar cammcamm\THEOREM ascii_ISO_DEF ascii |- (!a. ABS_ascii(REP_ascii a) = a) /\ (!r. TRP (\v tl. (?b0 b1 b2 b3 b4 b5 b6 b7. v = b0,b1,b2,b3,b4,b5,b6,b7) /\ (LENGTH tl = 0)) r = (REP_ascii(ABS_ascii r) = r)) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/defs/ascii_TY_DEF.doc0000640000212700021270000000027605026435557021400 0ustar cammcamm\THEOREM ascii_TY_DEF ascii |- ?rep. TYPE_DEFINITION (TRP (\v tl. (?b0 b1 b2 b3 b4 b5 b6 b7. v = b0,b1,b2,b3,b4,b5,b6,b7) /\ (LENGTH tl = 0))) rep \ENDTHEOREM hol88-2.02.19940316/Library/string/help/defs/STRING_DEF.doc0000640000212700021270000000014305026456504020666 0ustar cammcamm\THEOREM STRING_DEF string |- !a s. STRING a s = ABS_string(Node(INR a)[REP_string s]) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/defs/``_DEF.doc0000640000212700021270000000011005026456572020236 0ustar cammcamm\THEOREM ``_DEF string |- `` = ABS_string(Node(INL one)[])) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/defs/string_ISO_DEF.doc0000640000212700021270000000037205026456504021704 0ustar cammcamm\THEOREM string_ISO_DEF string |- (!a. ABS_string(REP_string a) = a) /\ (!r. TRP (\v tl. (v = INL one) /\ (LENGTH tl = 0) \/ (?a. v = INR a) /\ (LENGTH tl = SUC 0)) r = (REP_string(ABS_string r) = r)) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/defs/string_TY_DEF.doc0000640000212700021270000000030005026456504021575 0ustar cammcamm\THEOREM string_TY_DEF string |- ?rep. TYPE_DEFINITION (TRP (\v tl. (v = INL one) /\ (LENGTH tl = 0) \/ (?a. v = INR a) /\ (LENGTH tl = SUC 0))) rep \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/0000750000212700021270000000000005227267134016550 5ustar cammcammhol88-2.02.19940316/Library/string/help/thms/ASCII_11.doc0000640000212700021270000000050105026435555020366 0ustar cammcamm\THEOREM ASCII_11 ascii |- !b0 b1 b2 b3 b4 b5 b6 b7 b0' b1' b2' b3' b4' b5' b6' b7'. (ASCII b0 b1 b2 b3 b4 b5 b6 b7 = ASCII b0' b1' b2' b3' b4' b5' b6' b7') = (b0 = b0') /\ (b1 = b1') /\ (b2 = b2') /\ (b3 = b3') /\ (b4 = b4') /\ (b5 = b5') /\ (b6 = b6') /\ (b7 = b7') \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/ascii_CASES.doc0000640000212700021270000000015205026435556021246 0ustar cammcamm\THEOREM ascii_CASES ascii |- !a. ?b0 b1 b2 b3 b4 b5 b6 b7. a = ASCII b0 b1 b2 b3 b4 b5 b6 b7 \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/ascii_Induct.doc0000640000212700021270000000020205026641240021617 0ustar cammcamm\THEOREM ascii_Induct ascii |- !P. (!b0 b1 b2 b3 b4 b5 b6 b7. P(ASCII b0 b1 b2 b3 b4 b5 b6 b7)) ==> (!a. P a) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/ascii_Axiom.doc0000640000212700021270000000023405026435556021466 0ustar cammcamm\THEOREM ascii_Axiom ascii |- !f. ?! fn. !b0 b1 b2 b3 b4 b5 b6 b7. fn(ASCII b0 b1 b2 b3 b4 b5 b6 b7) = f b0 b1 b2 b3 b4 b5 b6 b7 \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/NOT_STRING_EMPTY.doc0000640000212700021270000000011105026456451021734 0ustar cammcamm\THEOREM NOT_STRING_EMPTY string |- !a s. ~(`` = STRING a s) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/STRING_11.doc0000640000212700021270000000015005026456452020543 0ustar cammcamm\THEOREM STRING_11 string |- !a s a' s'. (STRING a s = STRING a' s') = (a = a') /\ (s = s') \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/string_Axiom.doc0000640000212700021270000000015405026456452021703 0ustar cammcamm\THEOREM string_Axiom string |- !e f. ?! fn. (fn `` = e) /\ (!a s. fn(STRING a s) = f(fn s)a s) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/string_CASES.doc0000640000212700021270000000012505026456452021462 0ustar cammcamm\THEOREM string_CASES string |- !s. (s = ``) \/ (?s' a. s = STRING a s') \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/string_Induct.doc0000640000212700021270000000015105026456452022051 0ustar cammcamm\THEOREM string_Induct string |- !P. P `` /\ (!s. P s ==> (!a. P(STRING a s))) ==> (!s. P s) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/thms/NOT_EMPTY_STRING.doc0000640000212700021270000000011105026645757021745 0ustar cammcamm\THEOREM NOT_EMPTY_STRING string |- !a s. ~(STRING a s = ``) \ENDTHEOREM hol88-2.02.19940316/Library/string/help/entries/0000750000212700021270000000000005227267273017252 5ustar cammcammhol88-2.02.19940316/Library/string/help/entries/ascii_EQ_CONV.doc0000640000212700021270000000171205026644641022240 0ustar cammcamm\DOC ascii_EQ_CONV \TYPE {ascii_EQ_CONV : conv} \SYNOPSIS Decision-procedure for equality of ascii character constants. \DESCRIBE The conversion {ascii_EQ_CONV} implements a decision procedure for the equality of ascii character constants built up from boolean constants {T} and {F} using the constructor {ASCII}. The conversion expects its term argument to be an equation of the form: { "ASCII a1 a2 a3 a4 a5 a6 a7 a8 = ASCII b1 b2 b3 b4 b5 b6 b7 b8" } \noindent where each of {a1}, ..., {a8}, {b1}, ..., {b8} is either the constant {T} or the constant {F}. Given such a term, the conversion returns: { |- (ASCII a1 a2 a3 a4 a5 a6 a7 a8 = ASCII b1 b2 b3 b4 b5 b6 b7 b8) = T } \noindent if {ai} is identical to {bi} for i from 1 to 8. Otherwise, the conversion returns: { |- (ASCII a1 a2 a3 a4 a5 a6 a7 a8 = ASCII b1 b2 b3 b4 b5 b6 b7 b8) = F } \FAILURE Fails if applied to a term that is not of the form shown above. \SEEALSO string_EQ_CONV. \ENDDOC hol88-2.02.19940316/Library/string/help/entries/load_string.doc0000640000212700021270000000160305026466131022236 0ustar cammcamm\DOC load_string \TYPE {load_string : (void -> void)} \SYNOPSIS Loads ML functions in the string library and sets up autoloading of theorems in the library. \DESCRIBE If the user is not in draft mode, or the current theory is not an ancestor of the library theory {string}, then the contents of the string library cannot immediately be made available when the library is loaded, since the theory {string} can neither be made a parent of the current theory nor loaded using {load_theory}. In this case, the library load sequence defines the function {load_string}. Calling this function when the library theory {string} is an ancestor of the current theory completes the library load sequence for the string library, making available the ML functions in the library and activating autoloading of theorems. \FAILURE Fails if the theory {string} is not an ancestor of the current theory. \ENDDOC hol88-2.02.19940316/Library/string/help/entries/string_CONV.doc0000640000212700021270000000135205026466027022071 0ustar cammcamm\DOC string_CONV \TYPE {string_CONV : conv} \SYNOPSIS Axiom-scheme for character string constants. \DESCRIBE The conversion {string_CONV} expects its term argument to be a non-empty ascii character string constant (for example: {"`a`"}, {"`b`"}, {"`abc`"}). Given such a term, for example the term {"`abc`"}, the conversion returns a theorem that defines this constant in terms of a shorter string: { |- `abc` = STRING(ASCII F T T F F F F T)`bc` } \noindent where {(ASCII F T T F F F F T)} is the ascii character code for the first character in the supplied string (in this case {`a`}). \FAILURE Fails if applied to a term that is not of the form shown above or if applied to the empty string {"``"}. \SEEALSO string_EQ_CONV. \ENDDOC hol88-2.02.19940316/Library/string/help/entries/string_EQ_CONV.doc0000640000212700021270000000124705026462457022464 0ustar cammcamm\DOC string_EQ_CONV \TYPE {string_EQ_CONV : conv} \SYNOPSIS Decision-procedure for equality of string constants. \DESCRIBE The conversion {string_EQ_CONV} expects its term argument to be an equation between character string constants (for example: {"`a`"}, {"`b`"}, {"`abc`"}, etc). Given such a term, the conversion {string_EQ_CONV} returns: { |- (lhs = rhs) = T } \noindent if {lhs} and {rhs} are identical character strings. Otherwise, the conversion returns: { |- (lhs = rhs) = F } \FAILURE Fails if applied to a term that is not of the form specified above. \EXAMPLE { #string_EQ_CONV "`aax` = `aay`";; |- (`aax` = `aay`) = F } \SEEALSO ascii_EQ_CONV. \ENDDOC hol88-2.02.19940316/Library/string/mk_ascii.ml0000640000212700021270000000332104712331506016747 0ustar cammcamm% ===================================================================== % % FILE : mk_ascii.ml % % DESCRIPTION : Creates a theory of 8-bit ascii character codes % % WRITES FILES : ascii.th % % % % AUTHOR : (c) T. Melham 1988 % % DATE : 87.07.27 % % REVISED : 90.10.27 % % ===================================================================== % % --------------------------------------------------------------------- % % Create the new theory % % --------------------------------------------------------------------- % new_theory `ascii`;; % --------------------------------------------------------------------- % % define the type :ascii % % --------------------------------------------------------------------- % let ascii_Axiom = define_type `ascii_Axiom` `ascii = ASCII bool bool bool bool bool bool bool bool`;; % --------------------------------------------------------------------- % % prove induction theorem for ascii. % % --------------------------------------------------------------------- % let ascii_Induct = save_thm (`ascii_Induct`, prove_induction_thm ascii_Axiom);; % --------------------------------------------------------------------- % % prove cases theorem for ascii. % % --------------------------------------------------------------------- % let ascii_CASES = save_thm (`ascii_CASES`, prove_cases_thm ascii_Induct);; % --------------------------------------------------------------------- % % prove that the constructor ASCII is one-to-one % % --------------------------------------------------------------------- % let ASCII_11 = save_thm (`ASCII_11`, prove_constructors_one_one ascii_Axiom);; quit();; % Needed for Common Lisp % hol88-2.02.19940316/Library/string/mk_string.ml0000640000212700021270000001021705026645704017176 0ustar cammcamm% ===================================================================== % % FILE : mk_string.ml % % DESCRIPTION : Creates the theory "string.th". % % % % PARENTS : ascii.th % % WRITES FILES : string.th % % % % AUTHOR : (c) T. Melham 1988 % % DATE : 87.07.27 % % REVISED : 90.10.27 % % ===================================================================== % % --------------------------------------------------------------------- % % Create the new theory % % --------------------------------------------------------------------- % new_theory `string`;; % --------------------------------------------------------------------- % % Parent theories % % --------------------------------------------------------------------- % new_parent `ascii`;; % --------------------------------------------------------------------- % % The following hack allows us to use "``" in the following type % % definition. This switches off the code that makes `` a constant (of % % type :string, in fact) so that we can define `` using new_definition. % % % % These lisp hacks are purely local to this file... % % --------------------------------------------------------------------- % lisp `(setdebug t)`;; lisp `(defun mk-ol-atom (x) (cond ((memq x spec-toks) (parse-failed (concat x '| cannot be a term|))) ((numberp x) (list 'MK=CONST (atomify x))) ((constp x) (list 'MK=CONST x)) ((eq x tokflag) (list 'MK=VAR (let ((tok (car toklist))) (setq toklist (cdr toklist)) (implode (append '(96) (append (exploden tok) '(96))))))) (t (list 'MK=VAR x))))`;; lisp `(defun idenp (tok) t)`;; lisp `(defun constp (tok) (get tok 'const))`;; % --------------------------------------------------------------------- % % Note: we need to parse all our strings here, since ` is about to be % % made into a letter. % % --------------------------------------------------------------------- % let string_Axiom = `string_Axiom`;; let spec = `string = \`\` | STRING ascii string`;; let tok = `tok`;; let string_Induct = `string_Induct`;; let string_CASES = `string_CASES`;; let STRING_11 = `STRING_11`;; let NOT_STRING_EMPTY = `NOT_STRING_EMPTY`;; let NOT_EMPTY_STRING = `NOT_EMPTY_STRING`;; new_letter `\``;; % --------------------------------------------------------------------- % % define the type :string % % --------------------------------------------------------------------- % let string_Axiom = define_type string_Axiom spec;; % --------------------------------------------------------------------- % % Make tok an abbreviation for string, for compatibility with old code % % --------------------------------------------------------------------- % new_type_abbrev(tok, ":string");; % --------------------------------------------------------------------- % % prove "induction" theorem for :string. % % --------------------------------------------------------------------- % let string_Induct = save_thm (string_Induct,prove_induction_thm string_Axiom);; % --------------------------------------------------------------------- % % prove cases theorem for :string. % % --------------------------------------------------------------------- % let string_CASES = save_thm (string_CASES, prove_cases_thm string_Induct);; % --------------------------------------------------------------------- % % prove that the constructor STRING is one-to-one % % --------------------------------------------------------------------- % let STRING_11 = save_thm (STRING_11, prove_constructors_one_one string_Axiom);; % --------------------------------------------------------------------- % % prove that the constructors empty_string and STRING are distinct % % --------------------------------------------------------------------- % let NOT_STRING_EMPTY = save_thm (NOT_STRING_EMPTY, prove_constructors_distinct string_Axiom);; let NOT_EMPTY_STRING = save_thm (NOT_EMPTY_STRING, GEN_ALL(NOT_EQ_SYM(SPEC_ALL NOT_STRING_EMPTY)));; close_theory();; quit();; % Needed for Common Lisp % hol88-2.02.19940316/Library/string/ascii.ml0000640000212700021270000000550404712331571016267 0ustar cammcamm% ===================================================================== % % FILE : ascii.ml % % DESCRIPTION : Defines a conv for determining when two ascii values % % are equal. % % % % Assumes that ascii.th is a parent of current thy. % % % % AUTHOR : (c) T. Melham 1988 % % DATE : 87.05.30 % % REVISED : 90.10.27 % % ===================================================================== % % --------------------------------------------------------------------- % % ascii_EQ_CONV: decision-procedure for equality of ascii constants. % % --------------------------------------------------------------------- % let ascii_EQ_CONV = let check = assert (\c.fst(dest_const c)=`ASCII`) in let ckargs = let T="T" and F="F" in assert (forall (\tm. tm=T or tm=F)) in let strip = snd o (check # ckargs) o strip_comb in let thm,vs = let th = theorem `ascii` `ASCII_11` in let vs = fst(strip_forall(concl th)) in fst(EQ_IMP_RULE (SPECL vs th)), vs in letrec fc th = (let t,c = CONJ_PAIR th in ($=(dest_eq(concl t)) => fc c | t)) ? th in \tm. (let l,r = (strip # strip) (dest_eq tm) in if (l=r) then EQT_INTRO(REFL(rand tm)) else let cntr = fc(UNDISCH (INST (combine(l@r,vs)) thm)) in let fth = EQ_MP (bool_EQ_CONV (concl cntr)) cntr in EQF_INTRO (NOT_INTRO (DISCH tm fth))) ? failwith `ascii_EQ_CONV`;; % -------------------------------------------------- TESTS --- timer true;; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII F F F F F F F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII T T T T T T T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T F F F F F F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F T T T T T T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T F F F F F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F T T T T T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T T F F F F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F F T T T T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T T T F F F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F F F T T T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T T T T F F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F F F F T T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T T T T T F F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F F F F F T T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T T T T T T F";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F F F F F F T";; ascii_EQ_CONV "ASCII T T T T T T T T = ASCII T T T T T T T T";; ascii_EQ_CONV "ASCII F F F F F F F F = ASCII F F F F F F F F";; ascii_EQ_CONV "ASCII F T F T T F T F = ASCII F T F T T F T F";; ascii_EQ_CONV "ASCII F T F T T F T F = ASCII F T F T T F T x";; -------------------------------------------------------------------% hol88-2.02.19940316/Library/string/string.ml0000640000212700021270000000506205026464112016501 0ustar cammcamm% ===================================================================== % % FILE : string.ml % % DESCRIPTION : loads the library "string" into hol. % % % % AUTHOR : T. Melham % % DATE : 87.10.09 % % REVISED : 90.12.01, 91.01.23 % % ===================================================================== % % --------------------------------------------------------------------- % % Put the pathname to the library string onto the search path. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/string/` in print_string `Updating search path`; print_newline(); set_search_path (union (search_path()) [path]);; % --------------------------------------------------------------------- % % Add the string help files to online help. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/string/help/entries/` in print_string `Updating help search path`; print_newline(); set_help_search_path (union [path] (help_search_path()));; % --------------------------------------------------------------------- % % Load (or attempt to load) the theory string % % --------------------------------------------------------------------- % if draft_mode() then (print_string `Declaring theory string a new parent`; print_newline(); new_parent `string`) else (load_theory `string` ? (print_string `Defining ML function load_string`; print_newline() ; loadf `load_string`));; % --------------------------------------------------------------------- % % Load compiled code if possible % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `string`)) then let path st = library_pathname() ^ `/string/` ^ st in load(path `stringconv`, get_flag_value `print_lib`); load(path `ascii`, get_flag_value `print_lib`); load(path `string_rules`, get_flag_value `print_lib`);; % --------------------------------------------------------------------- % % Set up autoloading of (selected) theorems from string.th % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `string`)) then let thms = map fst (theorems `ascii`) in map (\name. autoload_theory(`theorem`,`ascii`,name)) thms; let thms = map fst (theorems `string`) in map (\name. autoload_theory(`theorem`,`string`,name)) thms; delete_cache `ascii`; delete_cache `string`; ();; hol88-2.02.19940316/Library/string/Makefile0000640000212700021270000000474605003572644016316 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: string # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o @echo "===> library string: all object code deleted" clobber: rm -f *_ml.o *_ml.l *.th @echo "===> library string: all object code and theory files deleted" # ===================================================================== # Entries for individual files. # ===================================================================== ascii.th: mk_ascii.ml rm -f ascii.th echo 'set_flag(`abort_when_fail`,true);;'\ 'loadt `mk_ascii`;;' | ${Hol} string.th: mk_string.ml ascii.th rm -f string.th echo 'set_flag(`abort_when_fail`,true);;'\ 'loadt `mk_string`;;' | ${Hol} ascii_ml.o: ascii.ml ascii.th echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `ascii`;;'\ 'compilet `ascii`;;'\ 'quit();;' | ${Hol} stringconv_ml.o: stringconv.ml string.th echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `string`;;'\ 'compilet `stringconv`;;'\ 'quit();;' | ${Hol} string_rules_ml.o: string_rules.ml stringconv_ml.o ascii_ml.o string.th echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `string`;;'\ 'loadf `stringconv`;;'\ 'loadf `ascii`;;'\ 'compilet `string_rules`;;'\ 'quit();;' | ${Hol} string_ml.o: string.ml string_rules_ml.o string.th echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `string`;;'\ 'compilet `string`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: ascii.th string.th ascii_ml.o stringconv_ml.o string_rules_ml.o \ string_ml.o @echo "===> library string rebuilt" hol88-2.02.19940316/Library/string/READ-ME0000640000212700021270000000402004613123517015571 0ustar cammcamm+ ===================================================================== + | | | LIBRARY : string | | | | DESCRIPTION : definition of logical types for ascii character codes | | and ascii character strings. | | | | AUTHOR : T Melham | | DATE : 88.04.20 | | | | MODIFIED : M. Gordon | | DATE : 23 March 89 | + ===================================================================== + + --------------------------------------------------------------------- + | | | FILES: | | | + --------------------------------------------------------------------- + mk_ascii.ml creates the theory of 8-bit ascii character codes mk_string.ml creates the theory of character strings ascii.ml defines ascii_EQ_CONV, a conversion for inferring the equality (or otherwise) of ascii character codes. stringconv.ml axiom scheme string_CONV for string constants. string_rules.ml defines string_EQ_CONV, a conversion for inferring the equality (or otherwise) of character strings. string.ml loads the library into hol. + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clean" 3) type "make all" + --------------------------------------------------------------------- + | | | TO USE THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) EITHER copy the files *_ml.o and *.th in this library into your current working directory, OR put the pathname of this library on the internal hol search path. 2) To use strings, make "string.th" a parent of your theory. E.g. by executing new_parent `string`;; in draft mode. 3) To load the library, load the file `string`. hol88-2.02.19940316/Library/string/stringconv.ml0000640000212700021270000000270204712335163017371 0ustar cammcamm% ===================================================================== % % FILE : stringconv.ml % % DESCRIPTION : define the axiom scheme for character strings. % % % % % % AUTHOR : T. Melham % % DATE : 87.08.23 % % REVISED : 90.10.27 % % ===================================================================== % % --------------------------------------------------------------------- % % string_CONV "defines" the infinite family of constants: % % % % 'a' = STRING(ASCII F T T F F F F T)`` % % 'ab' = STRING(ASCII F T T F F F F T)`b` % % % % ... etc % % % % The auxiliary function bits n m computes the representation in n % % bits of m (MOD 2**n) % % --------------------------------------------------------------------- % let string_CONV = let T = "T" and F = "F" and A = "ASCII" in let STR = curry mk_comb "STRING" in let chkty = assert (\t.fst(dest_type t) = `string`) in letrec bits n m = if (n=0) then [] else let hm = m/2 in (hm*2 = m => F | T) . bits (n-1) hm in \tm. (let str,ty = (I # chkty) (dest_const tm) in if (str = `\`\``) then fail else let q.h.t = explode str in let code = rev (bits 8 (ascii_code h)) in let tm1 = STR (list_mk_comb(A,code)) in let def = mk_comb(tm1,mk_const(implode (q.t),ty)) in mk_thm([], mk_eq(tm,def))) ? failwith `string_CONV`;; hol88-2.02.19940316/Library/string/string_rules.ml0000640000212700021270000000644304712344421017720 0ustar cammcamm% ===================================================================== % % FILE : string_rules.ml % % DESCRIPTION : Defines useful derived rules for strings. % % % % Assumes string.th a parent of current theory. % % % % AUTHOR : T. Melham % % DATE : 87.10.09 % % % % RENAMED : M. Gordon (from string.ml) % % DATE : 23 March 1989 % % % % REVISED : 90.10.27 (melham) % % ===================================================================== % % --------------------------------------------------------------------- % % string_EQ_CONV : determines if two string constants are equal. % % % % string_EQ_CONV "`abc` = `abc`" ---> "(`abc` = `abc`) = T" % % string_EQ_CONV "`abc` = `abx`" ---> "(`abc` = `abx`) = F" % % string_EQ_CONV "`abc` = `ab`" ---> "(`abc` = `ab`) = F" % % % % ... etc % % --------------------------------------------------------------------- % let string_EQ_CONV = let Estr = "``" and a = genvar ":ascii" and s = genvar ":string" in let Nth = EQF_INTRO(SPECL [a;s] (theorem `string` `NOT_STRING_EMPTY`)) in let pat = mk_eq(mk_eq(Estr,s),"F") and b = genvar ":bool" in let a' = genvar ":ascii" and s' = genvar ":string" in let S11 = SPECL [a;s;a';s'] (theorem `string` `STRING_11`) in let MKeq = let c = "$=:string->string->bool" in \t1 t2. MK_COMB(AP_TERM c t1,t2) in let check c = if (fst (dest_type(type_of c)) = `string`) then (let c.cs = explode(fst(dest_const c)) in c = `\`` & last cs = `\``) else false in let Tand = CONJUNCT1 (SPEC b AND_CLAUSES) in let mkC = AP_THM o (AP_TERM "/\") in letrec conv l r = if (l=Estr) then let thm = string_CONV r in let A,S = (rand # I) (dest_comb (rand(concl thm))) in SUBST [SYM thm,s] pat (INST [A,a;S,s] Nth) else if (r=Estr) then let thm = string_CONV l in let A,S = (rand # I) (dest_comb (rand(concl thm))) in let sth = SUBST [SYM thm,s] pat (INST [A,a;S,s] Nth) in TRANS (SYM(SYM_CONV (lhs(concl sth)))) sth else let th1 = string_CONV l and th2 = string_CONV r in let a1,s1 = (rand # I) (dest_comb(rand(concl th1))) and a2,s2 = (rand # I) (dest_comb(rand(concl th2))) in let ooth = TRANS (MKeq th1 th2) (INST [a1,a;a2,a';s1,s;s2,s'] S11) in if (a1=a2) then let thm1 = TRANS ooth (mkC(EQT_INTRO(REFL a1))(mk_eq(s1,s2))) in let thm2 = TRANS thm1 (INST [mk_eq(s1,s2),b] Tand) in TRANS thm2 (conv s1 s2) else let th1 = CONJUNCT1 (EQ_MP ooth (ASSUME (mk_eq(l,r)))) in let th2 = EQ_MP (ascii_EQ_CONV (mk_eq(a1,a2))) th1 in EQF_INTRO(NOT_INTRO(DISCH (mk_eq(l,r)) th2)) in \tm. (let l,r = (assert check # assert check) (dest_eq tm) in if (l=r) then EQT_INTRO(REFL l) else conv l r) ? failwith `string_EQ_CONV` ;; % ----- TESTS --- string_EQ_CONV "`a` = `b`";; string_EQ_CONV "`abc` = `abc`";; string_EQ_CONV "`a` = `a`";; string_EQ_CONV "`abc` = `abx`";; string_EQ_CONV "`abc` = `ab`";; string_EQ_CONV "`ab` = `abc`";; string_EQ_CONV "`xab` = `abc`";; string_EQ_CONV "`abcdefghijklmnopqrstuvwxyz` = `abcdefghijklmnopqrstuvwxyz`";; string_EQ_CONV "`abcdefghijklmnopqrstuvwxyz` = `abcdefghijklmnopqrstuvwxyA`";; % -------------- hol88-2.02.19940316/Library/string/load_string.ml0000640000212700021270000000242305026464157017507 0ustar cammcamm% ===================================================================== % % FILE : load_string.ml % % DESCRIPTION : creates a function that loads the contents of the % % library "string" into hol. % % % % AUTHOR : T. Melham % % DATE : 91.01.20 % % ===================================================================== % % --------------------------------------------------------------------- % % define the function load_string. % % --------------------------------------------------------------------- % let load_string (v:void) = if (mem `string` (ancestry())) then (print_string `Loading contents of string...`; print_newline(); let path st = library_pathname() ^ `/string/` ^ st in load(path `stringconv`, get_flag_value `print_lib`); load(path `ascii`, get_flag_value `print_lib`); load(path `string_rules`, get_flag_value `print_lib`); let thms = map fst (theorems `ascii`) in map (\name. autoload_theory(`theorem`,`ascii`,name)) thms; let thms = map fst (theorems `string`) in map (\name. autoload_theory(`theorem`,`string`,name)) thms; delete_cache `ascii`; delete_cache `string`; ()) else failwith `theory string not an ancestor of the current theory`;; hol88-2.02.19940316/Library/ind_defs/0000750000212700021270000000000005533117201015077 5ustar cammcammhol88-2.02.19940316/Library/ind_defs/Examples/0000750000212700021270000000000005227252076016667 5ustar cammcammhol88-2.02.19940316/Library/ind_defs/Examples/exp.ml0000640000212700021270000001027405071621561020016 0ustar cammcamm% ===================================================================== % % FILE : exp.ml % % DESCRIPTION : The operational semantics of a trivial language of % % arithmetic expressions. % % language. % % % % AUTHOR : T. Melham % % DATE : 90.11.24 % % ===================================================================== % % --------------------------------------------------------------------- % % Create the theory. % % --------------------------------------------------------------------- % new_theory `exp`;; % --------------------------------------------------------------------- % % Need the ind_defs library. % % --------------------------------------------------------------------- % load_library `ind_defs`;; % ===================================================================== % % SYNTAX % % ===================================================================== % let exp_axiom = define_type `exp_axiom` `exp = N num | plus exp exp`;; % --------------------------------------------------------------------- % % Make plus an infix `++'. % % --------------------------------------------------------------------- % let iplus = new_infix_definition (`iplus`, "$++ e1 e2 = plus e1 e2");; let exp_axiom = REWRITE_RULE [SYM(SPEC_ALL iplus)] exp_axiom;; % --------------------------------------------------------------------- % % distinctness and injectivity of constructors N and ++. % % --------------------------------------------------------------------- % let dist = let th = prove_constructors_distinct exp_axiom in CONJ th (NOT_EQ_SYM(SPEC_ALL th));; let oneone = prove_constructors_one_one exp_axiom;; % --------------------------------------------------------------------- % % induction. % % --------------------------------------------------------------------- % let sind = prove_induction_thm exp_axiom;; % ===================================================================== % % OPERATIONAL SEMANTICS % % ===================================================================== % % --------------------------------------------------------------------- % % Semantics of natural number expressions. % % --------------------------------------------------------------------- % new_special_symbol `--->`;; let rules,ind = let R = "---> : exp -> num -> bool" in new_inductive_definition true `expsem` ("^R e n", []) [ [ % -------------------------------------------- % ], "^R (N n) n" ; [ "^R e1 n"; "^R e2 m" % -------------------------------------------- % ], "^R (e1 ++ e2) (n+m)" ];; % --------------------------------------------------------------------- % % Tactics for the rules. % % --------------------------------------------------------------------- % let EXP_TAC = FIRST (map RULE_TAC rules);; % --------------------------------------------------------------------- % % Cases theorem. % % --------------------------------------------------------------------- % let cases = derive_cases_thm (rules,ind);; % ===================================================================== % % PROOF: the operational semantics is deterministic. % % ===================================================================== % let DETERMINISTIC = prove_thm (`DETERMINISTIC`, "!e1 n. e1 ---> n ==> !m. e1 ---> m ==> (n = m)", RULE_INDUCT_THEN ind ASSUME_TAC ASSUME_TAC THEN REPEAT GEN_TAC THEN let rule = REWRITE_RULE [dist;oneone] o MATCH_MP cases in DISCH_THEN (STRIP_ASSUME_TAC o rule) THEN EVERY_ASSUM (\th g. SUBST_ALL_TAC th g ? ALL_TAC g) THEN RES_THEN SUBST1_TAC THEN REFL_TAC);; % ===================================================================== % % PROOF: each expression evaluates to something. % % ===================================================================== % let EVAL = prove_thm (`EVAL`, "!e. ?n. e ---> n", INDUCT_THEN sind STRIP_ASSUME_TAC THEN REPEAT GEN_TAC THENL [EXISTS_TAC "n:num" THEN EXP_TAC; EXISTS_TAC "n+n'" THEN EXP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; hol88-2.02.19940316/Library/ind_defs/Examples/rtc.ml0000640000212700021270000000571305071617760020022 0ustar cammcamm% ===================================================================== % % FILE : rtc.ml % % DESCRIPTION : reflexitive-transitive closure of a relation. % % % % AUTHOR : T. Melham % % DATE : 90.04.29 % % ===================================================================== % % --------------------------------------------------------------------- % % Create the new theory. % % --------------------------------------------------------------------- % new_theory `rtc`;; % --------------------------------------------------------------------- % % Load the inductive definitions package % % --------------------------------------------------------------------- % load_library `ind_defs`;; % --------------------------------------------------------------------- % % Inductive definition the reflexive-transitive closure of a relation. % % --------------------------------------------------------------------- % let (rules,ind) = let RTC = "RTC:(*->*->bool)->*->*->bool" in new_inductive_definition false `RTC_DEF` ("^RTC R x y", ["R:*->*->bool"]) [ [ % ------------------------------ % "R (x:*) (y:*):bool"], "^RTC R x y" ; [ %------------------------------- % ], "^RTC R x x" ; [ "^RTC R x z"; "^RTC R z y" %------------------------------- % ], "^RTC R x y" ];; % --------------------------------------------------------------------- % % Tactics for RTC proofs. % % --------------------------------------------------------------------- % let [IN_TAC;REFL_TAC;TRANS_TAC] = map RULE_TAC rules;; % --------------------------------------------------------------------- % % Strong form of rule induction. % % --------------------------------------------------------------------- % let sind = derive_strong_induction_thm (rules,ind);; % --------------------------------------------------------------------- % % Cases theorem for RTC. % % --------------------------------------------------------------------- % let cases = derive_cases_thm (rules,ind);; % --------------------------------------------------------------------- % % Rule induction tactic for RTC. % % --------------------------------------------------------------------- % let RTC_INDUCT_TAC = RULE_INDUCT_THEN ind STRIP_ASSUME_TAC STRIP_ASSUME_TAC;; % --------------------------------------------------------------------- % % Prove that taking the reflexive-transitive closure preserves symmetry % % --------------------------------------------------------------------- % let RTC_PRESERVES_SYMMETRY = prove_thm (`RTC_PRESERVES_SYMMETRY`, "!R. (!a (b:*). R a b ==> R b a) ==> (!a b. RTC R a b ==> RTC R b a)", GEN_TAC THEN DISCH_TAC THEN RTC_INDUCT_TAC THENL [IN_TAC THEN RES_TAC; REFL_TAC; TRANS_TAC THEN EXISTS_TAC "z:*" THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; hol88-2.02.19940316/Library/ind_defs/Paper/0000750000212700021270000000000005227252263016156 5ustar cammcammhol88-2.02.19940316/Library/ind_defs/Paper/paper.log0000640000212700021270000000202205203500221017745 0ustar cammcammThis is TeX, C Version 3.0 (format=lplain 90.7.30) 11 MAY 1992 15:10 **paper (paper.tex LaTeX Version 2.09 <7 Dec 1989> (/usr/lib/tex/macros/article.sty Document Style `article' <16 Mar 88>. (/usr/lib/tex/macros/art10.sty) \c@part=\count79 \c@section=\count80 \c@subsection=\count81 \c@subsubsection=\count82 \c@paragraph=\count83 \c@subparagraph=\count84 \c@figure=\count85 \c@table=\count86 ) (alltt.sty) (/usr/lib/tex/macros/twocolumn.sty) (/usr/lib/tex/macros/fleqn.sty \mathindent=\dimen99 ) (layout.sty) (paper.aux) (macros.tex \hsbw=\skip41 \c@sessioncount=\count87 ) [1 ] [2] [3] [4] [5] [6] [7] [8] (paper.aux) ) Here is how much of TeX's memory you used: 196 strings out of 4463 1839 string characters out of 63169 40217 words of memory out of 262141 2133 multiletter control sequences out of 9500 19348 words of font info for 73 fonts, out of 72000 for 255 14 hyphenation exceptions out of 607 13i,19n,17p,171b,385s stack positions out of 300i,100n,60p,3000b,4000s Output written on paper.dvi (8 pages, 47536 bytes). hol88-2.02.19940316/Library/ind_defs/Paper/READ-ME0000640000212700021270000000023305202505242017101 0ustar cammcammThe LaTeX file paper.tex in this directory is the short paper I wrote about the inductive definitions package for the 1991 HOL Users Meeting. Tom Melham hol88-2.02.19940316/Library/ind_defs/Paper/paper.aux0000640000212700021270000000355005203500220017767 0ustar cammcamm\relax \citation{description,melham} \citation{pitts} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1}Introduction}{1}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {2}Inductive definitions}{1}} \newlabel{ind-defs}{{2}{1}} \citation{winskel} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {2.1}Rule induction}{2}} \newlabel{rule-ind}{{2.1}{2}} \newlabel{fact1}{{1}{2}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3}Inductive definitions in logic}{2}} \newlabel{in-logic}{{3}{2}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {3.1}Deriving the rules and rule induction}{3}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {4}Automation}{3}} \newlabel{newind}{{4}{3}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {4.1}A simple example}{4}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {4.2}Defining a class of relations}{4}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {4.3}Stating premisses and conclusions}{5}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {5}A tactic for rule induction}{5}} \citation{description} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {5.1}An example}{6}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {6}Tactics and inference rules}{7}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {7}Case analysis}{7}} \bibcite{description}{1} \bibcite{melham}{2} \bibcite{pitts}{3} \bibcite{winskel}{4} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {8}Applications}{8}} \newlabel{appl}{{8}{8}} hol88-2.02.19940316/Library/ind_defs/Paper/paper.dvi0000640000212700021270000013466005203500221017764 0ustar cammcamm÷ƒ’À;è TeX output 1992.05.11:1510‹ÿÿÿÿ ¥,ò ýZÓ ˆ¹  þàw ÿpt·Ÿ÷Î8‘êñëóÙ“ Rcmr7³PreprinÈãt–%$of“a“papš7er“to“app˜ear“in“the“Pro˜ceedings“of“the“1991“InÈãternational“T‘ÿZªutorialŽ¤‘êñëand–ó-W‘ÿZªorkshop“on“the“HOL‘óTheorem“ProÈãving“System,›†27{30“August“1991,˜DaÈãvisŽ¡‘êñëCalifornia–±È(IEEE“Computer“So7cietÈãy“Press).ŽŽŽŸ1‘!¢aó7ò"Vff cmbx10âA›…P•Š=ac“k‘ÿ{age˜for˜Inductiv“e˜Relation˜De nitions˜in˜HOLŽŸ$’ÃÛáóKñ`y cmr10ÄT.–UUF.“MelhamŽŸ‘{eUniv•¸ãersit“y–UUof“Cam¸ãbridge“Computer“LabGoratoryŽ¤ ’‘lNew–UUMuseums“Site,“P•¸ãem“brok“e‘UUStreetŽ¡’›v†Cam¸ãbridge,–UUCB2“3QG,“England.Ž¡Ž ì‰ þ1àw‘Hîîó'ò"V ó3 cmbx10ÒAbstractŽ©‹Ó‘öñëóý': cmti10ÇThis›–p–ÿ}'ap“er˜describ“es˜a˜set˜of˜the“or“em˜pr“oving˜to“olsŽ¤ ‘êñëb–ÿ}'ase“d–N¤on“a“new“derive‘ÿ}'d“principle“of“de nition“in“HOL,Ž¡‘êñënamely–æthe“intr–ÿ}'o“duction–æof“r›ÿ}'elations“inductively“de ne˜dŽ¡‘êñëby–Èa“set“of“rules.‘˜ŒSuch“inductive“de nitions“ab‘ÿ}'ound“inŽ¡‘êñëc–ÿ}'omputer›xscienc“e.‘EçExample˜applic“ation˜ar“e“as˜includeŽŽ¡‘êñër–ÿ}'e“asoning›•/ab“out˜structur“e“d˜op“er“ational˜semantics,‘•typ“eŽ¡‘êñëjudgements,‘Qotr–ÿ}'ansition›øTr“elations˜for˜pr“o“c“ess˜algebr“as,Ž¡‘êñër–ÿ}'e“ductionŽ‘…r–ÿ}'elations,‘ÔÒand›”£c“omp“ositional˜pr“o“of˜systems.Ž¡‘êñëThe–dp›ÿ}'ackage“describ˜e˜d“in“this“p˜ap˜er“automates“theŽ¡‘êñëderivation–YIof“c›ÿ}'ertain“inductive“de nitions“involve˜d“inŽ¡‘êñëthese–Kapplic›ÿ}'ations“and“pr˜ovides“the“b˜asic“to˜ols“ne˜e˜de˜dŽ¡‘êñëfor›“çr–ÿ}'e“asoning˜ab“out˜the˜r“elations˜intr“o“duc“e“d˜by˜them.ŽŸƒñ‘êñëó0ÂÖN  cmbx12Û1Ž‘ÿ1ëIn tro`ductionŽ¦‘öñëÄThe–6ÑHOL‘6Êuser“comm•¸ãunit“y–6Ñhas“a“strong“tradition“ofŽ¡‘êñëtaking–ða“purely“Çde nitional‘øÄapproac¸ãh“to“using“higherŽ¡‘êñëorder–¼xlogic.‘>ÓThat“is,‘Û the“syn¸ãtax“of“the“logic“is“extendedŽ¡‘êñëwith––Ïnew“notation“not“simply“b¸ãy“pGostulating“axioms“toŽ¡‘êñëgivš¸ãe–®‡meaning“to“it,‘Ïäbut“rather“b˜y“de ning“it“in“terms“ofŽ¡‘êñëexisting–z_expressions“of“the“logic“that“already“ha•¸ãv“e‘z_theŽ¡‘êñërequired–$&semanš¸ãtics.‘Þ:The“adv‘ÿqÇan˜tage“of“this“approac˜h,Ž¡‘êñëas–q>oppšGosed“to“the“axiomatic“metho˜d,‘žÝis“that“eac¸ãh“of“theŽ¡‘êñëprimitiv¸ãe–rules“of“de nition“in“the“óo´‹Ç cmr9½HOL‘ Älogic|namely‘ÿ*ª,Ž¡‘êñëconstan•¸ãt›!/de nition,‘”%constan“t˜spGeci cation,‘”%and˜t“ypGeŽ¡‘êñëde nition|is–5œguaranš¸ãteed“to“preserv˜e“consistency‘ÿ*ª.‘g4TheŽ¡‘êñëdisadv‘ÿqÇan¸ãtage–A±is“that“these“rules“admit“only“de nitionsŽŽ¡‘êñëthat–gHsatisfy“certain“vš¸ãery“restrictiv˜e“rules“of“formation.Ž¡‘êñëDe nitions–Wexpressed“in“anš¸ãy“other“form“m˜ust“alw˜a˜ysŽ¡‘êñëbGe–Íájusti ed“formally“bš¸ãy“deriving“them“from“equiv‘ÿqÇalen˜t,Ž¡‘êñëbut–UUpGossibly“rather“complex,“primitiv¸ãe“de nitions.ŽŸ ƒñ‘öñëThe–óz½ML‘óÄmetalanguage“alloš¸ãws“users“to“implemen˜tŽ¡‘êñëderivš¸ãed–Î)inference“rules“in“the“½HOL‘ÍÈÄsystem“and“th˜usŽ¡‘êñëproš¸ãvides–`*a“facilit˜y“for“automating“proGofs“that“justifyŽ¡‘êñëderivš¸ãed–¦rules“of“de nition.‘ cÿF‘ÿ*ªor“example,‘:Arecursiv˜eŽ¡‘êñëde nitionsŽ‘Jare–not“admitted“bš¸ãy“the“primitiv˜e“rulesŽ¡‘êñëof–Jšde nition“of“the“½HOL‘J[Älogic.‘Q–But“certain“recursiv¸ãeŽŽŽ þ1àw’íÝut¸ãypšGe–úÜde nitions“and“function“de nitions“are“supp˜ortedŽ¤ ’íÝuin–Q|the“system“bš¸ãy“deriv˜ed“inference“rules“written“inŽ¡’íÝu½ML–>œÄ[1Ž‘,“2Ž‘>].‘j4The“details“of“the“primitiv¸ãe“de nitions“thatŽ¡’íÝuunderlie–£Jthese“rules“are“hidden“from“the“user,‘Ææand“theirŽ¡’íÝu½ML‘˜ Äimplemen¸ãtations–˜_are“highly“optimized.‘:åSo“theseŽ¡’íÝuderiv¸ãedŽ’1sprinciples–¢3of“de nition“ma¸ãy“simply“bGe“regardedŽ¡’íÝuas–UUprimitivš¸ãe“b˜y“most“users“of“the“system.ŽŸ *ÿ’ùÝuThis–<žpapšGer“describ˜es“a“set“of“theorem-pro¸ãving“to˜olsŽ¡’íÝubased–Uon“a“new“deriv¸ãed“principle“of“de nition“in“½HOLŽ¡’íÝuÄfor–¢_de ning“relations“inductivš¸ãely“b˜y“a“set“of“rules.Ž¡’íÝuSections‘UU2Ž’ð¼and–!{3“givš¸ãe“a“general“in˜troGduction“to“theŽ¡’íÝuclass–Næof“inductivš¸ãe“de nitions“handled“b˜y“the“pac˜k‘ÿqÇageŽ¡’íÝuand–'oexplain“the“logical“basis“for“these“de nitions.‘bzTheŽ¡’íÝuremaining–ólsections“describGe“the“½ML‘óSÄfunctions“pro¸ãvidedŽ¡’íÝubš¸ãy–Žæthe“pac˜k‘ÿqÇage“and“brie y“men˜tion“some“applicationsŽ¡’íÝufor–UUwhicš¸ãh“the“pac˜k‘ÿqÇage“can“bGe“used.ŽŸ€þ’íÝuÛ2Ž’uInductiv e‘€de nitionsŽŸ€þ’ùÝuÄThe–èfolloš¸ãwing“is“a“simple“but“t˜ypical“example“of“aŽ¡’íÝurelation–¦*de ned“inductivš¸ãely“b˜y“a“set“of“rules.‘dE(ThisŽ¡’íÝuexample–ëis“tak¸ãen“from“[3Ž‘].)‘N…Let“ó  b> cmmi10ÅR‘Úßó!",š cmsy10Æ‘ÇÅA–eUÆ“ÅA–ëÄbGe“a“binaryŽ¡’íÝurelation–r÷on“a“set“ÅAÄ.‘ʬThe“re exiv•¸ãe-transitiv“e–r÷closure“ofŽ¡’íÝuÅR‘ Äcan–‰ÙbšGe“de ned“to“b˜e“the“least“relation“ÅRÇŸü^ÿó O!â…cmsy7µŽ‘ËIÆ‘žÅA–[ãÆ“ÅAŽ¡’íÝuÄfor–UUwhicš¸ãh“the“follo˜wing“deduction“rules“hold.ŽŸ,û’ùÝuót ‰: cmbx9ÁRóò"V cmbx10É1ŽŸü ’˨Ÿ£&‰fe4!úŸ¿˜‘UHŸÅRÇŸü^ÿµŽ‘¬«Ä(Åx;‘ª¨y[ÙÄ)ŽŽŽŽŽ’M¯ÅRÇÄ(Åx;‘ª¨y[ÙÄ)ŽŽŸW’ùÝuÁRÉ2ŽŸü ’˨Ÿ£&‰fe4–Ÿ¿˜‘UHŸÅRÇŸü^ÿµŽ‘¬«Ä(Åx;‘ª¨xÄ)ŽŽŽŽŽŽŽŸ(̯’ùÝuÁRÉ3ŽŸü ’ ðŸýÅRÇŸü^ÿµŽ–¬«Ä(Åx;‘ª¨zšp—Ä)‘ÅRÇŸü^ÿµŽ“Ä(Åz˜;‘ª¨y[ÙÄ)ŽŽ’˨Ÿ£&‰fejÍŽŸ¿˜‘#«ŸÅRÇŸü^ÿµŽ‘¬«Ä(Åx;‘ª¨y[ÙÄ)ŽŽŽŽŽŽŽŽŽŽŸiÅ”’íÝuThese–:–rules“state“precisely“the“propGerties“required“ofŽ¡’íÝuthe›~Ùre exiv•¸ãe-transitiv“e˜closure˜of˜the˜relation˜ÅRÇÄ.‘îTRuleŽ¡’íÝuÁRÉ1–èÌÄstates“that“it“mš¸ãust“con˜tain“at“least“all“the“v‘ÿqÇaluesŽ¡’íÝuin– .ÅRÇÄ;‘#ærule“ÁRÉ2“Ästates“that“it“mš¸ãust“bGe“re exiv˜e;‘#æand“ruleŽŽŽŽŽŽŸsç’ßûå1ŽŽŒ‹* ¥,ò ýZÓ ˆ¹  ýFõ‘êñëÁRÉ3–“wÄstates“that“it“mš¸ãust“bGe“transitiv˜e.‘,.The“re exiv˜e-Ž¤ ‘êñëtransitivš¸ãe–Éšclosure“ÅRÇŸü^ÿµŽ‘vEÄma˜y“therefore“simply“bGe“Çde ne‘ÿ}'dŽ¡‘êñëÄto–‰|bGe“the“least“relation“that“satis es“these“conditions.Ž¡‘êñëIt–U then“folloš¸ãws“simply“b˜y“de nition“that“the“rules“ÁRÉ1Ä,Ž¡‘êñëÁRÉ2–|Äand“ÁRÉ3“Äare“in“fact“satis ed“bš¸ãy“ÅRÇŸü^ÿµŽ‘¬«Ä.‘¸;Moreo˜v˜er,‘HitŽ¡‘êñëfolloš¸ãws–°immediately“that“ÅRÇŸü^ÿµŽ‘È[Äis“a“subset“of“an˜y“otherŽ¡‘êñërelation–Ç&that“satis es“these“rules,‘ã–since“ÅRÇŸü^ÿµŽ‘sÑÄis“de ned“toŽ¡‘êñëbGe–cÁthe“Çle‘ÿ}'ast‘V™Äsucš¸ãh“relation.‘!AThis“means“that“ÅRÇŸü^ÿµŽ‘lÄcon˜tainsŽ¡‘êñëonly–kÚthose“pairs“of“v‘ÿqÇalues“that“it“mš¸ãust“con˜tain“b˜y“virtueŽ¡‘êñëof–ý¢satisfying“the“rules.‘ j­As“will“bšGe“discussed“b˜elo¸ãw,Ž¡‘êñëthis–{BpropGertš¸ãy“giv˜es“rise“to“an“induction“principle“forŽ¡‘êñëreasoning–UUabGout“the“relation“ÅRÇŸü^ÿµŽ‘¬«Ä.Ž© ®}‘öñëThe–É{de nition“givš¸ãen“abGo˜v˜e“is“v‘ÿqÇalid“bGecause“the“rulesŽ¡‘êñëÁRÉ1Ä,–@õÁRÉ2Ä,“and–;ÝÁRÉ3“Ämakš¸ãe“only“pGositiv˜e“statemen˜ts“abGoutŽ¡‘êñëthe–äLelemenš¸ãts“of“ÅRÇŸü^ÿµŽ‘¬«Ä.‘ ­This“guaran˜tees“that“the“leastŽ¡‘êñërelation–à0satisfying“these“rules“doGes“exist.‘J»In“particular,Ž¡‘êñëif–Rthe“rules“ha•¸ãv“e–Rthis“form,‘Sthen“one“can“sho¸ãw“that“theŽ¡‘êñëinš¸ãtersection–¤ßof“an˜y“set“of“relations“that“satisfy“the“rulesŽ¡‘êñëalso–Ýsatis es“the“rules.‘ Moreo•¸ãv“er,‘ÿat–Ýleast“one“binaryŽ¡‘êñërelation–;­satis es“the“rules,‘tnamely“the“maximal“relationŽ¡‘êñëÅA–ã#Æ“ÅAÄ.‘8ÒThe–ªu`least'“or“smallest“relation“that“satis es“theŽ¡‘êñërules–íma¸ãy“therefore“legitimately“bšGe“de ned“to“b˜e“theŽ¡‘êñëinš¸ãtersection–UUof“all“suc˜h“relations.Ž¦‘öñëIn–†ógeneral,‘Zan“inductiv¸ãe“de nition“of“an“ÅnÄ-placeŽ¡‘êñërelationŽ‘£·ÅR‘iÄconsists–UUof“a“set“of“rules“of“the“form:ŽŸ!I¨Ÿü zfŸýÅRšÇÄ(ÅtŸü^ÿ³1ŽŸl1ŽŽ‘|sÅ;–ª¨:“:“:Ž‘ÿ÷;–ª¨tŸü^ÿ³1ŽŸáó 0e—rcmmi7´nŽŽ‘q~Ä)‘ ª©Æ““Ž‘"ÿùÅR˜Ä(ÅtŸü^ÿ´iŽŸl³1ŽŽ‘|sÅ;“:“:“:Ž‘ÿ÷;“tŸü^ÿ´iŽŸánŽŽ‘q~Ä)ŽŽ‘ø%Ÿ£&‰fe¡O?Ÿ¿˜‘5>rŸÅRÇÄ(ÅtŸÿ³1Ž‘|sÅ;–ª¨:“:“:Ž‘ÿ÷;‘ª¨tŸÿ´nŽ‘q~Ä)ŽŽŽŽŽ’ 5ÀÅCŸÿ³1Ž‘_ûÆ–ª¨“Ž‘î*ÅCŸÿ´jŽŽŽŽŸ#M‘êñëÄThe–återms“abGo•¸ãv“e–åthe“line“are“the“Çpr‘ÿ}'emisses‘·3Äof“the“rule,Ž¡‘êñëeacš¸ãh–\&of“whic˜h“mak˜es“a“pGositiv˜e“assertion“of“mem˜bGershipŽ¡‘êñëin–z8the“relation“ÅRÇÄ.‘àqThe“term“bGelo¸ãw“the“line,‘ƒqcalled“theŽ¡‘êñëÇc‘ÿ}'onclusion‘W/Äof–’Ìthe“rule,‘¢*likš¸ãewise“asserts“mem˜bGership“inŽ¡‘êñëÅRÇÄ.‘ÈÑThe–Ç®terms“ÅCŸÿ³1Ž‘|sÄ,Å:–ª¨:“:ŽŽ‘ UOÄ,ÅCŸÿ´jŽ‘þZÄare“Çside‘èŸc‘ÿ}'onditions‘™ÏÄon“theŽ¡‘êñërule;‘ò@these–Àµma¸ãy“bšGe“arbitrary“prop˜ositions“not“in•¸ãv“olvingŽ¡‘êñëthe–hbrelation“ÅR›|)ÄbGeing“de ned.‘ªíA‘hrelation“ÅR˜Äis“Çclose‘ÿ}'dŽ¡‘êñëÄunder–ùksucš¸ãh“a“rule“if“whenev˜er“the“premisses“and“sideŽ¡‘êñëconditions–MÂhold,‘‚ythe“conclusion“also“holds.‘ìThe“relationŽ¡‘êñëÇinductively‘Üàde ne‘ÿ}'d‘­0Äbš¸ãy–¤§a“collection“of“suc˜h“rules“is“theŽ¡‘êñëleast–UUrelation“closed“under“all“the“rules.Ž¤ v‘êñëÒ2.1Ž‘ ²Rule‘2inductionŽ¡‘öñëÄBy–¡™virtue“of“its“de nition“as“the“Çle‘ÿ}'ast‘”qÄrelation“closedŽ¤ ‘êñëunder–X~a“set“of“rules,‘YIevš¸ãery“inductiv˜ely“de ned“relationŽ¡‘êñëcomes–_with“an“assoGciated“induction“principle.‘ xåThisŽ¡‘êñëprinciple–:of“Çrule‘zÙinduction‘þ|Äis“essenš¸ãtial“for“man˜y“proGofsŽ¡‘êñëin•¸ãv“olving›½ suc“h˜relations.‘¨ä(The˜term˜`rule˜induction'Ž¡‘êñëwš¸ãas–UUcoined“b˜y“Glynn“Winsk˜el“in“[4Ž‘]).Ž¦‘öñëThe–«Xprinciple“of“rule“induction“for“an“inductiv¸ãelyŽ¡‘êñëde ned–Ûrelation“maš¸ãy“bGe“stated“brie y“as“follo˜ws.‘ELetŽ¡‘êñëÅR‘Ø^ÄbGe–Ä—an“ÅnÄ-place“relation“inductivš¸ãely“de ned“b˜y“a“set“ofŽ¡‘êñërules,‘úand–ãïsuppGose“wš¸ãe“wish“to“sho˜w“that“ev˜ery“elemen˜tŽŽŽ ýFõ’íÝuin–UUÅR‘iÄhas“a“certain“propGert¸ãy“ÅP‘cÄ:Ž¤Q^’ùÝuifŽ’@üÅRÇÄ(ÅxŸÿ³1Ž–|sÅ;–ª¨:“:“:Ž‘ÿ÷;›ª¨xŸÿ´nŽ‘q~Ä)‘Ž0thenŽ‘Ž*ÅP‘cÄ[ÅxŸÿ³1Ž“Å;˜:˜:˜:Ž‘ÿ÷;˜xŸÿ´nŽ‘q~Ä]‘5u’(1)ŽŽ¡’íÝuSince–À@ÅR‘ÔÄis“the“least“relation“closed“under“the“rules,‘Þan¸ãyŽ¤ ’íÝurelation–SRÅS‘æßÄwhic¸ãh“is“also“closed“under“the“rules“has“theŽ¡’íÝupropGertš¸ãy–UUthat“ÅR‘ÚßÆ‘ÇÅS‘“Ä.‘qÇNo˜w,“letŽ¤Q^’ùÝuÅS‘Z¥Ä=–ÇÆfÄ(ÅxŸÿ³1Ž›|sÅ;–ª¨:“:“:Ž‘ÿ÷;‘ª¨xŸÿ´nŽ‘q~Ä)“Æj“ÅP‘cÄ[ÅxŸÿ³1Ž˜Å;–ª¨:“:“:Ž‘ÿ÷;‘ª¨xŸÿ´nŽ‘q~Ä]ÆgŽŽŽ¡’íÝuÄThen–gto“pro•¸ãv“e–gthe“desired“propGert¸ãy“of“ÅRÇÄ,‘k|it“suces“toŽ¤ ’íÝusho¸ãw–*that“the“relation“ÅS‘½ Äis“closed“under“the“rules“thatŽ¡’íÝude ne–¾bÅRÇÄ.‘¬îF‘ÿ*ªor“if“the“relation“ÅS‘QïÄin“fact“is“closed“underŽ¡’íÝuthe–’ùÝu(Æ8Åx–8àyš[Ù:“R‘Úßx–Çy‘"ñÆ“ÅP‘*§x“y˜Ä)“Æ^ŽŽ¡’ùÝuÄ(Æ8Åx:‘8àP‘*§x–ÇxÄ)“Æ^ŽŽ¡’ùÝuÄ(Æ8Åx–8ày[Ù:“Ä(Æ9Åzp—:“P›*§x‘Çz‘©wÆ^“ÅP˜z‘7¯y[ÙÄ)–ÇÆ“ÅP˜x“y[ÙÄ)ŽŽŽŽŽŸ.†¡’íÝuEacš¸ãh–•rule“is“expressed“b˜y“a“quan˜ti ed“implication“of“itsŽ¡’íÝuconclusion–à˜b¸ãy“the“conjunction“of“its“premisses“and“sideŽŽŽŽŽŸsç’ßûå2ŽŽŒ‹à¥,ò ýZÓ ˆ¹  ýFõ‘êñëÄconditions.‘<þA‘¶Ñrule–¶ùwith“no“side“conditions“or“premissesŽ¤ ‘êñëis–®djust“represenš¸ãted“b˜y“a“univ˜ersally“quan˜ti ed“assertionŽ¡‘êñëof–êtits“conclusion.‘1#Closure“of“a“relation“under“an¸ãy“setŽ¡‘êñëof–±„rules“of“the“form“discussed“abšGo•¸ãv“e–±„can“b˜e“expressedŽ¡‘êñëin–UUlogic“in“a“similar“w•¸ãa“y‘ÿ*ª.Ž¡‘öñëUsing–ÉÒthis“methoGd“of“expressing“the“notion“ofŽ¡‘êñëclosureŽ‘ _%under–Wâa“set“of“rules,‘˜…one“can“de ne“the“Çle‘ÿ}'astŽ¡‘êñëÄrelation–R³closed“under“a“set“of“rules“simply“b¸ãy“takingŽ¡‘êñëthe–èinš¸ãtersection“of“all“suc˜h“relations.‘ÈF‘ÿ*ªor“example,‘NÍaŽ¡‘êñëfunctionŽ¤ÜW‘öñëó m#½R cmss10ËRtcŽ‘<“Ä:›Ç(Å zÆ!Ž– {Å zÆ!Ž“Åbool2`Ä)˜Æ!˜Ä(Å zÆ!Ž“Å zÆ!Ž“Åbool2`Ä)ŽŽŽ¡‘êñëthat–ž|maps“an“arbitrary“relation“ÅR‘TÊÄ:‘AÅ zÆ!Ž– {Å zÆ!Ž“Åbool‘ÐÜÄto‘ž|itsŽ¤ ‘êñëre exiv•¸ãe-transitiv“e–(¯closure“ËRtcŽ‘sWÅR‘is“an“½ML‘µ%Äfunction“that“tak˜es“as“an“argumen˜tŽ¡’íÝua–ª_list“of“rules“and“automatically“pro•¸ãv“es–ª_the“de ningŽ¡’íÝupropGerties–3xof“the“relationŽ‘'Ãginductivš¸ãely“de ned“b˜y“them.Ž¡’íÝuMore–Š/precisely‘ÿ*ª,‘—fthis“deriv¸ãed“½HOL‘Š"Äinference“rule“buildsŽ¡’íÝua–‡term“that“denotes“the“least“relation“closed“under“theŽ¡’íÝurules–3Áusing“the“in¸ãtersection“construction“describGed“inŽ¡’íÝuthe–’¼previous“section.‘)ýA‘’kconstanš¸ãt“is“then“in˜troGducedŽ¡’íÝu(via–½a“constan¸ãt“spGeci cation)“to“name“this“relation.Ž¡’íÝuThe–1‹result“is“a“set“of“theorems“stating“that“the“newly-Ž¡’íÝude ned–_relation“is“the“least“relation“closed“under“theŽ¡’íÝurules–UUsupplied“b¸ãy“the“user.Ž¡’ùÝuThe–Ц½ML‘ЇÄfunction“that“implemen¸ãts“this“principle“ofŽ¡’íÝuinductiv¸ãe–UUde nition“is:ŽŸ,¨ÙŸáæd’ùÝuóßꎒŸ3·Ä(Çin x‘“ç ag‘â}Ä)ŽŽ¡’ lÊstring‘?ý->Ž’Ÿ3·Ä(Çdefn.‘“çname‘À[Ä)ŽŽ¡’ lÊ(term–?ý#“term“list)“->Ž’Ÿ3·Ä(Çp‘ÿ}'attern‘ÄcÄ)ŽŽ¡’ lÊ(term–?ýlist“#“term)“list“->Ž’Ÿ3·Ä(Çrules‘Ò!Ä)ŽŽ¡’ lÊ(thm–?ýlist“#“thm)Ž’Ÿ3·Ä(Çr‘ÿ}'esult‘òØÄ)ŽŽŽŽŽŸ.š ’íÝuThe–=^ rst“argumen¸ãt“to“this“function“is“a“b•Go“olean‘=^ agŽ¡’íÝuwhicš¸ãh–ãKindicates“if“the“constan˜t“that“is“de ned“is“toŽ¡’íÝuha•¸ãv“e–‚in x“synš¸ãtactic“status.‘øThe“second“argumen˜t“isŽ¡’íÝuthe–½íname“under“whic¸ãh“the“resulting“de nition“will“bGeŽ¡’íÝusa•¸ãv“ed–ŠÆon“disk.‘The“third“argumen¸ãt“is“a“`pattern'“thatŽ¡’íÝusupplies–…uinformation“whic¸ãh“is“needed“bGecause“this“½MLŽ¡’íÝuÄfunction–´can“bGe“used“to“de ne“classes“of“inductiv¸ãelyŽ¡’íÝude ned–5Ÿrelations,‘m±rather“than“just“single“instances“ofŽ¡’íÝuthese–î²relations.‘=ÞDetails“of“the“purpGose“and“format“ofŽ¡’íÝuthis–LHpattern“will“bGe“explained“later.‘nThe“ nal“argumen¸ãtŽ¡’íÝuis–#¸a“list“of“rules,‘-¤eacš¸ãh“of“whic˜h“is“represen˜ted“b˜y“a“pairŽ¡’íÝuof–UUthe“form:Ž¦’ùÝuÊ([Ž’Çpr›ÿ}'emisses–“çand“side“c˜onditionsŽ’‰³—Ê],Ž’™sŽÇc‘ÿ}'onclusionŽ’ÇsšÊ)ŽŽŽŽ¦’íÝuÄThe–D rst“compGonen¸ãt“is“a“list“of“the“premisses“and“sideŽ¡’íÝuconditions,‘–ôwhic•¸ãh›‰Ôma“y˜bGe˜arranged˜in˜an“y˜order.‘DTheŽŽŽŽŽŸsç’ßûå3ŽŽŒ‹41 ¥,ò ýZÓ ˆ¹  ýFõ‘êñëÄsecond–õcompGonen¸ãt“is“the“conclusion“of“the“rule.‘QSideŽ¤ ‘êñëconditions–¢Rcan“bšGe“arbitrary“b˜o˜olean“terms,‘õ‘pro¸ãvidedŽ¡‘êñëthey––do“not“men¸ãtion“the“relation“bGeing“de ned.‘ˆ‰TheŽ¡‘êñëpremisses–‹Úand“conclusion“m¸ãust“bšGe“p˜ositiv¸ãe“assertions“ofŽ¡‘êñëmem¸ãbšGership–-ªin“the“relation“b˜eing“de ned.‘dŽThe“preciseŽ¡‘êñëform–Ä&that“these“assertions“mš¸ãust“tak˜e“is“explained“later,Ž¡‘êñëbut–°lroughly“spGeaking“the“premisses“and“conclusion“ofŽ¡‘êñëa–UUrule“m¸ãust“bGe“terms“of“form“Ê"ÅR‘…‡tŸÿ³1Ž‘ ˜ÛÅ:–ª¨:“:Ž‘_êtŸÿ´nŽ‘q~Ê"Ä,“whereŽŸ•Ë‘öñëÅR‘ÚßÊ:Ž‘ áôÅŸÿ³1Ž‘C‹Ê->Ž‘5EÅ:–ª¨:“:Ž‘&Q¬Ê->Ž‘3˜¾ÅŸÿ´nŽ‘8–Ê->Ž‘¨boolŽŽŽŽŸD£‘êñëÄis–&¾a“v‘ÿqÇariable“represen¸ãting“the“ÅnÄ-place“relation“that“isŽ¡‘êñëto–ÔbGe“de ned,‘Štand“eac¸ãh“ÅtŸÿ´iŽ‘TLÊ:Ž‘”IÅŸÿ´iŽ‘Ô Äis“an“arbitrary“term“notŽ¡‘êñëcon¸ãtaining‘UUÅRÇÄ.ŽŸ Q)‘öñëGiv¸ãen–gNan“in x“ ag,›«Ìa“name,˜a“pattern,˜and“a“listŽ¡‘êñëof–ìËrules,‘³the“½ML‘ì°Äfunction“Ênew_inductive_definitionŽ¡‘êñëÄautomatically›éPpro•¸ãv“es˜the˜existence˜of˜the˜least˜relationŽ¡‘êñëthat–r"satis es“these“rules.‘& A‘qéconstanš¸ãt“is“then“in˜troGducedŽ¡‘êñëto–ðldenote“this“relation“using“a“constan¸ãt“spGeci cation,Ž¡‘êñëthe–result“of“whicš¸ãh“is“sa˜v˜ed“on“disk“under“the“suppliedŽ¡‘êñëname.‘-The–B†v‘ÿqÇalue“returned“is“a“pair“consisting“of“a“list“ofŽ¡‘êñëtheorems–%ˆwhic¸ãh“state“that“the“newly-de ned“relationŽ¡‘êñësatis es–Yêthe“rules,‘›together“with“a“theoremŽ‘,I.assertingŽ¡‘êñërule–tcinduction“for“the“relation.‘ÎðThese“theorems“giv¸ãe“aŽ¡‘êñëcomplete–Æstatemen¸ãt“of“the“de ning“propGerties“for“theŽ¡‘êñëleast–UUrelation“closed“under“the“spGeci ed“set“of“rules.Ž¤óz‘êñëÒ4.1Ž‘ ²A–2simple“exampleŽ¡‘öñëÄThe–³³folloš¸ãwing“example“½HOL‘³šÄsession“sho˜ws“ho˜w“theŽ¤ ‘êñëfunction–!ºÊnew_inductive_definition“Äcan“bGe“used“toŽ¡‘êñëinductivš¸ãely–UUde ne“the“set“of“ev˜en“natural“n˜um˜bGers.ŽŸZûÕ‘êñ럳ò#‰ffëõ7 ‚ÌÍŸ™œ„“ºff ÿw»T’ÕoM„ ׸莒Ö(5„¸è®dŽ’Þ—ŸýóH¡8)Ïcmsl8ëH1ŽŽŽŽŸÿGƒ‘ÌÍÊ#let–?ý(rules,ind)“=Ž¡‘ŒÄlet–?ýEven“=“"Even:num->bool"“inŽ¡‘ŒÄnew_inductive_definition–?ýfalse“`Even`Ž¡‘ŒÄ("^Even–?ýn",“[])Ž©‘ŒÄ[‘?ý[Ž¡‘ ¾%–?ý-----------------------------“%“],Ž¡‘_ š"^Even‘?ý0"‘9¿ß;Ž¦‘ ¾[‘9¿ß"^Even‘?ýn"Ž¡‘ ¾%–?ý-----------------------------“%“],Ž¡‘TŒ "^Even‘?ý(n+2)"‘)ÿè];;ŽŽ’ë[ž„“ºffŽŽŸ‰ffëõ7ŽŽŽŸZª­‘êñëÄThe– rst“rule“in“this“de nition“states“that“Ê0“Äis“an“ev¸ãenŽ¡‘êñënatural›>Én•¸ãum“bGer,‘y&and˜the˜second˜rule˜states˜that˜if˜ÊnŽ¡‘êñëÄis–Tdevš¸ãen“then“Ên+2“Äis“also“ev˜en.‘ nô(An˜tiquotation“andŽ¡‘êñë½ML‘ûÏÄcommenš¸ãts–ûæare“used“to“giv˜e“a“readable“presen˜tationŽ¡‘êñëof––…these“rules.)‘5XSince“the“evš¸ãen“natural“n˜um˜bGers“areŽ¡‘êñëexactlyŽ‘ !Xthose›ön•¸ãum“bGers˜obtainable˜from˜zero˜b“y˜addingŽ¡‘êñëmš¸ãultiples–P›of“t˜w˜o,‘„Áthese“rules“inductiv˜ely“de ne“`ÊEven‘?ýnÄ'Ž¡‘êñësucš¸ãh–UUthat“it“holds“preciselyŽ‘,@when“Ên“Äis“ev˜en.ŽŽŽ ýFõ’ùÝuThe–‘v‘ÿqÇalue“supplied“for“the“pattern“in“this“example“isŽ¤ ’íÝuthe–«7pair“Ê("Even‘?ýn",[])Ä.‘slThe“ rst“compGonen¸ãt“of“thisŽ¡’íÝupair–[indicates“that“the“constan¸ãt“to“bGe“de ned,‘\„namelyŽ¡’íÝuÊEvenÄ,‘*ƒis–Ì­a“one-place“function“with“tš¸ãypical“argumen˜tŽ¡’íÝuÊnÄ.‘+ŒIn–“Ageneral,‘¢¼the“second“compGonen¸ãt“of“a“pattern“is“aŽ¡’íÝunon-empt¸ãy–£§list“only“when“a“Çclass‘uÈÄof“relations“is“bGeingŽ¡’íÝude ned–¹(see“bGelo¸ãw).‘œÈIn“this“example,‘ÑëÊEven“Äis“a“singleŽ¡’íÝuinductivš¸ãely-de ned–è…predicate,‘ Qand“the“list“compGonen˜tŽ¡’íÝuof–UUthe“pattern“is“therefore“empt¸ãy‘ÿ*ª.Ž¡’ùÝuWhen–ˆ˜the“de nition“shoš¸ãwn“in“bGo˜x“1“is“ev‘ÿqÇaluated,Ž¡’íÝuÊnew_inductive_definition–üôÄautomatically“pro•¸ãv“es‘üôtheŽ¡’íÝuexistence–a|of“the“least“predicate“closed“under“the“giv¸ãenŽ¡’íÝulist–\0of“rules“and“then“de nes“the“constan¸ãt“ÊEven“ÄtoŽ¡’íÝudenote–ô|this“predicate.‘ O=The“follo¸ãwing“automatically-Ž¡’íÝupro•¸ãv“ed–UUtheorems“abGout“ÊEven“Äare“then“returned:Ž©4cB’íÝuŸØ9@‰ffëõ7ŸFóäÌÍŸ™œ„J€ffŸÀIŽ’ÕoM„ ׸莒Ö(5„¸è®dŽ’Þ—ŸýëH2ŽŽŽŽŸÿGƒ‘ÌÍÊrules‘?ý=Ž¡‘ÌÍ[Æ`–?ýÊEven“0;Ž¡‘ ÊÆ`–?ý8‘ª¨Ên.“Even“n“Æ“ÊEven(n“+“2)]“:“thm“listŽ¡‘ÌÍind‘?ý=Ž¡‘ÌÍÆ`–?ý8›ª¨ÊP.“P“0“Æ^“Ê(Æ8˜Ên.“P“n“Æ“ÊP(n“+“2))“ÆŽ¡‘&÷cÊ(Æ8‘ª¨Ên.–?ýEven“n“Æ“ÊP“n)ŽŽ’ë[ž„J€ffŽŽŸ‰ffëõ7ŽŽŽ¦’íÝuÄThe–š!theorems“bGound“to“the“½ML‘šÄiden¸ãti er“Êrules“ÄstateŽ¡’íÝuthat–¹the“required“rules“hold“of“the“predicate“ÊEvenÄ.‘*“AndŽ¡’íÝuthe–)}rule“induction“theorem“bGound“to“Êind“Ästates“thatŽ¡’íÝuthe–Ωset“of“n•¸ãum“bGers–Ωfor“whic¸ãh“ÊEven“Äholds“is“the“least“setŽ¡’íÝuthat–UUsatis es“these“rules.Ž¡’ùÝuAn–o´analogous“set“of“de ning“theorems“can“bGe“pro•¸ãv“edŽ¡’íÝuautomatically–îtfor“anš¸ãy“particular“relation“inductiv˜elyŽ¡’íÝude ned–g‚bš¸ãy“a“list“of“rules.‘¨NThe“next“section“sho˜ws“ho˜wŽ¡’íÝuthis–B–derivš¸ãed“principle“of“inductiv˜e“de nition“in“½HOL‘BQÄcanŽ¡’íÝualso–?½bGe“used“to“de ne“a“parameterized“class“of“relations.Ž¤´ï’íÝuÒ4.2Ž’ Œ*->bool)->*->*->bool"Ž¡‘ ÊinŽ¡‘ŒÄnew_inductive_definition–?ýfalse“`Rtc`Ž¡‘ŒÄ("^Rtc–?ýR“x“y",“["R:*->*->bool"])Ž©‘ŒÄ[–?ý[‘î"R“(x:*)“(y:*):bool"Ž¡‘ ¾%–?ý-----------------------------“%“],Ž¡‘TŒ "^Rtc–?ýR“x“y"‘4â;Ž¦‘ ¾[Ž¡‘ ¾%------------------------------–?ý%“],Ž¡‘TŒ "^Rtc–?ýR“x“x"‘4â;Ž¦‘ ¾[› ú"^Rtc–?ýR“x“z";˜"^Rtc“R“z“y"Ž¡‘ ¾%------------------------------–?ý%“],Ž¡‘TŒ "^Rtc–?ýR“x“y"‘4â];;ŽŽ’ë[ž„ÏñffŽŽŸ‰ffëõ7ŽŽŽŸvq ‘êñëÄThe–UUpattern“in“this“case“is“the“pair:Ž¤sU‘öñëÊ("Rtc–?ýR“x“y",“["R:*->*->bool"])Ž¡‘êñëÄThe–¸˜ rst“compšGonen¸ãt“of“this“pattern“sp˜eci es“that“theŽ¤ ‘êñëfunction–ä'ÊRtc“Äis“to“takš¸ãe“three“argumen˜ts“in“total|aŽ¡‘êñërelationŽ‘WÊRÄ,–¹and“t•¸ãw“o–¹v‘ÿqÇalues“Êx“Äand“ÊyÄ.‘X>The“secondŽ‘#the“terms“that“o˜ccur“atŽ¡’íÝupGositionsŽ’cwhic¸ãh,‘oaccording–‡to“the“supplied“pattern,Ž¡’íÝucorrespGondŽ’!ú…to–€˜the“parameters“of“a“class“of“relations.Ž¡’íÝuIn–Þöparticular,‘]the“terms“that“ošGccur“at“these“p˜ositionsŽ¡’íÝumš¸ãust–NÀbGe“the“same“v‘ÿqÇariables“giv˜en“in“the“pattern“itself.ŽŸ È’ùÝuThe–ÀÌrules“for“re exiv•¸ãe-transitiv“e–ÀÌclosure“sho¸ãwn“inŽ¡’íÝubGo¸ãx–^Ñ3“conform“to“this“restriction.‘Ž:Here,‘¡/the“patternŽ¡’íÝuindicates– âthat“in“the“tš¸ãypical“assertion“of“mem˜bGershipŽ¡’íÝuÊ"Rtc–?ýR“x“y"–!5Ä(i.e.“the“ rst“compGonen¸ãt“of“the“pattern),Ž¡’íÝuthe–•v‘ÿqÇariable“ÊR‘”ÉÄmarks“the“pGosition“of“a“parameter“toŽ¡’íÝuthe–»class“of“relations“to“bGe“de ned.‘^éEv¸ãery“premiss“andŽ¡’íÝuconclusion–r_menš¸ãtioned“in“the“rules“m˜ust“therefore“bGe“aŽ¡’íÝuterm–bof“the“form“Ê"Rtc‘?ýRŽ‘'jKÅtŸÿ³1Ž‘ @ÅtŸÿ³2Ž‘|sÊ"Ž‘ ¼pÄ,‘eßwhere“the“argumen¸ãtsŽ¡’íÝuÅtŸÿ³1Ž–Ä¿Äand›HLÅtŸÿ³2Ž“Äma¸ãy˜bGe˜arbitrary˜terms˜but˜the˜parameter˜ÊRŽ¡’íÝuÄmš¸ãust–UUbGe“the“v‘ÿqÇariable“giv˜en“in“the“pattern.ŽŸ8W’íÝuÛ5Ž’uA–€tactic“for“rule“inductionŽŸ8W’ùÝuÄThe–Ð%inductivš¸ãe“de nitions“pac˜k‘ÿqÇage“in“½HOL‘ÐÄincludes“aŽ¡’íÝun•¸ãum“bšGer–ñaof“auxiliary“functions“that“supp˜ort“reasoningŽ¡’íÝuabGout–Sinductiv¸ãely-de ned“relations,‘ŒRin“addition“to“theŽ¡’íÝuderivš¸ãed–>(rule“of“de nition“itself.‘,?The“most“impGortan˜tŽ¡’íÝuof–Ô&these“is“the“follo¸ãwing“general“tactic“for“goal-directedŽ¡’íÝuproGofs–UUb¸ãy“rule“induction:Ž©)ªŸçæd’ùÝuÊRULE_INDUCT_THENŽŽ¡’ÿr:–?ýthm“->Ž’Œ?ÄÄ(Çinduction‘“çthm‘ÄcÄ)ŽŽ¡’ lÊ(thm–?ý->“tactic)“->Ž’Œ?ÄÄ(Çpr–ÿ}'emiss‘“çc“ont.Ä)ŽŽ¡’ lÊ(thm–?ý->“tactic)“->Ž’Œ?ÄÄ(Çside–“çc›ÿ}'ond.“c˜ont.Ä)ŽŽ¡’ lÊtacticŽ’Œ?ÄÄ(Çr‘ÿ}'esult‘òØÄ)ŽŽŽŽŽ¦’íÝuThe–R³ rst“argumen¸ãt“to“this“function“is“the“rule“inductionŽŽ¡’íÝutheorem–±Freturned“b¸ãy“Ênew_inductive_definition“ÄforŽ¡’íÝua–ù{givš¸ãen“inductiv˜ely-de ned“relation.‘^9Lik˜e“the“generalŽ¡’íÝustructural–’(induction“tactic“in“½HOLÄ,“the“rule“inductionŽ¡’íÝutactic–4ñis“parameterized“b¸ãy“functions“that“determineŽ¡’íÝuwhat–Ais“done“with“induction“hš¸ãypGotheses.‘/These“ma˜y“bGeŽ¡’íÝueither–Òåpremisses“or“side“conditions,‘òHand“the“user“ma¸ãyŽŽŽŽŽŸsç’ßûå5ŽŽŒ‹g¢ ¥,ò ýZÓ ˆ¹  ýFõ‘êñëÄwish– to“treat“these“t•¸ãw“o– kinds“of“induction“h¸ãypGothesesŽ¤ ‘êñëdi eren•¸ãtly‘ÿ*ª.‘‰'Tw“o–²useparate“theorem“con•¸ãtin“uations‘²uareŽ¡‘êñëtherefore–ľsupplied“as“the“second“and“third“argumen¸ãtsŽ¡‘êñëto–UUthe“function“ÊRULE_INDUCT_THENÄ.ŽŸ `‘öñëGivš¸ãen–zthe“rule“induction“theorem“for“an“inductiv˜ely-Ž¡‘êñëde ned–%µÅnÄ-ary“relation“ÅRÇÄ,‘/;the“function“describšGed“ab˜o•¸ãv“eŽ¡‘êñëreturns–ñqa“spGecialized“rule“induction“tactic“that“reducesŽ¡‘êñëgoals–UUof“the“form:ŽŸtß‘öñëÊ"Ž‘ü1èÆ8ÅxŸÿ³1Ž‘î3Å:–ª¨:“:Ž– šxŸÿ´nŽ‘q~Ê.Ž‘ x“ÅR‘ÚßxŸÿ³1Ž‘î3Å:–ª¨:“:Ž“xŸÿ´nŽ‘8–Æ‘ÇÅP‘cÄ[ÅxŸÿ³1Ž‘|sÅ;–ª¨:“:“:Ž‘ÿ÷;‘ª¨xŸÿ´nŽ‘q~Ä]Ê"ŽŽŽŽŸ]‘êñëÄto–Ù¶the“subgoal(s)“of“proš¸ãving“that“the“propGert˜y“ÅP‘=EÄisŽ¡‘êñëpreserv•¸ãed›”Lb“y˜the˜rules˜that˜inductiv“ely˜de ne˜ÅRÇÄ.‘.¬TheŽ¡‘êñërule–UUinduction“theorem“for“ÊRtcÄ,“for“example,“is:ŽŸ“tacticŽ¡‘êñëÄThe–cBtheorem“argumen¸ãt“to“this“function“is“expGected“toŽ¤ ‘êñëbGe–zÉa“rule“expressed“in“the“form“pro•¸ãv“ed›zÉb“y˜the˜deriv“edŽ¡‘êñëprinciple–(Lof“inductiv¸ãe“de nition“describGed“in“section“4.Ž¡‘êñëGiv•¸ãen›„£suc“h˜a˜theorem,‘ÐwÊRULE_TAC‘„UÄconstructs˜a˜tacticŽ¡‘êñëthat›cýin•¸ãv“erts˜the˜rule˜stated˜b“y˜it.‘¾The˜resulting˜tacticŽ¡‘êñëreduces–`"goals“that“matc¸ãh“the“conclusion“of“the“rule“toŽ¡‘êñësubgoals–Tðconsisting“of“the“correspGonding“instances“ofŽ¡‘êñëits–UUpremisses“and“side“conditions.Ž¡‘öñëConsider,–Ãafor›žãexample,“the˜theorem˜whic¸ãh˜states˜theŽ¡‘êñëtransitivit¸ãy–UUrule“for“ÊRtcÄ:ŽŸÚï‘öñëÆ`‘Ç8‘ª¨ÊR–?ýx“y.Ž‘&j“(Ž‘+ªÆ9‘ª¨Êz.–?ýRtc“R“x“zŽ‘H#aÆ^‘xÝÊRtc–?ýR“z“y)ŽŽŽ¡‘0j”ÆŽŽ¡‘&j“ÊRtc–?ýR“x“yŽŽŽŽŽŽŽŸ-fR‘êñëÄWhen–[ãapplied“to“this“theorem,‘]‡the“function“ÊRULE_TACŽ¡‘êñëÄreturns–UUthe“tactic“describGed“b¸ãy:ŽŸ#e„ŸóÕ‘,h –ÿøÊ?-“Rtc–ÇÅR‘Úßx“yŽŽŸ "Ç‘öñëŸú»k‰ff°h6Ÿff‰ff°h6ŽŽŽŽ¡‘~zÄ–ÿøÊ?-“Æ9Åzp—Ê.–ÇRtc“ÅR›Úßx“z‘pÆ^‘Ž0ÊRtc“ÅR˜z‘7¯yŽŽŽŽŽ©#eƒ‘êñëÄThis–˜˜tactic“can“then“bšGe“used“in“goal-directed“pro˜ofsŽ¡‘êñëab•Gout›ü®mem¸ãb“ership˜in˜the˜inductiv¸ãely-de ned˜relationŽ¡‘êñëÊRtc›ÇÅRÇÄ.‘]µThe–other“t•¸ãw“o–rules“that“de ne“ÊRtc˜ÅR‘,æÄcan“alsoŽ¡‘êñëbGe›Òcon•¸ãv“erted˜in“to˜tactics˜using˜the˜function˜ÊRULE_TACÄ.Ž¡‘êñëThe–5Eresult“is“a“complete“set“of“½HOL‘5 Ätactics“for“goal-Ž¡‘êñëdirected–ÇÊproGofs“in“the“deductiv¸ãe“system“comprising“theŽ¡‘êñëthree–UUrules“that“de ne“re exiv•¸ãe-transitiv“e‘UUclosure.Ž¡‘öñëIt–‹Úis“inš¸ãtended“that“the“inductiv˜e“de nitions“pac˜k-Ž¡‘êñëage–7Öwill“also“include“a“function“that“maps“rules“statedŽ¡‘êñëas–—theorems“to“forw¸ãard“inference“rules“in“½HOL‘—ŒÄ(i.e.“toŽ¡‘êñë½ML‘°ðÄfunctions).‘„ßF‘ÿ*ªor–±example,‘Çôthe“transitivit¸ãy“theoremŽ¡‘êñësho•¸ãwn›ü&abGo“v“e˜can˜bGe˜used˜to˜implemen“t˜the˜follo“wingŽ¡‘êñëderiv¸ãed–UUinference“rule:ŽŸ!s½ŸóÕ‘iùŸÿ³1Ž‘C‹Æ`Ž›'ÊRtc–ÇÅR‘Úßx“z‘p™ÄŸÿ³2Ž‘C‹Æ`Ž˜ÊRtc“ÅR‘Úßz‘7¯yŽŽŸ "Ç‘öñëŸûff°h6ŽŽŽŽ¡‘#¨šÄŸÿ³1Ž‘µSÆ[‘8àÄŸÿ³2Ž‘C‹Æ`Ž‘'ÊRtc–ÇÅR‘Úßx“yŽŽŽŽŽ¦‘êñëÄAnš¸ãy–R³rule“expressed“as“a“theorem“of“the“form“pro˜v˜edŽ¡‘êñëbš¸ãy–ß'the“deriv˜ed“principle“of“inductiv˜e“de nitions“canŽ¡‘êñëlikš¸ãewise–ƒRbGe“con˜v˜erted“in˜to“a“forw˜ard“inference“rule.‘û¾AŽ¡‘êñëfunction–ã)that“automaticallyŽ‘CAconstructs“suc¸ãh“rules“hasŽ¡‘êñënot–2‘yš¸ãet“bGeen“implemen˜ted,‘iàpartly“bGecause“it“has“notŽ¡‘êñëbGeen–Ò_found“necessary“for“the“applications“done“so“farŽŽŽ ýFõ’íÝu(see–8section“8).‘\F‘ÿ*ªor“completeness,›!>ho•¸ãw“ev“er,˜the‘8authorŽ¤ ’íÝuinš¸ãtends–Z™in“future“to“add“this“function“to“the“inductiv˜eŽ¡’íÝude nitions‘UUpac¸ãk‘ÿqÇage.ŽŸ¬’íÝuÛ7Ž’uCase‘€analysisŽŸ¬’ùÝuÄThe–V nal“ma‘Ž8jor“compGonenš¸ãt“of“the“½HOL“Äpac˜k‘ÿqÇage“forŽ¡’íÝuinductivš¸ãe–hUde nitions“is“an“½ML‘hPÄfunction“that“pro˜v˜es“anŽ¡’íÝuexhaustiv¸ãeŽ’t‚case–³xanalysis“theorem“for“anš¸ãy“giv˜en“relationŽ¡’íÝuinductivš¸ãely–;ède ned“b˜y“a“set“of“rules.‘%€The“name“andŽ¡’íÝut¸ãypGe–UUof“this“function“are:Ž¤¬’ùÝuÊderive_cases_thm–?ý:“(thm“list“#“thm)“->“thmŽ¡’íÝuÄThe–Ñargumen¸ãts“to“this“function“are“the“list“of“rulesŽ¤ ’íÝusatis ed–±bš¸ãy“an“inductiv˜ely“de ned“relation,‘togetherŽ¡’íÝuwith–äàits“rule“induction“theorem.‘ g(These“are“preciselyŽ¡’íÝuthe–Þ$de ning“theorems“whicš¸ãh“are“pro˜v˜ed“and“returnedŽ¡’íÝub¸ãy–r—Ênew_inductive_definitionÄ.)‘&3When“supplied“withŽ¡’íÝuthese–-,theorems,‘c!Êderive_cases_thm“Äpro•¸ãv“es–-,that“if“anŽ¡’íÝuassertion–¬of“mem¸ãbGership“in“the“relation“holds,‘ÁÌthen“itŽ¡’íÝuholds–only“b¸ãy“virtue“of“the“fact“that“one“of“the“rulesŽ¡’íÝucan–žtbGe“used“to“derivš¸ãe“it.‘M#This“allo˜ws“one“to“driv˜e“theŽ¡’íÝurules–-?that“de ne“a“relation“`bac•¸ãkw“ards',‘5Cinferring‘-?fromŽ¡’íÝuthe–:5conclusion“of“one“of“the“rules“that“the“premissesŽ¡’íÝuand–UUside“conditions“hold.Ž¡’ùÝuThe–UQfolloš¸ãwing“in˜teraction“with“the“½HOL‘T‹ÄsystemŽ¡’íÝushoš¸ãws–C3the“theorem“pro˜v˜ed“b˜y“Êderive_cases_thm“ÄforŽ¡’íÝuthe–’zÊRtc“Äexample“in¸ãtrošGduced“ab˜o•¸ãv“e.‘)7The‘’z½ML‘’kÄv‘ÿqÇariablesŽ¡’íÝuÊrules–hÖÄand“Êind“Äare“assumed“to“ha•¸ãv“e–hÖthe“bindings“sho¸ãwnŽ¡’íÝuabšGo•¸ãv“e–UUin“b˜o¸ãx“4.ŽŸ4:ò’íÝuŸ×‡w‰ffëõ7ŸHWuÌÍŸ™œ„KñffŸ¾åý’ÕoM„ ׸莒Ö(5„¸è®dŽ’Þ—ŸýëH9ŽŽŽŽŸÿGƒ‘ÌÍÊ#derive_cases_thm‘?ý(rules,ind);;Ž¡‘ÌÍÆ`–?ý8‘ª¨ÊR“x“y.Ž¡‘ÌÁRtc–?ýR“x“y“ÆŽ¡‘%L»ÊR–?ýx“y‘¿÷Æ_Ž¡‘%L»Ê(y–?ý=“x)“Æ_Ž¡‘%L»Ê(Æ9‘ª¨Êz.–?ýRtc“R“x“z“Æ^“ÊRtc“R“z“y)ŽŽ’ë[ž„KñffŽŽŸ‰ffëõ7ŽŽŽŸ6,¸’íÝuÄRoughly–2yspGeaking,‘9rthe“resulting“theorem“states“that“ifŽ¡’íÝuÊRtc–?ýR“x“y–UUÄholds,“then“either:ŽŸÌ­’÷ÝvÆŽŽŽ’ÝwÄit–Âis“deriv‘ÿqÇable“bš¸ãy“the“inclusion“rule“ÁRÉ1Ä,‘Ý0in“whic˜hŽ¡’Ýwcase–UUÊx“Äand“Êy“Äare“related“b¸ãy“ÊRÄ;“orŽ©¬’÷ÝvÆŽŽŽ’ÝwÄit–6íis“deriv‘ÿqÇable“bš¸ãy“the“re exivit˜y“rule“ÁRÉ2Ä,‘=in“whic˜hŽ¡’Ýwcase–UUÊx“Äand“Êy“Äare“equal;“orŽ¦’÷ÝvÆŽŽŽ’ÝwÄit–›Æis“deriv‘ÿqÇable“bš¸ãy“the“transitivit˜y“rule“ÁRÉ3Ä,‘Àãin“whic˜hŽ¡’Ýwcase–`there“mš¸ãust“bGe“an“in˜termediate“v‘ÿqÇalue“Êz“Äsuc˜hŽ¡’Ýwthat›UUÊRtc–?ýR“x“z˜Äand˜ÊRtc“R“z“yÄ.ŽŸÌ­’íÝuA‘º cmmi10óKñ`y cmr10ót ‰: cmbx9óo´‹Ç cmr9ó O!â…cmsy7ó 0e—rcmmi7óÙ“ Rcmr7ù¸1ßßßßßhol88-2.02.19940316/Library/ind_defs/Paper/macros.tex0000640000212700021270000000264705071426745020203 0ustar cammcamm\def\trule#1{\hbox{\vbox to 3mm{\vfill\hrule height0.4pt width#1\vskip2pt\hrule height0.4pt width#1\vfill}}} \def\rrule#1{\hbox{\vbox to 3mm{\vfill\hrule height0.4pt width#1\vfill}}} \def\Rule#1#2{\mbox{${\displaystyle\raise 3pt\hbox{$\;\;\;#1\;\;\;$}} \over {\displaystyle\lower5pt\hbox{$\;\;\;#2\;\;\;$}}$}} % --------------------------------------------------------------------- % Macros for little HOL sessions displayed in boxes. % % Usage: (1) \setcounter{sessioncount}{1} resets the session counter % % (2) \begin{session}\begin{verbatim} % . % < lines from hol session > % . % \end{verbatim}\end{session} % % typesets the session in a numbered box. % --------------------------------------------------------------------- \newlength{\hsbw} \setlength{\hsbw}{83mm} \addtolength{\hsbw}{-\arrayrulewidth} \addtolength{\hsbw}{-\tabcolsep} \newcommand\HOLSpacing{12pt} \newcounter{sessioncount} \setcounter{sessioncount}{1} \newenvironment{session}{\begin{flushleft} \begin{tabular}{@{}|c@{}|@{}}\hline \begin{minipage}[b]{\hsbw} % \vspace*{-.5pt} \begin{flushright} \rule{0.01in}{.15in}\rule{0.3in}{0.01in}\hspace{-0.35in} \raisebox{0.04in}{\makebox[0.3in][c]{\footnotesize\sl \thesessioncount}} \end{flushright} \vspace*{-11.5mm} \begingroup}{\endgroup\end{minipage}\\ \hline \end{tabular} \end{flushleft} \stepcounter{sessioncount}} hol88-2.02.19940316/Library/ind_defs/Paper/alltt.sty0000640000212700021270000000253105071426756020050 0ustar cammcamm% ALLTT DOCUMENT-STYLE OPTION - released 17 December 1987 % for LaTeX version 2.09 % Copyright (C) 1987 by Leslie Lamport % Defines the `alltt' environment, which is like the `verbatim' % environment except that `\', `\{', and `\}' have their usual meanings. % Thus, other commands and environemnts can appear within an `alltt' % environment. Here are some things you may want to do in an `alltt' % environment: % % * Change fonts--e.g., by typing `{\em empasized text\/}'. % % * Insert text from a file foo.tex by typing `input{foo}'. Beware that % each stars a new line, so if foo.tex ends with a % you can wind up with an extra blank line if you're not careful. % % * Insert a math formula. Note that `$' just produces a dollar sign, % so you'll have to type `\(...\)' or `\[...\]'. Also, `^' and `_' % just produce their characters; use `\sp' or `\sb' for super- and % subscripts, as in `\(x\sp{2}\)'. \def\docspecials{\do\ \do\$\do\&% \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~} \def\alltt{\trivlist \item[]\if@minipage\else\vskip\parskip\fi \leftskip\@totalleftmargin\rightskip\z@ \parindent\z@\parfillskip\@flushglue\parskip\z@ \@tempswafalse \def\par{\if@tempswa\hbox{}\fi\@tempswatrue\@@par} \obeylines \tt \catcode``=13 \@noligs \let\do\@makeother \docspecials \frenchspacing\@vobeyspaces} \let\endalltt=\endtrivlist hol88-2.02.19940316/Library/ind_defs/Paper/paper.tex0000640000212700021270000011354105151750764020022 0ustar cammcamm\documentstyle[alltt,twocolumn,fleqn,layout]{article} \pagestyle{plain} \flushbottom \sloppy \begin{document} \input{macros} \sloppy \twocolumn[{\scriptsize \parbox{100mm}{Preprint of a paper to appear in the Proceedings of the 1991 International Tutorial and Workshop on the HOL Theorem Proving System, 27--30 August 1991, Davis California (IEEE Computer Society Press).}}\vskip10mm \begin{center} {\Large\bf A Package for Inductive Relation Definitions in HOL}\\ \vskip24pt T.\ F.\ Melham\\ \vskip12pt University of Cambridge Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, CB2 3QG, England.\\ \mbox{}\\ \vskip3mm \end{center}] \subsection*{\centering Abstract} {\it\sloppy This paper describes a set of theorem proving tools based on a new derived principle of definition in HOL, namely the introduction of relations inductively defined by a set of rules. Such inductive definitions abound in computer science. Example application areas \mbox{include} reasoning about structured operational semantics, type judgements, transition relations for process algebras, \mbox{reduction} relations, and compositional proof systems. The package described in this paper automates the derivation of certain inductive definitions involved in these applications and provides the basic tools needed for reasoning about the relations introduced by them.} \vskip12pt \section{Introduction} The HOL user community has a strong tradition of taking a purely {\it definitional\/} approach to using higher order logic. That is, the syntax of the logic is extended with new notation not simply by postulating axioms to give meaning to it, but rather by defining it in terms of existing expressions of the logic that already have the required semantics. The advantage of this approach, as opposed to the axiomatic method, is that each of the primitive rules of definition in the {\small HOL} logic---namely, constant definition, constant specification, and type definition---is guaranteed to preserve consistency. The disadvantage is that these rules admit only \mbox{definitions} that satisfy certain very restrictive rules of formation. Definitions expressed in any other form must always be justified formally by deriving them from equivalent, but possibly rather complex, primitive definitions. The {\small ML} metalanguage allows users to implement derived inference rules in the {\small HOL} system and thus provides a facility for automating proofs that justify derived rules of definition. For example, recursive \mbox{definitions} are not admitted by the primitive rules of definition of the {\small HOL} logic. But certain recursive type definitions and function definitions are supported in the system by derived inference rules written in {\small ML}~\cite{description,melham}. The details of the primitive definitions that underlie these rules are hidden from the user, and their {\small ML} implementations are highly optimized. So these \mbox{derived} principles of definition may simply be regarded as primitive by most users of the system. This paper describes a set of theorem-proving tools based on a new derived principle of definition in {\small HOL} for defining relations inductively by a set of rules. \mbox{Sections~\ref{ind-defs}} and~\ref{in-logic} give a general introduction to the class of inductive definitions handled by the package and explain the logical basis for these definitions. The remaining sections describe the {\small ML} functions provided by the package and briefly mention some applications for which the package can be used. \section{Inductive definitions}\label{ind-defs} The following is a simple but typical example of a relation defined inductively by a set of rules. (This example is taken from~\cite{pitts}.) Let $R \subseteq A \times A$ be a binary relation on a set $A$. The reflexive-transitive closure of $R$ can be defined to be the least relation $R^{*} \subseteq A \times A$ for which the following deduction rules hold. \medskip \[ \begin{array}[t]{@{}l} \hbox{{\small\bf R}\bf 1}\quad\Rule{}{R^{*}(x,y)}\;\; R(x,y) \\[6mm] \hbox{{\small\bf R}\bf 2}\quad\Rule{}{R^{*}(x,x)}\\[8mm] \hbox{{\small\bf R}\bf 3}\quad\Rule{R^{*}(x,z)\qquad R^{*}(z,y)} {R^{*}(x,y)} \end{array} \] \medskip \noindent These rules state precisely the properties required of the reflexive-transitive closure of the relation $R$. Rule {{\small\bf R}\bf 1} states that it must contain at least all the values in $R$; rule {{\small\bf R}\bf 2} states that it must be reflexive; and rule {{\small\bf R}\bf 3} states that it must be transitive. The reflexive-transitive closure $R^{*}$ may therefore simply be {\it defined\/} to be the least relation that satisfies these conditions. It then follows simply by definition that the rules {{\small\bf R}\bf 1}, {{\small\bf R}\bf 2} and {{\small\bf R}\bf 3} are in fact satisfied by $R^{*}$. Moreover, it follows immediately that $R^{*}$ is a subset of any other relation that satisfies these rules, since $R^{*}$ is defined to be the {\it least\/} such relation. This means that $R^{*}$ contains only those pairs of values that it must contain by virtue of satisfying the rules. As will be discussed below, this property gives rise to an induction principle for reasoning about the relation $R^{*}$. The definition given above is valid because the rules {{\small\bf R}\bf 1}, {{\small\bf R}\bf 2}, and {{\small\bf R}\bf 3} make only positive statements about the elements of $R^{*}$. This guarantees that the least relation satisfying these rules does exist. In particular, if the rules have this form, then one can show that the intersection of any set of relations that satisfy the rules also satisfies the rules. Moreover, at least one binary relation satisfies the rules, namely the maximal relation $A \times A$. The `least' or smallest relation that satisfies the rules may therefore legitimately be defined to be the intersection of all such relations. In general, an inductive definition of an $n$-place \mbox{relation} $R$ consists of a set of rules of the form: \smallskip \[ \Rule{R(t_1^1,\dots,t_n^1) \quad \cdots \quad R(t_1^i,\dots,t_n^i)} {R(t_1,\dots,t_n)}\;\;C_1\:\cdots\:C_j \] \smallskip \noindent The terms above the line are the {\it premisses\/} of the rule, each of which makes a positive assertion of membership in the relation $R$. The term below the line, called the {\it conclusion\/} of the rule, likewise asserts membership in $R$. The terms $C_1$,\dots,$C_j$ are {\it side conditions\/} on the rule; these may be arbitrary propositions not involving the relation $R$ being defined. A relation $R$ is {\it closed\/} under such a rule if whenever the premisses and side conditions hold, the conclusion also holds. The relation {\it inductively defined\/} by a collection of such rules is the least relation closed under all the rules. \subsection{Rule induction}\label{rule-ind} By virtue of its definition as the {\it least\/} relation closed under a set of rules, every inductively defined relation comes with an associated induction principle. This principle of {\it rule induction\/} is essential for many proofs involving such relations. (The term `rule induction' was coined by Glynn Winskel in~\cite{winskel}). The principle of rule induction for an inductively defined relation may be stated briefly as follows. Let $R$ be an $n$-place relation inductively defined by a set of rules, and suppose we wish to show that every element in $R$ has a certain property $P$: {\samepage \begin{equation}\label{fact1} \hbox{\rm if}\;\;R(x_1,\dots,x_n)\;\;\hbox{then}\;\;P[x_1,\dots,x_n] \end{equation} \noindent Since $R$ is} \pagebreak[3] the least relation closed under the rules, any relation $S$ which is also closed under the rules has the property that $R \subseteq S$. Now, let \[S = \{(x_1,\dots,x_n) \mid P[x_1,\dots,x_n]\}\] \noindent Then to prove the desired property of $R$, it suffices to show that the relation $S$ is closed under the rules that define $R$. For if the relation $S$ in fact is closed under the rules, then we have that $R \subseteq S$ and therefore that every element of $R$ has the defining property of $S$---i.e.\ statement~(\ref{fact1}) holds of the relation $R$. For the relation $R^{*}$ defined above, the principle of rule induction is stated as follows. In order to prove that a property $P[x,y]$ holds for all $x$ and $y$ for which $R^{*}(x,y)$, it suffices to show that: \begin{itemize} \item for all $x$ and $y$, $R(x,y)$ implies $P[x,y]$ \item for all $x$, $P[x,x]$ \item for all $x$, $y$, and $z$, $P[x,z]$ and $P[z,y]$ imply $P[x,y]$ \end{itemize} \noindent This is an inductive form of argument: if the property $P$ holds in the `base cases' corresponding to rules {{\small\bf R}\bf 1} and {{\small\bf R}\bf 2}, and if $P$ is preserved by the rule {{\small\bf R}\bf 3} (the `step case' of the induction), then every pair in $R^{*}$ has the property $P$. A similar induction principle holds for every relation inductively defined by a set of rules. \section{Inductive definitions in logic}\label{in-logic} Inductive definitions are based on the concept of a relation being closed under a set of rules. Since rules are essentially implications---{\it if\/} the premisses and side conditions hold, {\it then\/} the conclusion holds---it is straightforward to express this concept in logic. Consider, for example, the rules given above for reflexive-transitive closure. Let $R : \alpha{\rightarrow}\alpha{\rightarrow}bool$ be a fixed but arbitrary relation on $\alpha$. (Here, a relation is represented by a curried function; but we shall continue to speak loosely of a pair of values $x$ and $y$ as being `in' the relation $R$ when $R\;x\;y$ holds.) The following formula then asserts that a relation $P : \alpha{\rightarrow}\alpha{\rightarrow}bool$ is closed under the rules defining the reflexive-transitive closure of $R$: \smallskip \[\begin{array}[t]{@{}l} (\forall x\:y.\:R\;x\;y \supset P\;x\;y)\; \wedge \\ (\forall x.\:P\;x\;x)\; \wedge \\ (\forall x\:y.\:(\exists z.\:P\;x\;z \wedge P\;z\;y) \supset P\;x\;y) \end{array}\] \smallskip \noindent Each rule is expressed by a quantified implication of its conclusion by the conjunction of its premisses and side conditions. A rule with no side conditions or premisses is just represented by a universally quantified assertion of its conclusion. Closure of a relation under any set of rules of the form discussed above can be expressed in logic in a similar way. Using this method of expressing the notion of \mbox{closure} under a set of rules, one can define the {\it least\/} relation closed under a set of rules simply by taking the intersection of all such relations. For example, a function \[ {\sf Rtc} : (\alpha{\rightarrow}\alpha{\rightarrow}bool) \rightarrow (\alpha{\rightarrow}\alpha{\rightarrow}bool) \] \noindent that maps an arbitrary relation $R : \alpha{\rightarrow}\alpha{\rightarrow}bool$ to its reflexive-transitive closure ${\sf Rtc}\;R$ can be defined in the {\small HOL} logic by the constant definition: \[\vdash \begin{array}[t]{@{}l} \forall R\:x\:y.\:{\sf Rtc}\;R\;x\;y\;= \\ \quad\forall P.\:(\begin{array}[t]{@{}l} (\forall x\: y.\:R\;x\;y \supset P\;x\;y)\; \wedge \\ (\forall x.\:P\;x\;x)\; \wedge \\ (\forall x\: y.\:(\exists z.\:P\;x\;z \wedge P\;z\;y) \supset P\;x\;y)) \\ \quad\supset\\ P\;x\;y \end{array}\end{array}\] \noindent This definition states that a pair $x$ and $y$ is in the relation ${\sf Rtc}\;R$ exactly when it is in every relation $P$ closed under the rules for reflexive-transitive closure. That is, ${\sf Rtc}\;R$ is \mbox{defined} to be the intersection of all relations closed under these rules. As will be discussed in the section that follows, this indeed makes ${\sf Rtc}\;R$ the least such relation, as required. \subsection{Deriving the rules and rule induction} Any relation intended to be defined inductively by a set of rules can be defined formally in the {\small HOL} logic by a constant definition of the kind illustrated by the {\sf Rtc} example given above. Such a definition, however, merely introduces the relation as the intersection of all relations that satisfy the desired set of rules. The proof obligations of a derived principle of inductive definition are, first of all, to show that the resulting relation in fact does satisfy these rules, and secondly to show that it is indeed the least such relation. It is these proof obligations which are automated by the {\small HOL} inference rule described below in section~\ref{newind}. In the case of the simple reflexive-transitive closure example, the first proof obligation is to show that: \[ \begin{array}[t]{@{}l} \vdash \forall R\:x\:y.\:R\;x\;y \supset {\sf Rtc}\;R\;x\;y \\[2mm] \vdash \forall R\:x.\:{\sf Rtc}\;R\;x\;x \\[2mm] \vdash \forall R\:x\:y.\: (\exists z.\:{\sf Rtc}\;R\;x\;z \wedge {\sf Rtc}\;R\;z\;y) \supset {\sf Rtc}\;R\;x\;y \end{array}\] \noindent That is, one must prove that the rules {{\small\bf R}\bf 1}, {{\small\bf R}\bf 2}, and {{\small\bf R}\bf 3} follow from the somewhat indirect formal definition of the relation ${\sf Rtc}\;R$ given in the previous section. The second proof obligation is to show that ${\sf Rtc}\;R$ is the least relation that satisfies these rules: \[\vdash \begin{array}[t]{@{}l} \forall R\:P.\:\begin{array}[t]{@{}l} (\begin{array}[t]{@{}l} (\forall x\:y.\:R\;x\;y \supset P\;x\;y)\; \wedge \\ (\forall x.\:P\;x\;x)\; \wedge \\ (\forall x\:y.\:(\exists z.\:P\;x\;z \wedge P\;z\;y) \supset P\;x\;y))\end{array}\\ \quad\supset\\ \forall x\:y.\: {\sf Rtc}\;R\;x\;y \supset P\;x\;y \end{array}\end{array}\] \noindent This is the principle of rule induction for ${\sf Rtc}\;R$. These four theorems constitute a complete statement of the defining properties of reflexive-transitive closure. All four can be proved fully automatically in {\small HOL} by the derived inference rule described in the next section. \section{Automation}\label{newind} The main component of the inductive definitions package is an {\small ML} function that takes as an argument a list of rules and automatically proves the defining properties of the \mbox{relation} inductively defined by them. More precisely, this derived {\small HOL} inference rule builds a term that denotes the least relation closed under the rules using the intersection construction described in the previous section. A constant is then introduced (via a constant specification) to name this relation. The result is a set of theorems stating that the newly-defined relation is the least relation closed under the rules supplied by the user. The {\small ML} function that implements this principle of inductive definition is: \medskip \noindent\begin{tabular}{@{\hskip\mathindent}l@{\hskip4.6mm}l@{}} \verb!new_inductive_definition! & \mbox{} \\ \verb! : bool ->! & ({\it infix flag\/})\\ \verb! string ->! & ({\it defn.\ name\/})\\ \verb! (term # term list) ->! & ({\it pattern\/})\\ \verb! (term list # term) list ->! & ({\it rules\/})\\ \verb! (thm list # thm)! & ({\it result\/}) \end{tabular} \medskip \noindent The first argument to this function is a boolean flag which indicates if the constant that is defined is to have infix syntactic status. The second argument is the name under which the resulting definition will be saved on disk. The third argument is a `pattern' that supplies information which is needed because this {\small ML} function can be used to define classes of inductively defined relations, rather than just single instances of these relations. Details of the purpose and format of this pattern will be explained later. The final argument is a list of rules, each of which is represented by a pair of the form: \[ \hbox{\verb!([!}\, \hbox{\it premisses and side conditions\/}\,\hbox{\verb!], !} \hbox{\it conclusion\/}\hbox{\verb!)!} \] \noindent The first component is a list of the premisses and side conditions, which may be arranged in any order. The second component is the conclusion of the rule. Side conditions can be arbitrary boolean terms, provided they do not mention the relation being defined. The premisses and conclusion must be positive assertions of membership in the relation being defined. The precise form that these assertions must take is explained later, but roughly speaking the premisses and conclusion of a rule must be terms of form \verb!"!$R\;\,t_1\;\,\dots\;\,t_n$\verb!"!, where \[ R\; \hbox{\verb!:!}\; \sigma_1 \;\hbox{\verb!->!}\; \dots \;\hbox{\verb!->!}\; \sigma_n \;\hbox{\verb!->!}\; \hbox{\verb!bool!}\] \noindent is a variable representing the $n$-place relation that is to be defined, and each $t_i \hbox{\verb!:!} \sigma_i$ is an arbitrary term not containing $R$. Given an infix flag, a name, a pattern, and a list of rules, the {\small ML} function \verb!new_inductive_definition! automatically proves the existence of the least relation that satisfies these rules. A constant is then introduced to denote this relation using a constant specification, the result of which is saved on disk under the supplied name. The value returned is a pair consisting of a list of theorems which state that the newly-defined relation satisfies the rules, together with a \mbox{theorem} asserting rule induction for the relation. These theorems give a complete statement of the defining properties for the least relation closed under the specified set of rules. \subsection{A simple example} The following example {\small HOL} session shows how the function \verb!new_inductive_definition! can be used to inductively define the set of even natural numbers. \begin{session}\begin{verbatim} #let (rules,ind) = let Even = "Even:num->bool" in new_inductive_definition false `Even` ("^Even n", []) [ [ % ----------------------------- % ], "^Even 0" ; [ "^Even n" % ----------------------------- % ], "^Even (n+2)" ];; \end{verbatim}\end{session} \noindent The first rule in this definition states that \verb!0! is an even natural number, and the second rule states that if \verb!n! is even then \verb!n+2! is also even. (Antiquotation and {\small ML} comments are used to give a readable presentation of these rules.) Since the even natural numbers are \mbox{exactly} those numbers obtainable from zero by adding multiples of two, these rules inductively define `\verb!Even n!' such that it holds \mbox{precisely} when \verb!n! is even. The value supplied for the pattern in this example is the pair \verb!("Even n",[])!. The first component of this pair indicates that the constant to be defined, namely \verb!Even!, is a one-place function with typical argument \verb!n!. In general, the second component of a pattern is a non-empty list only when a {\it class\/} of relations is being defined (see below). In this example, {\verb!Even!} is a single inductively-defined predicate, and the list component of the pattern is therefore empty. When the definition shown in box 1 is evaluated, \verb!new_inductive_definition! automatically proves the existence of the least predicate closed under the given list of rules and then defines the constant \verb!Even! to denote this predicate. The following automatically-proved theorems about \verb!Even! are then returned: \begin{session}\begin{alltt} rules = [\(\vdash\) Even 0; \(\vdash\) \(\forall\,\)n. Even n \(\supset\) Even(n + 2)] : thm list ind = \(\vdash\) \(\forall\,\)P. P 0 \(\wedge\) (\(\forall\,\)n. P n \(\supset\) P(n + 2)) \(\supset\) \(\,\)(\(\forall\,\)n. Even n \(\supset\) P n) \end{alltt}\end{session} \noindent The theorems bound to the {\small ML} identifier \verb!rules! state that the required rules hold of the predicate \verb!Even!. And the rule induction theorem bound to \verb!ind! states that the set of numbers for which \verb!Even! holds is the least set that satisfies these rules. An analogous set of defining theorems can be proved automatically for any particular relation inductively defined by a list of rules. The next section shows how this derived principle of inductive definition in {\small HOL} can also be used to define a parameterized class of relations. \subsection{Defining a class of relations} The constant {\sf Rtc} defined in section~\ref{in-logic} is not itself an inductively-defined relation, but rather a function that maps an arbitrary relation $R$ to an inductively-defined relation ${\sf Rtc}\;R$. The function {\sf Rtc} therefore represents an entire class of inductively-defined relations, one for each possible value of $R$. The information that is required by the derived rule \verb!new_inductive_definition! in order to handle the definition of such functions is supplied by its pattern argument. In the general case, a pattern is a pair of the following form: \[\hbox{\verb!("!}R\;v_1\;\dots\;v_n\hbox{\verb!",!}\; \hbox{\verb!["!}v_i\hbox{\verb!";!}\dots\hbox{\verb!;"!}v_j\hbox{\verb!"])!} \] \noindent The first component of the pattern is an application of the $n$-place curried function that is to be defined (in this case, $R$) to $n$ distinct variables $v_1$, \dots, $v_n$. The second component is a list of those variables that occur at the positions in this application which correspond to the parameters of class of inductively-defined relations, rather than to the actual arguments to these relations. An example of the role of the pattern argument in defining a class of relations is provided by the following definition of reflexive-transitive closure in {\small HOL}. \begin{session}\begin{verbatim} #let (rules,ind) = let Rtc = "Rtc:(*->*->bool)->*->*->bool" in new_inductive_definition false `Rtc` ("^Rtc R x y", ["R:*->*->bool"]) [ [ "R (x:*) (y:*):bool" % ----------------------------- % ], "^Rtc R x y" ; [ %------------------------------ % ], "^Rtc R x x" ; [ "^Rtc R x z"; "^Rtc R z y" %------------------------------ % ], "^Rtc R x y" ];; \end{verbatim}\end{session} \noindent The pattern in this case is the pair: \medskip \noindent\hskip\mathindent\verb!("Rtc R x y", ["R:*->*->bool"])! \medskip \noindent The first component of this pattern specifies that the function \verb!Rtc! is to take three arguments in total---a \mbox{relation} \verb!R!, and two values \verb!x! and \verb!y!. The \mbox{second} part of the pattern (the list containing just \verb!R!) specifies that the relation argument \verb!R! is to be a parameter to the class of inductively-defined relations that will be represented by \verb!Rtc!. The remaining variables \verb!x! and \verb!y! are assumed to indicate the positions of actual arguments to the predicate that represents these relations. The result of evaluating this inductive definition in {\small HOL} is the following collection of theorems: \begin{session}\begin{alltt} rules = [\(\vdash\) \(\forall\,\)R x y. R x y \(\supset\) Rtc R x y; \(\vdash\) \(\forall\,\)R x. Rtc R x x; \(\vdash\) \(\forall\,\)R x y. (\(\exists\,\)z. Rtc R x z \(\wedge\) Rtc R z y) \(\supset\) Rtc R x y] : thm list ind = \(\vdash\) \(\forall\,\)R P. (\(\forall\,\)x y. R x y \(\supset\) P x y) \(\wedge\) (\(\forall\,\)x. P x x) \(\wedge\) (\(\forall\,\)x y. (\(\exists\,\)z. P x z \(\wedge\) P z y) \(\supset\) P x y) \(\supset\) (\(\forall\,\)x y. Rtc R x y \(\supset\) P x y) \end{alltt}\end{session} \noindent Here, the {\small ML} variable \verb!rules! has been bound to a list of theorems which state the three rules that inductively define the reflexive-transitive closure of a relation. The \mbox{theorem} \verb!ind! states the corresponding principle of rule induction for an inductively-defined relation \verb!Rtc R!. \subsection{Stating premisses and conclusions} In addition to the use of the pattern argument, the \verb!Rtc! example also illustrates a restriction on the form in which the premisses and conclusions of rules must be supplied to \verb!new_inductive_definition!. As was mentioned above, premisses and conclusions must be positive assertions of membership of the form \medskip \noindent\hskip\mathindent\verb!"!$R\;\,t_1\;\,\dots\;\,t_n$\verb!"! \medskip \noindent where $R$ is a variable that stands for the function to be defined. The restriction is that some of the terms among the arguments $t_1$, \dots, $t_n$ in such an \mbox{assertion} must be variables---namely, the terms that occur at \mbox{positions} which, according to the supplied pattern, \mbox{correspond} to the parameters of a class of relations. In particular, the terms that occur at these positions must be the same variables given in the pattern itself. The rules for reflexive-transitive closure shown in box 3 conform to this restriction. Here, the pattern indicates that in the typical assertion of membership \verb!"Rtc R x y"! (i.e.\ the first component of the pattern), the variable \verb!R! marks the position of a parameter to the class of relations to be defined. Every premiss and conclusion mentioned in the rules must therefore be a term of the form $\hbox{\verb!"Rtc R!}\;\,t_1\;\,t_2\hbox{\verb!"!}$, where the arguments $t_1$ and $t_2$ may be arbitrary terms but the parameter \verb!R! must be the variable given in the pattern. \section{A tactic for rule induction} The inductive definitions package in {\small HOL} includes a number of auxiliary functions that support reasoning about inductively-defined relations, in addition to the derived rule of definition itself. The most important of these is the following general tactic for goal-directed proofs by rule induction: \medskip \noindent\begin{tabular}{@{\hskip\mathindent}l@{\hskip12.7mm}l@{}} \verb!RULE_INDUCT_THEN! & \mbox{} \\ \verb! : thm ->! & ({\it induction thm\/})\\ \verb! (thm -> tactic) ->! & ({\it premiss cont.\/})\\ \verb! (thm -> tactic) ->! & ({\it side cond.\ cont.\/})\\ \verb! tactic! & ({\it result\/}) \end{tabular} \medskip \noindent The first argument to this function is the rule \mbox{induction} theorem returned by \verb!new_inductive_definition! for a given inductively-defined relation. Like the general structural induction tactic in {\small HOL}, the rule induction tactic is parameterized by functions that determine what is done with induction hypotheses. These may be either premisses or side conditions, and the user may wish to treat these two kinds of induction hypotheses differently. Two separate theorem continuations are therefore supplied as the second and third arguments to the function \verb!RULE_INDUCT_THEN!. Given the rule induction theorem for an inductively-defined $n$-ary relation $R$, the function described above returns a specialized rule induction tactic that reduces goals of the form: \[ \hbox{\verb!"!}\forall x_1\;\dots\;x_n\hbox{\verb!.!}\; R \;x_1\;\dots\;x_n \supset P[x_1,\dots,x_n]\hbox{\verb!"!} \] \noindent to the subgoal(s) of proving that the property $P$ is preserved by the rules that inductively define $R$. The rule induction theorem for \verb!Rtc!, for example, is: \begin{session}\begin{alltt} #ind;; \(\vdash\) \(\forall\,\)R P. (\(\forall\,\)x y. R x y \(\supset\) P x y) \(\wedge\) (\(\forall\,\)x. P x x) \(\wedge\) (\(\forall\,\)x y. (\(\exists\,\)z. P x z \(\wedge\) P z y) \(\supset\) P x y) \(\supset\) (\(\forall\,\)x y. Rtc R x y \(\supset\) P x y) \end{alltt}\end{session} \noindent A rule induction tactic for \verb!Rtc! can be constructed from this theorem by making the simple {\small ML} definition: \begin{session}\begin{alltt} #let Rtc_INDUCT_TAC = RULE_INDUCT_THEN ind ASSUME_TAC ASSUME_TAC;; Rtc_INDUCT_TAC = - : tactic \end{alltt}\end{session} \noindent The use of \verb!ASSUME_TAC! in this definition means that the induction hypotheses arising from the premisses and side conditions of the rules are to be added to the assumptions of the subgoals that are generated. The resulting rule induction tactic for \verb!Rtc! is described by: \bigskip \noindent\begin{tabular}{@{\hskip\mathindent}c@{}} $\Gamma\;\:$\verb!?-!$\;\:\forall x\:y$\verb!. Rtc!$\;R\;x\;y \supset P[x,y]$\\ \trule{62mm}\\ $\Gamma \cup \{R\;x\;y\}\;\:$\verb!?-!$\;\:P[x,y]$\\[1mm] $\Gamma\;\:$\verb!?-!$\;\:\forall x$\verb!.!$\;P[x,x]$\\[1mm] $\Gamma\;{\cup}\;\{P[x,z],\:P[z,y]\}\;\:$\verb!?-!$\;\:P[x,y]$ \end{tabular} \bigskip \noindent This tactic implements the induction scheme described above in section~\ref{rule-ind}. It reduces the goal of proving that a property $P[x,y]$ holds for all pairs $x$ and $y$ related by $\hbox{\verb!Rtc!}\;R$ to showing that this property is preserved by the rules that inductively define this relation. \subsection{An example} The following session shows how the rule induction tactic for \verb!Rtc! constructed in the previous section can be used to prove a simple theorem about this relation. The aim is to show that the reflexive-transitive closure of a symmetric relation is also symmetric. The proof begins by using the {\small HOL} subgoal package (see~\cite{description}) to set up an appropriate goal to be proved: \smallskip \begin{session}\begin{alltt} #set_goal (["\(\forall\,\)x:*. \(\forall\,\)y. R x y \(\supset\) R y x"], "\(\forall\,\)x:*. \(\forall\,\)y. Rtc R x y \(\supset\) Rtc R y x");; "\(\forall\,\)x y. Rtc R x y \(\supset\) Rtc R y x" [ "\(\forall\,\)x y. R x y \(\supset\) R y x" ] () : void \end{alltt}\end{session} \smallskip \noindent The assumption of the goal is that the relation \verb!R! is symmetric, and the conclusion states that the closure \verb!Rtc R! is also symmetric. The conclusion of the goal is in precisely the right form for a proof by rule induction using the induction tactic described above. Applying this tactic results in: \smallskip \begin{session}\begin{alltt} #expand Rtc_INDUCT_TAC;; OK.. 3 subgoals "Rtc R y x" {\rm({\it{subgoal 1\/}})} [ "\(\forall\,\)x y. R x y \(\supset\) R y x" ] [ "Rtc R z x" ] [ "Rtc R y z" ] "\(\forall\,\)x. Rtc R x x" \(\!\){\rm({\it{subgoal 2\/}})} [ "\(\forall\,\)x y. R x y \(\supset\) R y x" ] "Rtc R y x" {\rm({\it{subgoal 3\/}})} [ "\(\forall\,\)x y. R x y \(\supset\) R y x" ] [ "R x y" ] () : void \end{alltt}\end{session} \smallskip \noindent Subgoals 1 and 2 are trivial, since the relation \verb!Rtc R! is transitive and reflexive by definition. The tactic proofs for these subgoals can simply use the rules shown above in box~4. The proof of subgoal 3 is also easy. The proposition \verb!"R y x"! follows immediately from the two assumptions of the subgoal; and this proposition \mbox{together} with the fact that \bigskip \noindent\hskip\mathindent$\vdash\forall\,$\verb!R x y. R x y !$\supset $\verb! Rtc R x y! \bigskip \noindent directly entail the required conclusion. The proof sketched above is a trivial example of the kind of reasoning sometimes referred to as induction over the structure (or the depth) of derivations in a deductive system stated by a set of rules. This form of inductive \mbox{argument}, which is very common in certain \mbox{areas} of theory (for example, operational semantics and process algebras), is made directly accessible in {\small HOL} by the tactic described in this section. \section{Tactics and inference rules} In addition to the rule induction tactic described above, the inductive definitions package also provides mechanized support for generating tactics from the theorems that state the rules for an inductively-defined relation. This takes the form of an {\small ML} function: \medskip \noindent\hskip\mathindent\verb!RULE_TAC : thm -> tactic! \medskip \noindent The theorem argument to this function is expected to be a rule expressed in the form proved by the derived principle of inductive definition described in section~\ref{newind}. Given such a theorem, \verb!RULE_TAC! constructs a tactic that inverts the rule stated by it. The resulting tactic reduces goals that match the conclusion of the rule to subgoals consisting of the corresponding instances of its premisses and side conditions. Consider, for example, the theorem which states the transitivity rule for \verb!Rtc!: \[\vdash \forall\,\hbox{\verb!R x y. !}\begin{array}[t]{@{}l}% \hbox{\verb!(!}\exists\, \hbox{\verb!z. Rtc R x z !}\wedge\hbox{\verb! Rtc R z y)!}\\ \quad \supset \\ \hbox{\verb!Rtc R x y!} \end{array} \] \noindent When applied to this theorem, the function \verb!RULE_TAC! returns the tactic described by: \bigskip \noindent\begin{tabular}{@{\hskip\mathindent}c@{}} $\Gamma\;\:$\verb!?-!$\;\:$\verb!Rtc!$\;R\;x\;y$ \\ \trule{62mm}\\ $\Gamma\;\:$\verb!?-!$\;\:\exists z $\verb!.!$\;$\verb!Rtc!$\;R\;x\;z\;\:\wedge\;\;$\verb!Rtc!$\;R\;z\;y$ \end{tabular} \bigskip \noindent This tactic can then be used in goal-directed proofs about membership in the inductively-defined relation {\verb!Rtc!$\;R$}. The other two rules that define \verb!Rtc!$\;R$ can also be converted into tactics using the function \verb!RULE_TAC!. The result is a complete set of {\small HOL} tactics for goal-directed proofs in the deductive system comprising the three rules that define reflexive-transitive closure. It is intended that the inductive definitions package will also include a function that maps rules stated as theorems to forward inference rules in {\small HOL} (i.e.\ to {\small ML} functions). For example, the transitivity theorem shown above can be used to implement the following derived inference rule: \bigskip \noindent\begin{tabular}{@{\hskip\mathindent}c@{}} $\Gamma_1\;{\vdash}\;$\verb!Rtc!$\;R\;x\;z$\qquad $\Gamma_2\;{\vdash}\;$\verb!Rtc!$\;R\;z\;y$\\ \rrule{62mm}\\ $\Gamma_1 \cup \Gamma_2\;{\vdash}\;$\verb!Rtc!$\;R\;x\;y$ \end{tabular} \bigskip \noindent Any rule expressed as a theorem of the form proved by the derived principle of inductive definitions can likewise be converted into a forward inference rule. A function that \mbox{automatically} constructs such rules has not yet been implemented, partly because it has not been found necessary for the applications done so far (see section~\ref{appl}). For completeness, however, the author intends in future to add this function to the inductive definitions package. \section{Case analysis} The final major component of the {\small HOL} package for inductive definitions is an {\small ML} function that proves an \mbox{exhaustive} case analysis theorem for any given relation inductively defined by a set of rules. The name and type of this function are: \medskip \noindent\hskip\mathindent\verb!derive_cases_thm : (thm list # thm) -> thm! \medskip \noindent The arguments to this function are the list of rules satisfied by an inductively defined relation, together with its rule induction theorem. (These are precisely the defining theorems which are proved and returned by \verb!new_inductive_definition!.) When supplied with these theorems, \verb!derive_cases_thm! proves that if an assertion of membership in the relation holds, then it holds only by virtue of the fact that one of the rules can be used to derive it. This allows one to drive the rules that define a relation `backwards', inferring from the conclusion of one of the rules that the premisses and side conditions hold. The following interaction with the {\small HOL} system shows the theorem proved by \verb!derive_cases_thm! for the \verb!Rtc! example introduced above. The {\small ML} variables \verb!rules! and \verb!ind! are assumed to have the bindings shown above in box~4. \smallskip \begin{session}\begin{alltt} #derive_cases_thm (rules,ind);; \(\vdash\) \(\forall\,\)R x y. Rtc R x y \(\supset\) R x y \(\vee\) (y = x) \(\vee\) (\(\exists\,\)z. Rtc R x z \(\wedge\) Rtc R z y) \end{alltt}\end{session} \smallskip \noindent Roughly speaking, the resulting theorem states that if \verb!Rtc R x y! holds, then either: \begin{itemize} \item it is derivable by the inclusion rule {{\small\bf R}\bf 1}, in which case \verb!x! and \verb!y! are related by \verb!R!; or \item it is derivable by the reflexivity rule {{\small\bf R}\bf 2}, in which case \verb!x! and \verb!y! are equal; or \item it is derivable by the transitivity rule {{\small\bf R}\bf 3}, in which case there must be an intermediate value \verb!z! such that \verb!Rtc R x z! and \verb!Rtc R z y!. \end{itemize} \noindent A similar theorem can be proved automatically for any relation defined inductively using the package. Work is currently underway to strengthen this theorem from an implication to an equation, so that it can be used for rewriting. \section{Applications}\label{appl} In a joint project with Juanito Camilleri, a set of example proofs has been developed to illustrate the potential for applications of the inductive \mbox{definitions} package. These examples include: the definition of an operational semantics for a simple programming language and a proof that its evaluation relation is \mbox{deterministic}; the definition of a reduction relation for combinatory logic and a proof that it has the Church-Rosser property; a definition of \mbox{provability} in a Hilbert style proof system for minimal intuitionistic logic; the definition of a type system for combinatory logic and a proof of the Curry-Howard isomorphism for typed combinatory logic and minimal intuitionistic logic; and definitions of the trace and transition semantics for a simple process algebra, \mbox{together} with the proof of a formal statement of the relationship between them. A report on this work is in preparation, and the {\small HOL} source code for the examples will be made available to interested users. \newpage \begin{thebibliography}{9} \bibitem{description} DSTO, The University of Cambridge, and SRI \mbox{International}, {\it The HOL System: DESCRIPTION} (1991). \bibitem{melham} T.\ F.\ Melham, `Automating Recursive Type Definitions in Higher Order Logic', in: {\it Current Trends in Hardware Verification and Automated Theorem Proving\/}, edited by G.\ Birtwistle and P.A.\ Subrahmanyam (Springer-Verlag, 1989), pp.\ 341--386. \bibitem{pitts} A.\ M.\ Pitts, `Semantics of Programming Languages', unpublished lecture notes, University of Cambridge Computer Laboratory (October 1989). \bibitem{winskel} G.\ Winskel, `Introduction to the Formal Semantics of Programming Languages', unpublished lecture notes, University of Cambridge Computer Laboratory (October 1985). \end{thebibliography} \end{document} hol88-2.02.19940316/Library/ind_defs/Paper/layout.sty0000640000212700021270000001316605151750527020246 0ustar cammcamm% ===================================================================== % LaTeX style file for HUG91 paper (ieee format) % ===================================================================== % --------------------------------------------------------------------- % PAPER SIZE (latex overrides these anyway) % % * TeX expects 1 inch margins all around. % * 8.5x11 (american paper) is exactly 279.4mm high by 215.9mm wide % * 1 inch = 25.4 mm % --------------------------------------------------------------------- \hsize=165.1truemm \vsize=228.6truemm % --------------------------------------------------------------------- % PAGE LAYOUT % --------------------------------------------------------------------- \textwidth 174truemm \textheight 228truemm % --------------------------------------------------------------------- % POSITION ON PAPER % % * left margin = 19 mm % * top margin = 25.4 mm (one inch) % --------------------------------------------------------------------- \evensidemargin=-7.4truemm \oddsidemargin=-7.4truemm \topmargin 0truemm % --------------------------------------------------------------------- % Column separation % --------------------------------------------------------------------- \columnsep 8mm % --------------------------------------------------------------------- % MATH INDENTATION. = 5mm % --------------------------------------------------------------------- \setlength{\mathindent}{1pc} % --------------------------------------------------------------------- % HEAD: no head % --------------------------------------------------------------------- \headheight 0mm \headsep 0mm % --------------------------------------------------------------------- % FOOT: page number % --------------------------------------------------------------------- \footheight 12pt \footskip 10mm % --------------------------------------------------------------------- % INDENTATION: 1pc indentation % --------------------------------------------------------------------- \parindent 1pc % --------------------------------------------------------------------- % Sizes of sections, etc. % --------------------------------------------------------------------- \makeatletter %need an 11 pt font size for subsection and abstract headings \def\subsize{\@setsize\subsize{12pt}\xipt\@xipt} %make section titles bold and 12 point, 1 blank lines before, 1 after \def\section{\@startsection{section}{1}{\z@}{12pt plus 2pt minus 2pt} {12pt plus 2pt minus 2pt}{\large\bf}} %make subsection titles bold and 11 point, 1 blank line before, 1 after \def\subsection{\@startsection{subsection}{2}{\z@}{12pt plus 2pt minus 2pt} {12pt plus 2pt minus 2pt}{\subsize\bf}} %make subsubsection titles bold and 10 point, 1 blank line before, run-in %and with a `:' after the title. \def\@mystartsection#1#2#3#4#5#6{\if@noskipsec \leavevmode \fi \par \@tempskipa #4\relax \@afterindenttrue \ifdim \@tempskipa <\z@ \@tempskipa -\@tempskipa \@afterindentfalse\fi \if@nobreak \everypar{}\else \addpenalty{\@secpenalty}\addvspace{\@tempskipa}\fi \@ifstar {\@ssect{#3}{#4}{#5}{#6}}{\@dblarg{\@mysect{#1}{#2}{#3}{#4}{#5}{#6}}}} \def\@mysect#1#2#3#4#5#6[#7]#8{\ifnum #2>\c@secnumdepth \def\@svsec{}\else \refstepcounter{#1}\edef\@svsec{\csname the#1\endcsname\hskip 1em }\fi \@tempskipa #5\relax \ifdim \@tempskipa>\z@ \begingroup #6\relax \@hangfrom{\hskip #3\relax\@svsec}{\interlinepenalty \@M #8:\par}% \endgroup \csname #1mark\endcsname{#7}\addcontentsline {toc}{#1}{\ifnum #2>\c@secnumdepth \else \protect\numberline{\csname the#1\endcsname}\fi #7}\else \def\@svsechd{#6\hskip #3\@svsec #8:\csname #1mark\endcsname {#7}\addcontentsline {toc}{#1}{\ifnum #2>\c@secnumdepth \else \protect\numberline{\csname the#1\endcsname}\fi #7}}\fi \@xsect{#5}} \def\subsubsection{\@mystartsection{subsubsection}{3}{\z@} {12pt plus 2pt minus 2pt}{-1em}{\bf}} % --------------------------------------------------------------------- % footnote hacks % --------------------------------------------------------------------- % No rule above footnotes like in the IEEE transations \renewcommand{\footnoterule}{} % thanks makes no footnote make like in the IEEE transactions \newcommand{\blanknote}[1] { \renewcommand{\thefootnote}{} \footnotetext{#1} \renewcommand{\thefootnote}{\arabic{footnote}} } \def\thanks#1{\begingroup \def\protect{\noexpand\protect\noexpand}\xdef\@thanks{\@thanks \protect\blanknote{#1}}\endgroup} % Set footnote text style to that in guidelines \def\footnotesize{\@setsize\footnotesize{10pt}\viiipt\@viiipt \abovedisplayskip 6pt plus 2pt minus 4pt\belowdisplayskip \abovedisplayskip \abovedisplayshortskip \z@ plus 1pt\belowdisplayshortskip 3pt plus 1pt minus 2pt \def\@listi{\leftmargin\leftmargini \topsep 3pt plus 1pt minus 1pt\parsep 2pt plus 1pt minus 1pt \itemsep \parsep}} \makeatother % --------------------------------------------------------------------- % Preliminary settings etc. % --------------------------------------------------------------------- \renewcommand{\topfraction}{0.8} % 0.8 of the top page can be fig. \renewcommand{\bottomfraction}{0.8} % 0.8 of the bottom page can be fig. \renewcommand{\textfraction}{0.1} % 0.1 of the page must contain text \setcounter{totalnumber}{4} % max of 4 figures per page \setcounter{secnumdepth}{3} % number sections down to level 3 \setcounter{tocdepth}{3} % toc contains numbers to level 3 \flushbottom % text extends right to the bottom \twocolumn % two columns hol88-2.02.19940316/Library/ind_defs/ind-defs.ml0000640000212700021270000017610405424753151017145 0ustar cammcamm% ===================================================================== % % FILE : ind-defs.ml % % DESCRIPTION : inductive definitions package. % % % % AUTHOR : (c) T. F. Melham 1990 % % DATE : 90.11.13 % % REVISED : 91.10.19 % % ===================================================================== % % ===================================================================== % % INDUCTIVE DEFINITIONS. % % ===================================================================== % begin_section prove_inductive_relation_exists;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION: mk_predv % % % % The function mk_predv, given a list of terms: % % % % ["t1:ty1"; "t2:ty2"; ...; "tn:tyn"] % % % % returns a variable P of type: % % % % P : ty1 -> ty2 -> ... -> tyn -> bool % % % % The choice of name `P` is fixed; but the variable may be primed later % % if it is found to conflict with some other variable name present in % % the rules supplied by the user. % % --------------------------------------------------------------------- % let mk_predv = let itfn tm ty = mk_type(`fun`,[type_of tm;ty]) in \ts. mk_var(`P`,itlist itfn ts ":bool");; % --------------------------------------------------------------------- % % INTERNAL FUNCTION: checkfilter % % % % The function checkfilter takes two lists "ps" and "as", where ps is a % % sublist of as, and returns a function from lists to list. Suppose % % that: % % % % ps = [u1;...;un] and as = [v1;...;vm] % % % % where {u1,...,un} is a subset of {v1,...,vm}. Then checkfilter ps as % % is a function that takes a list % % % % l = [w1,...,wm] % % % % and fails unless l has the same length as the list as and wi=vi for % % all i such that vi is an element of ps. If checkfilter ps as l % % succeeds, then it returns the sublist of l consisting of those % % elements wi for which the corresponding element vi is not in ps. % % --------------------------------------------------------------------- % let checkfilter = letrec check ps as = if (null as) then assert null else let cktl = check ps (tl as) in if (mem (hd as) ps) then let v = hd as in \(h.t). (h=v) => cktl t | fail else \(h.t). h . cktl t in \ps as. let f = check ps as in \l. f l ? failwith `ill-formed membership assertion`;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION: checkside % % % % This function is used to check that the relation R being defined does % % not occur in a side condition of a rule. It fails with an appropriate % % error message if R occurs free in tm and otherwise returns tm. % % --------------------------------------------------------------------- % let checkside R tm = if (free_in R tm) then (let name = fst(dest_var R) in failwith `"` ^ name ^ `" free in side-condition(s)`) else tm;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : mk_mk_pred % % % % The arguments to this function are the user-supplied pattern pat, and % % the list of global parameters ps (see below for a specification of % % required format of these inputs). The pattern, pat, is expected to % % have the form shown below: % % % % pat = "R x1 ... xn" % % % % and mk_mk_pred fails (with an appropriate message) if: % % % % 1: pat is not a boolean term % % 2: any one of R, x1, ... xn is not a variable % % 3: the xi's are not all distinct % % % % The second argument, ps, is a list of global parameter variables: % % % % ["y1",...,"ym"] % % % % where {"y1",...,"ym"} is expected to be a subset of {"x1",...,"xm"}. % % Failure occurs if: % % % % 1: any one of "y1",...,"ym" is not a variable % % 2: any "yi" is not an element of {"x1",...,"xm"}. % % 3: the "yi"'s are not all distinct % % % % A successful call to mk_mk_pred pat ps, where the inputs pat and ps % % are as described above, returns a function that maps applications of % % the form: % % % % "R a1 ... an" % % % % to applications of the form: % % % % "P ai ... aj" % % % % where ai,...,aj is the subsequence of a1,...,an consisting of those % % arguments to R whose positions correspond to the positions of the % % variables in the pattern "R x1 ... xn" that do NOT occur in the % % global paramter list ps. Furthermore, at all other positions (ie at % % those positions that correspond to global parameters) the a's must % % be identical to the parameter variables y1,...,ym. % % % % For example, if: % % % % pat = "R x1 x2 x3 x4" and ps = ["x1";"x3"] % % % % then the function returned by mk_mk_pred expects input terms of the % % form "R x1 a1 x3 a2" and maps these to "P a1 a2". Failure occurs if % % the agument to this function does not have the correct form. % % % % For convenience, the function mk_mk_pred also returns the variables % % R and P. % % --------------------------------------------------------------------- % let mk_mk_pred = let chk p = \st. \x. (p x => x | failwith st) in let ckb = chk (\t. type_of t = ":bool") `pattern not boolean` in let ckv = chk is_var `non-variable in pattern` in let ckp = chk is_var `non-variable parameter` in let itfn ck st = \v l. (mem (ck v) l => failwith st | v.l) in let cka = C (itlist (itfn ckv `duplicate argument in pattern`)) [] in let ckpa = C (itlist (itfn ckp `duplicate variable in parameters`)) [] in \(pat,ps,vs). let R,args = (ckv # cka) (strip_comb(ckb pat)) in if (exists ($not o C mem args) (ckpa ps)) then failwith `spurious parameter variable` else let P = variant vs (mk_predv (subtract args ps)) in let checkhyp = checkfilter ps args in R,P,\tm. let f,as = strip_comb tm in if (f = R) then list_mk_comb (P, checkhyp as) else checkside R tm;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : make_rule % % % % The function make_rule takes a user-supplied rule specification: % % % % (as, c) % % % % where as are the assumptions and side conditions and c is the % % conclusion, and generates the logical representation of the assertion % % that the relation P (supplied as one of the arguments) closed under % % the rule. The variable ps is the global paramter list, and the % % function mkp is the mapping from membership assertions: % % % % R a1 ... an % % % % which occur in the assumptions as and the conclusion c, to membership % % assertions of the form: % % % % P ai ... aj % % % % where the global parameters in ps that occur among the arguments % % a1,...,an are eliminated. In what follows, we let mkp(c) stand for % % the result of this operation. % % % % For an axiom of the form ([],c), the term returned is % % % % "!xs.mkp(c)" % % % % where xs are the variables that occur free in mkp(c). For a rule with % % side conditions ss and premisses p1,...,pi, the result is: % % % % "!xs. (?zs. mkp(p1) /\ ... /\ mkp(pi) /\ ss) ==> !ys. mkp(c) % % % % where ys are the variables that appear free only in mkp(c), xz are % % the variables that appear free only in mkp(p1),...,mkp(pi),ss, and xs % % are the remaining free variables of the rule. % % --------------------------------------------------------------------- % let make_rule (P,R,ps,mkp) (as,c) = if (not(fst(strip_comb c)) = R) then failwith `ill-formed rule conclusion` else let getvs tm = subtract (frees tm) (P.R.ps) in let con = mkp c in if (null as) then list_mk_forall(getvs con,con) else let asm = list_mk_conj (map mkp as) in let pvs = getvs asm and cvs = getvs con in let qcon = list_mk_forall(subtract cvs pvs, con) in let qasm = list_mk_exists(subtract pvs cvs, asm) in let avs = intersect pvs cvs in list_mk_forall(avs,mk_imp(qasm,qcon));; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : make_definition % % % % The function make_definition creates an appropriate non-recursive % % defining equation for the user-specified inducively-defined predicate % % described by the pattern pat, the parameter list ps and the rule list % % rules. (See below for a description of the required format of these % % input values). Error checking of the user input is also done here. % % % % The rules have the form (as,c), where as are a list of premisses and % % side conditions and c is the conclusion. Each rule is transformed % % into the logical assertion that the relation P is closed under the % % rule (see make_rule above). Let RULES[P] be the conjunction of these % % assertions. Then the smallest relation closed under the rules has % % the defining equation: % % % % !ps xs. REL ps xs = !P. RULES(ps)[P] ==> P xs % % % % Note that the rules may depend on the global parameters ps. % % --------------------------------------------------------------------- % let make_definition (pat,ps) rules = let vs = freesl (flat (map (\(x,y). y.x) rules)) in let R,P,mkp = mk_mk_pred (pat,ps,vs) in let frules = map ((flat o map conjuncts) # I) rules in let crules = list_mk_conj(map (make_rule (P,R,ps,mkp)) frules) in let right = mk_forall(P,mk_imp (crules,mkp pat)) in let eqn = mk_eq(pat,right) in let args = subtract (snd(strip_comb pat)) ps in list_mk_forall(ps @ args, eqn);; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : derive_induction % % % % This derives rule induction from the definition of an inductively % % defined relation REL. % % % % The input, def, has the form: % % % % !ps xs. REL ps xs = !P. RULES(ps)[P] ==> P xs % % % % where RULES(ps)[P] states that P is closed under the set of rules % % RULES(ps) and ps are the global parameters to the rules. % % % % The output is the rule induction theorem: % % % % def |- !ps. !P. RULES(ps)[P] ==> !xs. P xs ==> REL ps xs % % % % --------------------------------------------------------------------- % let derive_induction def = let vs,(left,right) = (I # dest_eq) (strip_forall def) in let P,(as,con) = (I # dest_imp) (dest_forall right) in let rvs = snd(strip_comb con) in let th1 = UNDISCH (fst(EQ_IMP_RULE (SPECL vs (ASSUME def)))) in let th2 = GENL rvs (DISCH left (UNDISCH (SPEC P th1))) in GENL (subtract vs rvs) (GEN P (DISCH as th2));; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : usedef % % % % This returns functions that use the non-recursive definition of an % % inductively defined relation REL to abbreviate an application of REL. % % % % The input has the form: % % % % rvs = ps...xs % % dth = |- REL ps xs = !P. RULES(ps)[P] ==> P xs % % % % where RULES(ps)[P] states that P is closed under the set of rules % % RULES(ps) and ps are the global parameters to the rules. % % % % The result is a pair consisting of an inference rule (type thm->thm) % % and a conversion (term->thm). The conversion maps terms of the form % % "P vs" to the theorem: % % % % RULES(ps)[P] |- REL ps vs ==> P vs % % % % The inference rule maps a theorem of the form: % % % % |- !P. RULES(ps)[P] ==> P vs % % % % to the theorem: % % % % def |- REL ps vs % % --------------------------------------------------------------------- % let usedef (rvs,dth) = let left,right = EQ_IMP_RULE dth in let ante,v = (I # (fst o dest_forall)) (dest_imp (concl left)) in let lth = GENL rvs (DISCH ante (UNDISCH (SPEC v (UNDISCH left)))) in let as tm = SPECL (snd(strip_comb tm)) lth in let rth = GENL rvs right in let ab th = let ts = snd(strip_comb(rand(snd(dest_forall(concl th))))) in MP (SPECL ts rth) th in (ab,as);; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : eximp % % % % forward proof rule for existentially quantifying variables in both % % the antecedent and consequent of an implication. % % % % A call to: % % % % eximp ["v1",...,"vn"] A |- P ==> Q % % % % returns a pair (tm,th) where: % % % % tm = "?v1...vn. P" and th = A,tm |- ?v1...vn. Q % % % % --------------------------------------------------------------------- % let eximp = let exfn v th = EXISTS(mk_exists(v,concl th),v)th in let chfn v (a,th) = let tm = mk_exists(v,a) in (tm,CHOOSE (v,ASSUME tm) th) in \vs th. let A,C = dest_imp(concl th) in itlist chfn vs (A,itlist exfn vs (UNDISCH th));; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : derive_rule % % % % This proves that a rule holds of the inductively-defined relation REL % % defined by the rules. Axioms have the form: % % % % "!ps. REL ps " % % % % and rules proper have the form % % % % "!xs. (?zs. REL ps /\ ... /\ REL ps /\ ss) ==> % % !ys. REL ps % % % % The supplied functions ab and as embody the definition: % % % % !ps xs. REL ps xs = !P. RULES(ps)[P] ==> P xs % % --------------------------------------------------------------------- % let derive_rule = let check v = assert ($not o (free_in v)) # assert (free_in v) in \rel (ab,as). let mfn tm = (free_in rel tm => as tm | DISCH tm (ASSUME tm)) in \th. let ([R],xs,body) = (I # strip_forall) (dest_thm th) in let thm1 = SPECL xs th in (let ante,cvs,con = (I # strip_forall) (dest_imp body) in let evs,asms = (I # conjuncts) (strip_exists ante) in let ths = map mfn asms in let A1,th1 = eximp evs (end_itlist IMP_CONJ ths) in let th3 = ab (GEN rel (DISCH R (SPECL cvs (MP thm1 th1)))) in GENL xs (DISCH A1 (GENL cvs th3))) ? GENL xs (ab (GEN rel (DISCH R thm1)));; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : derive_rules. % % % % This just constructs the arguments for derive_rule and then derives % % a list of all the rules. % % --------------------------------------------------------------------- % let derive_rules def = let vs,(left,right) = (I # dest_eq) (strip_forall def) in let rel,(a,c) = (I # dest_imp) (dest_forall right) in let rvs = subtract vs (snd(strip_comb c)) in let ab,as = usedef (snd(strip_comb c),SPECL vs (ASSUME def)) in let ths = CONJUNCTS (ASSUME a) in let rules = map (GENL rvs o derive_rule rel (ab,as)) ths in LIST_CONJ rules;; % --------------------------------------------------------------------- % % prove_inductive_relation_exists % % % % This is the main function for inductively-defined relations in HOL. % % The first argument is expected to be a pattern: % % % % ("REL x1 ... xn", ["p1",...,"pn"]) % % % % where the set of variables {p1,...,pn} is a subset of {x1,...,xn} and % % REL is a variable standing for the relation to be defined. The second % % argument is a list of rules of the form: % % % % ([], ) % % % % Side conditions may be abitrary boolean terms, provided they do not % % mention the variable REL. The premisses and conclusion of a rule must % % be assertions of the form: % % % % REL t1 ... tn % % % % where each ti for which the corresponding xi in the pattern appears % % as an element pi in the list of global parameters is just the % % parameter variable pi itself. The terms ti at other positions may be % % arbitrary terms. % % % % The result is a theorem stating the existence of the least relation % % REL closed under the rules. This consists of a conjunction which % % states (1) that REL is closed under the rules, and (2) that any other % % relation P which is closed under the rules contains REL. % % --------------------------------------------------------------------- % let prove_inductive_relation_exists (pat,ps) rules = let def = make_definition (pat,ps) rules in let vs,(left,right) = (I # dest_eq) (strip_forall def) in let R,args = strip_comb left in let thm1 = CONJ (derive_rules def) (derive_induction def) in let eth = EXISTS(mk_exists(R,concl thm1),R) thm1 in let lam = list_mk_abs(vs,right) in let bth = GENL vs (LIST_BETA_CONV (list_mk_comb(lam,vs))) in let deth = EXISTS (mk_exists(R,def),lam) bth in CHOOSE (R, deth) eth;; % --------------------------------------------------------------------- % % Bind this value to "it". % % --------------------------------------------------------------------- % prove_inductive_relation_exists;; % --------------------------------------------------------------------- % % end the section. % % --------------------------------------------------------------------- % end_section prove_inductive_relation_exists;; % --------------------------------------------------------------------- % % save the function. % % --------------------------------------------------------------------- % let prove_inductive_relation_exists = it;; % --------------------------------------------------------------------- % % new_inductive_definition % % % % Make a new inductive definition by first proving the existence of the % % least relation closed under the supplied rules and then introducing % % a constant to denote this relation. % % --------------------------------------------------------------------- % let new_inductive_definition infix st (pat,ps) rules = let eth = prove_inductive_relation_exists (pat,ps) rules in let name = fst(dest_var(fst(dest_exists(concl eth)))) in let fl = (infix => `infix` | `constant`) in let rules,ind = CONJ_PAIR (new_specification st [fl,name] eth) in CONJUNCTS rules, ind;; % ===================================================================== % % STRONGER FORM OF INDUCTION. % % ===================================================================== % begin_section strong_induction;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : simp_axiom % % % % This function takes an axiom of the form % % % % |- !xs. REL ps % % % % and a term of the form % % % % !xs. (\vs. REL ps vs /\ P vs) % % % % and proves that % % % % |- (!xs. P ) ==> !xs. (\vs. REL ps vs /\ P vs) % % % % That is, simp_axiom essentially beta-reduces the input term, and % % drops the redundant conjunct "REL ps xs", this holding merely by % % virtue of the axiom being true. % % --------------------------------------------------------------------- % let simp_axiom (ax,tm) = let vs,red = strip_forall tm in let bth = LIST_BETA_CONV red in let asm = list_mk_forall(vs,rand(rand(concl bth))) in let th1 = SPECL vs (ASSUME asm) in let th2 = EQ_MP (SYM bth) (CONJ (SPECL vs ax) th1) in DISCH asm (GENL vs th2);; % --------------------------------------------------------------------- % % INTERNAL FUNCION : reduce_asm % % % % The term asm is expected to be the antecedent of a rule in the form: % % % % "?zs. ... /\ (\vs. REL ps vs /\ P vs) /\ ..." % % % % in which applications of the supplied parameter fn: % % % % "(\vs. REL ps vs /\ P vs)" % % % % appear as conjuncts (possibly among some side conditions). The % % function reduce_asm beta-reduces these conjuncts and flattens the % % resulting conjunction of terms. The result is the theorem: % % % % |- asm ==> ?zs. ... /\ REL ps /\ P /\ ... % % % % --------------------------------------------------------------------- % let reduce_asm = letrec reduce fn tm = (let c1,imp = (I # reduce fn) (dest_conj tm) in if (fst(strip_comb c1) = fn) then let t1,t2 = CONJ_PAIR(EQ_MP (LIST_BETA_CONV c1) (ASSUME c1)) in let thm1 = CONJ t1 (CONJ t2 (UNDISCH imp)) in let asm = mk_conj(c1,rand(rator(concl imp))) in let h1,h2 = CONJ_PAIR(ASSUME asm) in DISCH asm (PROVE_HYP h1 (PROVE_HYP h2 thm1)) else IMP_CONJ (DISCH c1 (ASSUME c1)) imp) ? if (fst(strip_comb tm) = fn) then fst(EQ_IMP_RULE(LIST_BETA_CONV tm)) else DISCH tm (ASSUME tm) in \fn asm. let vs,body = strip_exists asm in itlist EXISTS_IMP vs (reduce fn body);; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : prove_asm % % % % Given the term "P" and an existentially-quantified term of the form: % % % % "?zs. C1 /\ ... /\ P /\ ... /\ Cn" % % % % prove_asm filters out those conjuncts of the form "P ". The % % theorem returned is: % % % % |- (?zs. C1 /\ ... /\ P /\ ... /\ Cn) ==> % % (?zs. C1 /\ ... /\ Cn) % % % % --------------------------------------------------------------------- % let prove_asm P tm = let test t = not(fst(strip_comb(concl t)) = P) in let vs,body = strip_exists tm in let newc = LIST_CONJ(filter test (CONJUNCTS(ASSUME body))) in itlist EXISTS_IMP vs (DISCH body newc);; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : simp_concl % % % % The argument rul is a rule of the form: % % % % |- !xs. (?zs. REL ps /\ SS) ==> REL ps % % % % and the term tm will be an unsimplified term of the form: % % % % "!xs. (?zs. REL ps /\ P /\ SS) ==> % % (REL ps /\ P ) % % % % The function simp_concl proves that the first conjunct of the % % antecedent of tm (i.e. REL ps ) is unnecessary. The result is: % % % % |- (!xs.(?zs. REL ps /\ P /\ SS) ==> P ) ==> tm % % --------------------------------------------------------------------- % let simp_concl rul tm = let vs,(ante,cncl) = (I # dest_imp) (strip_forall tm) in let srul = SPECL vs rul in let (cvs,a,c) = (I # dest_conj) (strip_forall cncl) in let simpl = prove_asm (fst(strip_comb c)) ante in let thm1 = SPECL cvs (UNDISCH (IMP_TRANS simpl srul)) in let newasm = list_mk_forall (vs, mk_imp(ante,list_mk_forall (cvs,c))) in let thm2 = CONJ thm1 (SPECL cvs (UNDISCH (SPECL vs (ASSUME newasm)))) in DISCH newasm (GENL vs (DISCH ante (GENL cvs thm2)));; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : simp_rule % % % % This function takes a rule of the form % % % % |- !xs. (?zs. REL ps /\ SS) ==> REL ps % % % % and a term of the form % % % % "!xs (?zs. (\vs. REL ps vs /\ P vs) /\ SS) ==> % % (!ys. (\vs. REL ps vs /\ P vs) ) % % % % and proves that % % % % |- (!xs. (?zs. REL ps /\ P /\ SS) ==> !ys. P ) % % ==> % % (!xs (?zs. (\vs. REL ps vs /\ P vs) /\ SS) ==> % % (!ys. (\vs. REL ps vs /\ P vs) ) % % % % That is, simp_rule essentially beta-reduces the input term and % % drops the redundant conjunct "REL ps " in the conclusion, as % % this holds by virtue of the rule itself. % % --------------------------------------------------------------------- % let simp_rule (rul,tm) = let vs,a,c = (I # dest_imp) (strip_forall tm) in let cvs,red = strip_forall c in let basm = reduce_asm (fst(strip_comb red)) a in let bth = itlist FORALL_EQ cvs (LIST_BETA_CONV red) in let asm = list_mk_forall(vs,mk_imp (rand(concl basm),rand(concl bth))) in let thm1 = UNDISCH (IMP_TRANS basm (SPECL vs (ASSUME asm))) in let thm2 = DISCH asm (GENL vs (DISCH a (EQ_MP (SYM bth) thm1))) in let thm3 = simp_concl rul (rand(rator(concl thm2))) in IMP_TRANS thm3 thm2;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : simp. % % % % Simplify a rule or an axiom using simp_rule or simp_axiom. % % --------------------------------------------------------------------- % let simp p = simp_rule p ? simp_axiom p;; % --------------------------------------------------------------------- % % derive_strong_induction % % % % The induction theorem for an inductively-defined relation REL has the % % general form: % % % % |- !ps. !P. RULES(ps)[P] ==> !xs. P xs ==> REL ps xs % % % % where the closure of P under a rule is typically expressed as: % % % % !xs. (?zs. P /\ ... /\ P /\ ss) ==> !ys. P % % % % The function derive_strong_induction strengthens the hypotheses of % % such a rule to include the assumptions that the values are % % also in the relation REL: % % % % !xs. (?zs. REL ps /\ P /\ ... /\ % % REL ps /\ P /\ ss) % % ==> !ys. P % % % % ===================================================================== % let derive_strong_induction (rules,ind) = (let ps,(hy,c) = (I # dest_imp) (strip_forall (concl ind)) in let srules = map (SPECL (butlast ps)) rules in let cvs,rel,pred = (I # dest_imp) (strip_forall c) in let newp = list_mk_abs(cvs,mk_conj(rel,pred)) in let pvar,args = strip_comb pred in let ith = INST [newp,pvar] (SPECL ps ind) in let as,co = dest_imp (concl ith) in let bth = LIST_BETA_CONV (list_mk_comb(newp,args)) in let sth = CONJUNCT2 (EQ_MP bth (UNDISCH (SPECL args (ASSUME co)))) in let thm1 = IMP_TRANS ith (DISCH co (GENL args (DISCH rel sth))) in let ths = map simp (combine (srules,conjuncts as)) in GENL ps (IMP_TRANS (end_itlist IMP_CONJ ths) thm1)) ? failwith `derive_strong_induction`;; % --------------------------------------------------------------------- % % Bind derive_strong_induction to "it". % % --------------------------------------------------------------------- % derive_strong_induction;; % --------------------------------------------------------------------- % % end of section. % % --------------------------------------------------------------------- % end_section strong_induction;; % --------------------------------------------------------------------- % % Save the exported value. % % --------------------------------------------------------------------- % let derive_strong_induction = it;; % ===================================================================== % % RULE INDUCTION % % ===================================================================== % begin_section RULE_INDUCT_THEN;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : TACF % % % % TACF is used to generate the subgoals for each case in an inductive % % proof. The argument tm is formula which states one case in the % % the induction. In general, this will take one of the forms: % % % % (1) no side condition, no assumptions: % % % % tm = !xs. P % % % % (2) side condition and/or assumptions: % % % % tm = !xs. (?zs. P /\ SS) ==> !ys. P % % % % When TACF is applied to tm, a parameterized tactic is returned which % % will later be applied to the corresponding subgoal in an induction. % % The resulting tactic takes two theorem continuations as arguments. % % For a base case, like case 1 above, the resulting tactic just throws % % these parameters away and passes the goal on unchanged: % % % % \ttac1 ttac2. ALL_TAC % % % % For a step case, like case 2, the tactic applies GEN_TAC to strip off % % the xs. It then strips off and breaks into conjuncts the induction % % hypotheses. The theorem continuation ttac1 is then applied to the % % premisses and the theorem continuation ttac2 applied to the side % % conditions. % % % % The implementation of TTAC uses three auxiliary functions, namely % % MK_CONJ_THEN, MK_CHOOSE_THEN and MK_THEN for stripping down the % % existentially-quantified conjunction of induction hypotheses. % % --------------------------------------------------------------------- % letrec MK_CONJ_THEN fn tm = (let c1,c2 = dest_conj tm in let tcl1 = (fst(strip_comb c1) = fn) => \t1 t2. t1 | \t1 t2. t2 in let tcl2 = MK_CONJ_THEN fn c2 in \ttac1 ttac2. CONJUNCTS_THEN2 (tcl1 ttac1 ttac2) (tcl2 ttac1 ttac2)) ? if (fst(strip_comb tm) = fn) then K else C K;; letrec MK_CHOOSE_THEN fn vs body = if (null vs) then MK_CONJ_THEN fn body else let tcl = MK_CHOOSE_THEN fn (tl vs) body in \ttac1 ttac2. CHOOSE_THEN (tcl ttac1 ttac2);; let MK_THEN fn tm = let vs,body = strip_exists tm in if (free_in fn body) then MK_CHOOSE_THEN fn vs body else \ttac1 ttac2. ttac2;; let TACF fn tm = let vs,body = strip_forall tm in if (is_imp body) then let TTAC = MK_THEN fn (fst(dest_imp body)) in \ttac1 ttac2. REPEAT GEN_TAC THEN DISCH_THEN (TTAC ttac1 ttac2) else \ttac1 ttac2. ALL_TAC;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : TACS % % % % TACS uses TACF to generate a parameterized list of tactics, one for % % each conjunct in the hypothesis of an induction theorem. If tm is the % % conjunction of cases for an induction theorem: % % % % "RULE1 /\ ... /\ RULEn" % % % % then TACS tm yields the paremterized list of tactics: % % % % \ttac1 ttac2. % % [TACF "RULE1" ttac1 ttac2; ...; TACF "RULEn" ttac1 ttac2] % % % % Where the applications TACF "RULEi" have been pre-evaluated. % % --------------------------------------------------------------------- % letrec TACS fn tm = let cf,csf = ((TACF fn # TACS fn) (dest_conj tm) ? TACF fn tm,(\x y.[])) in \ttac1 ttac2. (cf ttac1 ttac2) . (csf ttac1 ttac2);; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : mkred % % % % This produces a conversion that selectively beta-reduces the terms in % % a conjunction. Evaluating: % % % % mkred "f" ["c1";...;"cn"] % % % % produces a conversion that applies LIST_BETA_CONV to the conjuncts % % Ci in a term of the form: % % % % "C1 /\ ... /\ Cn" % % % % for which the corresponding "ci" is of the form "f x1 ... xn". % % --------------------------------------------------------------------- % letrec mkred fn (c.cs) = (let cfn = (fst(strip_comb c) = fn) => LIST_BETA_CONV | REFL in if (null cs) then cfn else let rest = mkred fn cs in \tm. let c1,c2 = dest_conj tm in MK_COMB(AP_TERM cnj (cfn c1),rest c2)) where cnj = "/\";; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : RED_CASE. % % % % Given the argument "fn" and a term corresponding to one of the rules % % % % !xs. (?zs. fn /\ ... /\ SS) ==> !ys. fn % % % % RED_CASE produces a conversion that will apply LIST_BETA_CONV to % % instances of this term at the positions which correspond to % % applications of fn to . % % --------------------------------------------------------------------- % let RED_CASE = let imp = "==>" in \fn pat. let bdy = snd(strip_forall pat) in if (is_imp bdy) then let ante = fst(dest_imp bdy) in let hyps = conjuncts(snd(strip_exists(ante))) in let redf = mkred fn hyps in \tm. let vs,ant,con = (I # dest_imp) (strip_forall tm) in let cvs,red = strip_forall con in let th1 = itlist FORALL_EQ cvs (LIST_BETA_CONV red) in let evs,hyp = strip_exists ant in let th2 = itlist EXISTS_EQ evs (redf hyp) in itlist FORALL_EQ vs (MK_COMB(AP_TERM imp th2,th1)) else \tm. let vs,con = strip_forall tm in itlist FORALL_EQ vs (LIST_BETA_CONV con);; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : APPLY_CASE % % % % Given a list of conversions [f1;...;fn], APPLY_CASE produces a % % conversion that applies fi to conjunct Ci in a term of the form: % % % % "C1 /\ ... /\ Cn" % % % % The result is |- (C1 /\ ... /\ Cn) = (^(f C1) /\ ... /\ ^(f Cn)) % % --------------------------------------------------------------------- % letrec APPLY_CASE (f.fs) tm = (if (null fs) then f tm else let c1,c2 = dest_conj tm in MK_COMB (AP_TERM cnj (f c1),APPLY_CASE fs c2)) where cnj = "/\";; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : RED_WHERE % % % % Given the argument "P" and a term corresponding to the statement of % % rule induction: % % % % RULES(ps)[P] ==> R ps vs ==> P vs % % % % RED_WHERE produces a conversion that will apply LIST_BETA_CONV to % % instances of this term at the positions which correspond to % % applications of P. % % --------------------------------------------------------------------- % let RED_WHERE fn body = let cs,con = (conjuncts # I) (dest_imp body) in let rfns = map (RED_CASE fn) cs in \stm. let a,c = dest_imp stm in let hthm = APPLY_CASE rfns a in let cthm = RAND_CONV LIST_BETA_CONV c in MK_COMB(AP_TERM "==>" hthm,cthm);; % --------------------------------------------------------------------- % % RULE_INDUCT_THEN : general rule induction tactic. % % % % The first theorem continuation is for premisses and the second is for % % side conditions. % % --------------------------------------------------------------------- % let is_param icvs slis arg = let val = snd (assoc arg slis) ? arg in mem val icvs;; let RULE_INDUCT_THEN th : (thm->tactic) -> (thm->tactic) -> tactic = (let vs,(hy,con) = (I # dest_imp) (strip_forall (concl th)) in let cvs,cncl = strip_forall con in let thm = DISCH hy (SPECL cvs(UNDISCH(SPECL vs th))) in let pvar = genvar (type_of (last vs)) in let sthm = INST [pvar,last vs] thm in let RED = RED_WHERE (last vs) (mk_imp(hy,cncl)) in let tacs = TACS (last vs) hy in (\ttac1 ttac2 (A,g). (let gvs,body = strip_forall g in let slis,ilis = match (rator cncl) (rator body) in let sith = INST_TY_TERM (slis,ilis) sthm in let largs = snd(strip_comb (rand(rator body))) in let icvs = map (inst [] ilis) cvs in let params = filter (is_param icvs slis) largs in let lam = list_mk_abs(params,rand body) in let spth = INST [lam,inst [] ilis pvar] sith in let spec = GENL gvs (UNDISCH (CONV_RULE RED spth)) in let subgls = map (pair A) (conjuncts (hd(hyp spec))) in let tactic g = subgls,\ths. PROVE_HYP (LIST_CONJ ths) spec in (tactic THENL (tacs ttac1 ttac2)) (A,g)) ? failwith `RULE_INDUCT_THEN: inappropriate goal`)) ? failwith `RULE_INDUCT_THEN: ill-formed rule induction theorem`;; % --------------------------------------------------------------------- % % Bind RULE_INDUCT_THEN to "it". % % --------------------------------------------------------------------- % RULE_INDUCT_THEN;; % --------------------------------------------------------------------- % % end of section. % % --------------------------------------------------------------------- % end_section RULE_INDUCT_THEN;; % --------------------------------------------------------------------- % % Save the exported value. % % --------------------------------------------------------------------- % let RULE_INDUCT_THEN = it;; % ===================================================================== % % TACTICS FROM THEOREMS THAT STATE RULES. % % ===================================================================== % begin_section RULE_TAC;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : axiom_tac % % % % This function maps an axiom of the form: % % % % |- R ps % % % % to a tactic: % % % % --- % % =========================== % % A ?- !xs. R % % % % where is an instance of ps, and an instance of . % % --------------------------------------------------------------------- % let axiom_tac th : tactic (A,g) = (let vs,body = strip_forall g in let instl = match (concl th) body in [], K (itlist ADD_ASSUM A (GENL vs (INST_TY_TERM instl th)))) ? failwith `RULE_TAC : axiom does not match goal`;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : prove_conj % % % % Given a list of theorems [|- C1; ...; |- Cn] and a conjunction % % % % "c1 /\ ... /\ cm" % % % % this function proves |- (c1 /\ ... /\ cm) provided each ci is equal % % to some Ci. % % --------------------------------------------------------------------- % letrec prove_conj ths tm = uncurry CONJ ((prove_conj ths # prove_conj ths) (dest_conj tm)) ? find (curry $= tm o concl) ths;; % --------------------------------------------------------------------- % % RULE_TAC : maps a theorem stating a rule to a tactic. % % --------------------------------------------------------------------- % let RULE_TAC : thm -> tactic = let mkg A vs c = A,list_mk_forall(vs,c) in \th. (let vs,rule = strip_forall(concl th) in (let asm,cvs,cncl = (I # strip_forall) (dest_imp rule) in let ith = DISCH asm (SPECL cvs (UNDISCH (SPECL vs th))) in \(A,g). (let gvs,body = strip_forall g in let slis,ilis = match cncl body in let th1 = INST_TY_TERM (slis,ilis) ith in let svs = freesl (map (subst slis o inst [] ilis) vs) in let nvs = intersect gvs svs in let ante = fst(dest_imp(concl th1)) in let newgs = map (mkg A nvs) (conjuncts ante) in newgs, \thl. let ths = map (SPECL nvs o ASSUME o snd) newgs in let th2 = GENL gvs (MP th1 (prove_conj ths ante)) in itlist PROVE_HYP thl th2) ? failwith `RULE_TAC : rule does not match goal`) ? axiom_tac (SPECL vs th)) ? failwith `RULE_TAC: ill-formed input theorem`;; % --------------------------------------------------------------------- % % Bind this value to "it". % % --------------------------------------------------------------------- % RULE_TAC;; % --------------------------------------------------------------------- % % end the section. % % --------------------------------------------------------------------- % end_section RULE_TAC;; % --------------------------------------------------------------------- % % save the function. % % --------------------------------------------------------------------- % let RULE_TAC = it;; % ===================================================================== % % REDUCTION OF A CONJUNCTION OF EQUATIONS. % % ===================================================================== % begin_section REDUCE;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : reduce % % % % A call to % % % % reduce [v1;...;vn] ths [] [] % % % % reduces the list of theorems ths to an equivalent list by removing % % theorems of the form |- vi = ti where vi does not occur free in ti, % % first using this equation to substitute ti for vi in all the other % % theorems. The theorems in ths are processed sequentially, so for % % example: % % % % reduce [a;b] [|- a=1; |- b=a+2; |- c=a+b] [] [] % % % % is reduced in the following stages: % % % % [|- a=1; |- b=a+2; |- c=a+b] % % % % ===> [|- b=1+2; |- c=1+b] (by the substitution [1/a]) % % ===> [|- c=1+(1+2)] (by the substitution [1+2/b]) % % % % The function returns the reduced list of theorems, paired with a list % % of the substitutions that were made, in reverse order. The result % % for the above example would be [|- c = 1+(1+2)],[("1+2",b);("1",a)]. % % --------------------------------------------------------------------- % letrec reduce vs ths res sub = if (null ths) then (rev res, sub) else (let l,r = dest_eq(concl(hd ths)) in let sth,pai = mem l vs => hd ths,(r,l) | mem r vs => SYM(hd ths),(l,r) | fail in if free_in (snd pai) (fst pai) then fail else let sfn = map (SUBS [sth]) in let ssfn = map \(x,y). (subst [pai] x),y in reduce vs (sfn (tl ths)) (sfn res) (pai . ssfn sub)) ? (reduce vs (tl ths) (hd ths . res) sub);; % --------------------------------------------------------------------- % % REDUCE : simplify an existentially quantified conjuction by % % eliminating conjuncts of the form |- v=t, where v is among the % % quantified variables and v does not appear free in t. For example % % suppose: % % % % tm = "?vi. ?vs. C1 /\ ... /\ v = t /\ ... /\ Cn" % % % % then the result is: % % % % |- (?vi. ?vs. C1 /\ ... /\ vi = ti /\ ... /\ Cn) % % = % % (?vs. C1[ti/vi] /\ ... /\ Cn[ti/vi]) % % % % The equations vi = ti can appear as ti = vi, and all eliminable % % equations are eliminated. Fails unless there is at least one % % eliminable equation. Also flattens conjuncts. Reduces term to "T" if % % all variables eliminable. % % --------------------------------------------------------------------- % let REDUCE = let chfn v (a,th) = let tm = mk_exists(v,a) in let th' = if (free_in v (concl th)) then EXISTS (mk_exists(v,concl th),v) th else th in (tm,CHOOSE (v,ASSUME tm) th') in let efn ss v (pat,th) = let wit = fst(rev_assoc v ss) ? v in let epat = subst ss (mk_exists(v,pat)) in (mk_exists(v,pat),EXISTS(epat,wit) th) in letrec prove ths cs = (uncurry CONJ ((prove ths # prove ths) (dest_conj cs))) ? (find (\t. concl t = cs) ths) ? (REFL (rand cs)) in \tm. let vs,cs = strip_exists tm in let rem,ss = reduce vs (CONJUNCTS (ASSUME cs)) [] [] in if (null ss) then failwith `REDUCE` else let th1 = LIST_CONJ rem ? TRUTH in let th2 = (uncurry DISCH) (itlist chfn vs (cs,th1)) in let rvs,rcs = strip_exists(rand(concl th2)) in let eqt = subst ss cs in let th3 = prove (CONJUNCTS (ASSUME rcs)) eqt in let _,th4 = itlist (efn ss) vs (cs,th3) in let th5 = (uncurry DISCH) (itlist chfn rvs (rcs,th4)) in IMP_ANTISYM_RULE th2 th5;; % --------------------------------------------------------------------- % % Bind this value to "it". % % --------------------------------------------------------------------- % REDUCE;; % --------------------------------------------------------------------- % % end the section. % % --------------------------------------------------------------------- % end_section REDUCE;; % --------------------------------------------------------------------- % % save the function. % % --------------------------------------------------------------------- % let REDUCE = it;; % ===================================================================== % % CASES THEOREM % % ===================================================================== % begin_section derive_cases_thm;; % --------------------------------------------------------------------- % % Old version of MATCH_MP reinstated here. % % --------------------------------------------------------------------- % let MATCH_MP impth = let hy,(vs,imp) = (I # strip_forall) (dest_thm impth) in let pat = fst(dest_imp imp) ? failwith `MATCH_MP: not an implication` in let fvs = subtract (frees (fst(dest_imp imp))) (freesl hy) in let gth = GSPEC (GENL fvs (SPECL vs impth)) in let matchfn = match (fst(dest_imp(concl gth))) in \th. (MP (INST_TY_TERM (matchfn (concl th)) gth) th) ? failwith `MATCH_MP: does not match`;; % --------------------------------------------------------------------- % % INTERNAL FUNCTION : LIST_NOT_FORALL % % % % If: % % |- ~P % % --------------- f : thm->thm % % |- Q |- R % % % % Then: % % % % |- ~!x1 ... xi. P % % ---------------------------- % % |- ?x1 ... xi. Q |- R % % --------------------------------------------------------------------- % let LIST_NOT_FORALL = let efn v th = EXISTS(mk_exists(v,concl th),v) th in \f th. let vs,body = strip_forall (dest_neg (concl th)) in if (null vs) then f th else let Q,R = f (ASSUME(mk_neg body)) in let nott = itlist efn vs Q in let thm = CCONTR body (MP (ASSUME (mk_neg (concl nott))) nott) in CCONTR (concl nott) (MP th (GENL vs thm)), R;; % --------------------------------------------------------------------- % % simp_axiom: simplify the body of an axiom. % % --------------------------------------------------------------------- % let simp_axiom sfn vs ax th = (let rbody = LIST_BETA_CONV (dest_neg(concl th)) in let fth = MP th (EQ_MP (SYM rbody) (ASSUME (rand (concl rbody)))) in let imp = PROVE_HYP th (CCONTR (dest_neg(rand(concl rbody))) fth) in let ante,eqs = (I # conjuncts) (dest_imp(concl imp)) in let avs,res = strip_forall (concl ax) in let inst = INST (fst(match res ante)) (SPECL avs ax) in let ths = MP imp inst in let thm = sfn (ASSUME(concl ths)) inst in let rth = (uncurry DISCH) (itlist chfn vs ((concl ths),thm)) in (ths,rth)) where chfn v (a,th) = let tm = mk_exists(v,a) in (tm,CHOOSE (v,ASSUME tm) th);; % --------------------------------------------------------------------- % % crul rel th : beta-reduce and simplify if rel is free in th % % % % |- (\xs. ~(P ==> Q)) ts % % -------------------------- crul rel th % % |- P[ts/xs] % % --------------------------------------------------------------------- % let crul rel th = if (free_in rel (concl th)) then let th1 = CONV_RULE LIST_BETA_CONV th in CONJUNCT1 (CONV_RULE (REWR_CONV NOT_IMP) th1) else th;; % --------------------------------------------------------------------- % % CONJ_RUL : chain through conjunction. % % % % If: % % % % |- Pi % % -------------- (crul rel) % % |- Qi % % % % then: % % % % |- P1 /\ ... /\ Pj % % --------------------- CONJ_RUL rel % % |- P1 /\ ... /\ Qj % % --------------------------------------------------------------------- % letrec CONJ_RUL rel th = (uncurry CONJ ((crul rel # CONJ_RUL rel) (CONJ_PAIR th))) ? crul rel th;; % --------------------------------------------------------------------- % % LIST_EXIST_THEN : chain through exists. % % % % If: % % % % |- P % % ------------- f % % |- Q % % % % then: % % % % |- ?x1...xi. P % % --------------------- LIST_EXISTS_THEN f % % |- ?x1...xi. Q % % --------------------------------------------------------------------- % let LIST_EXISTS_THEN f th = let vs,body = strip_exists(concl th) in let th1 = DISCH body (f (ASSUME body)) in MP (itlist EXISTS_IMP vs th1) th;; % --------------------------------------------------------------------- % % RULE % % % % |- !xs. p xs % % --------------------------------- RULE |- ?xs. p xs => q xs % % |- ?xs. q xs % % --------------------------------------------------------------------- % let RULE thm1 thm2 = let xs,imp = strip_exists (concl thm1) in let thm = SPECL xs thm2 in let impth = MP (ASSUME imp) thm in let iimp = DISCH imp impth in MATCH_MP (itlist EXISTS_IMP xs iimp) thm1;; % --------------------------------------------------------------------- % % EXISTS_IMP : existentially quantify the antecedent and conclusion % % of an implication. % % % % A |- P ==> Q % % -------------------------- EXISTS_IMP "x" % % A |- (?x.P) ==> (?x.Q) % % % % LIKE built-in, but doesn't quantify in Q if not free there. % % Actually, used only in context where x not free in Q. % % --------------------------------------------------------------------- % let EXISTS_IMP2 x th = let ante,cncl = dest_imp(concl th) in if (free_in x cncl) then let th1 = EXISTS (mk_exists(x,cncl),x) (UNDISCH th) in let asm = mk_exists(x,ante) in DISCH asm (CHOOSE (x,ASSUME asm) th1) else let asm = mk_exists(x,ante) in DISCH asm (CHOOSE (x,ASSUME asm) (UNDISCH th));; % --------------------------------------------------------------------- % % |- ?xs. P |- ?ys. Q ===> ?xs ys. P /\ Q % % [Primes the ys if necessary.] % % --------------------------------------------------------------------- % let efn v th = if free_in v (concl th) then EXISTS(mk_exists(v,concl th),v) th else th;; let RULE2 vs thm1 thm2 = let xs,P = strip_exists(concl thm1) in let ys,Q = strip_exists(concl thm2) in let itfn = \v vs. let v' = variant (vs @ xs) v in (v'.vs) in let ys' = itlist itfn ys [] in let Q' = subst(combine(ys',ys)) Q in let asm = CONJ (ASSUME P) (ASSUME Q') in let ths = CONJUNCTS asm in let realths = ths in let cs = LIST_CONJ realths in let vs = filter (C free_in (concl cs)) (xs @ ys') in let eth = MP (itlist EXISTS_IMP2 xs (DISCH P (itlist efn vs cs))) thm1 in let eth' = MP (itlist EXISTS_IMP2 ys' (DISCH Q' eth)) thm2 in eth';; % --------------------------------------------------------------------- % % |- ~~P % % -------- NOT_NOT % % |- P % % --------------------------------------------------------------------- % let NOT_NOT th = CCONTR (dest_neg(dest_neg (concl th))) (UNDISCH th);; % --------------------------------------------------------------------- % % simp_rule: simplify the body of a non-axiom rule. % % --------------------------------------------------------------------- % let simp_rule = let rule = NOT_NOT o CONV_RULE(RAND_CONV LIST_BETA_CONV) in \sfn set vs rul th. (let c1,c2 = CONJ_PAIR (CONV_RULE (REWR_CONV NOT_IMP) th) in let th1,_ = LIST_NOT_FORALL (\th. rule th,TRUTH) c2 in let th2 = LIST_EXISTS_THEN (CONJ_RUL set) c1 in let evs,imp = strip_exists (concl th1) in let gvs,cnc = (I # rand) (strip_forall(concl rul)) in let th3 = UNDISCH (SPECL gvs rul) in let pat = list_mk_forall(evs,fst(dest_imp imp)) in let inst = fst(match (concl th3) pat) in let tha = INST inst (DISCH_ALL th3) in let rins = MATCH_MP tha th2 in let erins = MATCH_MP tha (ASSUME (concl th2)) in let eqns = RULE th1 rins in let evs,eths = (I # conjuncts) (strip_exists(concl eqns)) in let thm = sfn (LIST_CONJ (map ASSUME eths)) (SPECL evs erins) in let vv,cs = (I # conjuncts) (strip_exists(concl th2)) in let itfn = \v vs. let v' = variant (vs @ evs) v in (v'.vs) in let vv' = itlist itfn vv [] in let cs' = map (subst(combine(vv',vv))) cs in let thx = PROVE_HYP (itlist efn vv' (LIST_CONJ (map ASSUME cs'))) thm in let simp = RULE2 vs eqns th2 in let nevs,cn = strip_exists(concl simp) in let hys = CONJUNCTS (ASSUME cn) in let hh,nthm = itlist chfn nevs (cn,itlist PROVE_HYP hys thx) in let res = (uncurry DISCH) (itlist chfn vs (hh,nthm)) in (PROVE_HYP th simp, res)) where chfn v (a,th) = let tm = mk_exists(v,a) in (tm,CHOOSE (v,ASSUME tm) th) and efn v th = EXISTS(mk_exists(v,concl th),v) th;; % --------------------------------------------------------------------- % % simp : simplify a case in the case analysis theorem % % % % Each case has the form ~(!x1...xn.P). The inference rule is: % % % % If: % % % % |- ~ P % % ------------- simp_axiom [x1;...;xn] rul % % |- Q % % % % or: % % % % |- ~ P % % ------------- simp_rule [x1;...;xn] set rul % % |- Q % % % % then: % % % % |- ~(!x1...xi. P) % % --------------------- simp set rul % % |- ?y1...yj. Q % % --------------------------------------------------------------------- % let simp set sfn rul th = let vs = fst(strip_forall (dest_neg (concl th))) in LIST_NOT_FORALL (simp_axiom sfn vs rul) th ? LIST_NOT_FORALL (simp_rule sfn set vs rul) th ? failwith `simp`;; % --------------------------------------------------------------------- % % LIST_DE_MORGAN: iterated inference rule. % % % % If: % % % % ~Pi |- ~Pi % % --------------------------- f (|- thi) % % R |- Qi |- Qi ==> R % % % % Then % % % % R |- ~(P1 /\ ... /\ Pn) % % ------------------------ LIST_DE_MORGAN f [|- th1;...;|- thn] % % R |- Q1 \/ ... \/ Qn % % |- Q1 \/ ... \/ Qn ==> R % % --------------------------------------------------------------------- % let LIST_DE_MORGAN = let v1 = genvar ":bool" and v2 = genvar ":bool" in let thm = fst(EQ_IMP_RULE(CONJUNCT1 (SPECL [v1;v2] DE_MORGAN_THM))) in let IDISJ th1 th2 = let di = mk_disj(rand(rator(concl th1)),rand(rator(concl th2))) in DISCH di (DISJ_CASES (ASSUME di) (UNDISCH th1) (UNDISCH th2)) in let ITDISJ th1 th2 = let [hy1],cl1 = dest_thm th1 and [hy2],cl2 = dest_thm th2 in let dth = UNDISCH (INST [rand hy1,v1;rand hy2,v2] thm) in DISJ_CASES_UNION dth th1 th2 in \f ths th. let cs = conjuncts(dest_neg (concl th)) in let ts1,ts2 = split (map2 (\r,t. f r (ASSUME(mk_neg t))) (ths,cs)) in (PROVE_HYP th (end_itlist ITDISJ ts1)),end_itlist IDISJ ts2;; % --------------------------------------------------------------------- % % derive_cases_thm : prove exhaustive case analysis theorem for an % % inductively defined relation. % % --------------------------------------------------------------------- % let derive_cases_thm (rules,ind) = let vs,(hy,c) = (I # dest_imp) (strip_forall (concl ind)) in let ps,P = (butlast vs, last vs) in let sind = SPECL ps ind and srules = map (SPECL ps) rules in let cvs,con = strip_forall c in let thm1 = DISCH hy (SPECL cvs (UNDISCH (SPEC P sind))) in let avs = map (genvar o type_of) cvs in let eqns = list_mk_conj(map2 mk_eq (cvs,avs)) in let asmp = subst (combine(avs,cvs)) (rator con) in let pred = list_mk_abs (avs,mk_neg(mk_comb(asmp,eqns))) in let thm2 = UNDISCH (UNDISCH (INST [pred,P] thm1)) in let thm3 = CONV_RULE LIST_BETA_CONV thm2 in let HY = rand(rator con) in let contr = DISCH HY (ADD_ASSUM HY (LIST_CONJ (map REFL cvs))) in let fthm = NOT_INTRO (DISCH (subst [pred,P] hy) (MP thm3 contr)) in let sfn eqs = SUBST (combine(map SYM (CONJUNCTS eqs),cvs)) HY in let set = fst(strip_comb HY) in let a,b = LIST_DE_MORGAN (simp set sfn) srules fthm in let th = IMP_ANTISYM_RULE (DISCH HY a) b in let ds = map (TRY_CONV REDUCE) (disjuncts(rand(concl th))) in let red = end_itlist (\t1 t2. MK_COMB (AP_TERM "\/" t1,t2)) ds in GENL ps (GENL cvs (TRANS th red));; % --------------------------------------------------------------------- % % Bind this value to "it". % % --------------------------------------------------------------------- % derive_cases_thm;; % --------------------------------------------------------------------- % % end the section. % % --------------------------------------------------------------------- % end_section derive_cases_thm;; % --------------------------------------------------------------------- % % save the function. % % --------------------------------------------------------------------- % let derive_cases_thm = it;; %< ===================================================================== TEST CASES loadf `ind_defs`;; timer true;; let rules1,ind1 = let N = "N (R:num->num->bool) : num->num->bool" in new_inductive_definition false `def1` ("^N n m", ["R:num->num->bool"]) [ [],"^N 0 m" ; ["^N n m"; "R (m:num) (n:num):bool"], "^N (n+2) k"];; derive_strong_induction (rules1,ind1);; derive_cases_thm (rules1,ind1);; let rules2,ind2 = let RTC = "RTC1:(*->*->bool)->*->*->bool" in new_inductive_definition false `def2` ("^RTC R x y", ["R:*->*->bool"]), [ [ % ------------------------------ % "R (x:*) (y:*):bool"], "^RTC R x y" ; [ ], %------------------------------- % "^RTC R x x" ; [ "^RTC R z y" ; "(R:*->*->bool) x z" %------------------------------- %], "^RTC R x y" ];; derive_strong_induction (rules2,ind2);; derive_cases_thm (rules2,ind2);; let rules3,ind3 = let RTC = "RTC2:(*->*->bool)->*->*->bool" in new_inductive_definition false `def3` ("^RTC R x y", ["R:*->*->bool"]), [ [ % ------------------------------ % "R (x:*) (y:*):bool"], "^RTC R x y" ; [ ], %------------------------------- % "^RTC R x x" ; [ "^RTC R z y" ; "(R:*->*->bool) x z" %------------------------------- %], "^RTC R x y" ];; derive_strong_induction (rules3,ind3);; derive_cases_thm (rules3,ind3);; let rules4,ind4 = let RTC = "RTC4:(*->*->bool)->*->*->bool" in new_inductive_definition false `def4` ("^RTC R x y", ["R:*->*->bool"]), [ [ % ------------------------------ % "R (x:*) (y:*):bool"], "^RTC R x y" ; [ %------------------------------- % ], "^RTC R x x" ; [ "^RTC R x z"; "^RTC R z y" ], %------------------------------- % [], "^RTC R x y" ];; derive_strong_induction (rules4,ind4);; derive_cases_thm (rules4,ind4);; let rules5,ind5 = let ODD = "ODD:num->num->bool" in new_inductive_definition false `def5` ("^ODD n m", []), [ [ % ------------------------------ % ], "^ODD 2 3" ; [ "^ODD n m"; "(1=2) /\ (3=4)"; "^ODD 2 3" %------------------------------- % ], "^ODD (n+m) m" ];; derive_strong_induction (rules5,ind5);; derive_cases_thm (rules5,ind5);; let rules6,ind6 = let EVEN = "EVEN:num->bool" in new_inductive_definition false `def6` ("^EVEN n", []), [ [ % ------------------------------ % ], "^EVEN 0" ; [ "^EVEN n" %------------------------------- % ], "^EVEN (n+2)" ];; derive_strong_induction (rules6,ind6);; derive_cases_thm (rules6,ind6);; ===================================================================== >% hol88-2.02.19940316/Library/ind_defs/Makefile0000640000212700021270000000315305071306632016547 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: ind_defs # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : compile code # # make clean : remove compiled code # # make clobber : remove compiled code # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o @echo "===> library ind_defs: all object code deleted" clobber: rm -f *_ml.o *_ml.l @echo "===> library ind_defs: all object code deleted" # ===================================================================== # Entries for individual files. # ===================================================================== ind-defs_ml.o: ind-defs.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `ind-defs`;;'\ 'quit();;' | ${Hol} ind_defs_ml.o: ind-defs_ml.o ind_defs.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `ind_defs`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: ind_defs_ml.o @echo "===> library ind_defs rebuilt" hol88-2.02.19940316/Library/ind_defs/ind_defs.ml0000640000212700021270000000112105071307656017214 0ustar cammcamm% ===================================================================== % % FILE : ind_defs.ml % % DESCRIPTION : loads the library "ind_defs" into hol. % % % % AUTHOR : T. Melham % % DATE : 91.10.30 % % ===================================================================== % % --------------------------------------------------------------------- % % Load the compiled code into ml. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/ind_defs/ind-defs` in load(path, get_flag_value `print_lib`);; hol88-2.02.19940316/Library/ind_defs/READ-ME0000640000212700021270000000100405071310771016034 0ustar cammcamm This directory contains the first release of an inductive definitions package for HOL. There is no manual at present, but preliminary documentation can be found in the Manual directory. Note that this is an initial release, and at least following changes are proposed: * to add a function that maps rules as theorems to ML inference rules * to strengthen the implication proved by derive_cases_thm to equality Please report any bugs or other problems to me. Tom Melham (tfm@cl.cam.ac.uk) September 1991 hol88-2.02.19940316/Library/taut/0000750000212700021270000000000005533117166014313 5ustar cammcammhol88-2.02.19940316/Library/taut/Manual/0000750000212700021270000000000005535606262015532 5ustar cammcammhol88-2.02.19940316/Library/taut/Manual/taut.tex0000640000212700021270000000443305104511664017227 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: taut library (standard latex style) % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{description} % --------------------------------------------------------------------- % Reference manual entries for functions % --------------------------------------------------------------------- \include{entries} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/taut/Manual/description.tex0000640000212700021270000001651005104511674020575 0ustar cammcamm\chapter{The taut Library} This document describes the facilities provided by the \ml{taut} library for the HOL system~\cite{description}. Functions for proving propositional formulae and instances of propositional formulae are provided. There is a conversion which given a universally quantified propositional term proves it to be either true or false, a conversion which given a valid propositional formula returns it as a theorem, and a tactic for proving propositional goals. There are also similar conversions and tactics for proving instances of propositional formulae. The library is designed for proving propositional formulae valid (true under all interpretations), but if the argument formula is closed (with universal quantifiers), the main function (\ml{PTAUT\_CONV}) is capable of evaluating the formula to either true or false. The function assumes that any variable occurring free is to be taken as universally quantified. \ml{PTAUT\_CONV} is described in more detail below. Given a term of the form {\small\verb%"!x1 ... xn. t"%} where {\small\verb%t%} contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, and all the variables in {\small\verb%t%} appear in {\small\verb%x1 ... xn%}, the conversion \ml{PTAUT\_CONV} proves the term to be either true or false, that is, one of the following theorems is returned: \begin{boxed}\begin{verbatim} |- (!x1 ... xn. t) = T |- (!x1 ... xn. t) = F \end{verbatim}\end{boxed} \noindent \ml{PTAUT\_CONV} also accepts propositional terms that are not fully universally quantified. However, for such a term, the conversion will only succeed if the term is valid. \ml{PTAUT\_CONV} has two failure modes. The failure string {\small\verb%`PTAUT_CONV`%} indicates that the argument term is not a propositional formula. The string: \begin{small}\begin{verbatim} `PTAUT_CONV -- false for at least one interpretation` \end{verbatim}\end{small} \noindent indicates that the argument term is not fully universally quantified and is false for at least one interpretation of the variables. The conversion \ml{TAUT\_CONV} performs a similar operation to \ml{PTAUT\_CONV} but also works for instances of propositional formulae provided they are valid (it won't prove invalid formulae false). An instance\index{instantiation of variables!with terms} of a propositional formula is a formula in which one or more of the variables have been replaced by terms of the same type. \ml{TAUT\_CONV} does not require the variables of the formula to be universally quantified but will accept such terms. \section{An outline of the method of proof} A propositional formula is proved true or false by performing a Boolean case analysis\index{case analysis!on Boolean values} on each of the variables in the formula. The outermost universally quantified variable is chosen and two new formulae are generated: one with the variable replaced by {\small\verb%T%} (true) and the other with the variable replaced by {\small\verb%F%} (false). A propositional simplifier\index{simplifier!for propositional formulae} is then called on each of these formulae. The entire process of instantiation\index{instantiation of variables!with true and false} and simplification is repeated for each of the resulting formulae. When all the variables have been instantiated, the simplifier will return either {\small\verb%T%} or {\small\verb%F%}. Suppose the original formula was of the form {\small\verb%"!x. f[x]"%}. If the theorems returned from the subcalls are {\small\verb%|- f[T] = T%} and {\small\verb%|- f[F] = T%}, we can deduce {\small\verb%|- (!x. f[x]) = T%}. If either of the results are {\small\verb%F%} we can deduce that {\small\verb%|- (!x. f[x]) = F%}. \index{optimization} The procedure is optimized for terms with more than two variables by eliminating\index{duplicated subcalls!elimination of} some duplicated subcalls. These arise if having instantiated a variable the two new formulae simplify to the same term. The procedure is also optimized for cases when the body simplifies to true or false before all the variables have been analysed. Also, the simplification function is optimized to avoid\index{rebuilding terms!avoiding when no change} rebuilding subterms that are not changed. Experiments have been performed with special code for cases when the first argument of a conjunction, disjunction, implication, or conditional simplifies to a value that makes simplification of certain other arguments unnecessary. For example, if the first argument of a conjunction is false the entire conjunction must be false. The results suggested that in general slightly fewer intermediate theorems are generated, but that due to the overhead of testing, the execution times are slightly longer. Instances of propositional formulae are proved by replacing the non-propositional subterms with unique variables. The procedure for purely propositional formulae is used to prove this generalized formula (if possible). The result is then specialized to obtain a theorem for the original formula. \section{Proving formulae containing free variables} In addition to closed terms, the \ml{PTAUT\_CONV} function accepts propositional terms that are not fully universally quantified. However, for such a term, the conversion will fail unless it is valid. Consider the term {\small\verb%"!x2 ... xn. f[x1,...,xn]"%}. The conversion first proves one of the following theorems: \begin{boxed}\begin{verbatim} |- (!x1 ... xn. f[x1,...,xn]) = T |- (!x1 ... xn. f[x1,...,xn]) = F \end{verbatim}\end{boxed} \noindent To obtain the required result, the former can be manipulated as follows: \begin{boxed}\begin{verbatim} |- (!x1 ... xn. f[x1,...,xn]) = T |- !x1 ... xn. f[x1,...,xn] |- !x2 ... xn. f[x1,...,xn] |- (!x2 ... xn. f[x1,...,xn]) = T \end{verbatim}\end{boxed} \noindent However when the fully quantified term is false, we have: \begin{boxed}\begin{verbatim} |- (!x1 ... xn. f[x1,...,xn]) = F |- ~(!x1 ... xn. f[x1,...,xn]) |- ?x1. ~(!x2 ... xn. f[x1,...,xn]) |- ?x1. ((!x2 ... xn. f[x1,...,xn]) = F) \end{verbatim}\end{boxed} \noindent whereas we want: \begin{boxed}\begin{verbatim} |- !x1. ((!x2 ... xn. f[x1,...,xn]) = F) \end{verbatim}\end{boxed} \noindent because it is equivalent to: \begin{boxed}\begin{verbatim} |- (!x2 ... xn. f[x1,...,xn]) = F \end{verbatim}\end{boxed} \noindent The conversions in the \ml{taut} library are not capable of proving this theorem. \section{Using the library} The \ml{taut} library can be loaded into a user's \HOL\ session using the function \ml{load\_library}\index{load\_library@{\ptt load\_library}} (see the \HOL\ manual for a general description of library loading). The first action in the load sequence initiated by \ml{load\_library} is to update the \HOL\ help\index{help!updating search path} search path. The help search path is updated with a pathname to online help files for the \ML\ functions in the library. After updating the help search path, the \ML\ functions in the library are loaded into \HOL. The following session shows how the \ml{taut} library may be loaded using \ml{load\_library}: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #load_library `taut`;; Loading library `taut` ... Updating help search path ........................................ Library `taut` loaded. () : void # \end{verbatim}\end{session} hol88-2.02.19940316/Library/taut/Manual/taut.log0000640000212700021270000000377605535606273017232 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:25 **taut.tex (taut.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file taut.idx (taut.aux (title.aux) (description.aux) (entries.aux) (references.aux) (index.aux)) (title.tex [1 ] [2]) (taut.toc) \tf@toc=\write4 [3 ] [4 ] (description.tex Chapter 1. [1 ] [2]) [3] (entries.tex [4 ] Chapter 2. (entries-intro.tex) [5] Underfull \vbox (badness 1810) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.62712 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [6] [7] [8] [9]) [10] (references.tex) [11 ] (index.tex [12 ]) (taut.aux (title.aux) (description.aux) (entries.aux) (references.aux) (index.aux)) ) Here is how much of TeX's memory you used: 443 strings out of 11977 3663 string characters out of 87025 37316 words of memory out of 262141 2286 multiletter control sequences out of 9500 19472 words of font info for 74 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 17i,12n,17p,189b,458s stack positions out of 300i,100n,60p,3000b,4000s Output written on taut.dvi (16 pages, 22240 bytes). hol88-2.02.19940316/Library/taut/Manual/taut.idx0000640000212700021270000000132505535606273017221 0ustar cammcamm\indexentry{instantiation of variables!with terms}{1} \indexentry{case analysis!on Boolean values}{2} \indexentry{simplifier!for propositional formulae}{2} \indexentry{instantiation of variables!with true and false}{2} \indexentry{optimization}{2} \indexentry{duplicated subcalls!elimination of}{2} \indexentry{rebuilding terms!avoiding when no change}{2} \indexentry{load\_library@{\ptt load\_library}}{3} \indexentry{help!updating search path}{3} \indexentry{PTAUT\_CONV@{\ptt PTAUT\_CONV}}{5} \indexentry{PTAUT\_PROVE@{\ptt PTAUT\_PROVE}}{6} \indexentry{PTAUT\_TAC@{\ptt PTAUT\_TAC}}{7} \indexentry{TAUT\_CONV@{\ptt TAUT\_CONV}}{8} \indexentry{TAUT\_PROVE@{\ptt TAUT\_PROVE}}{8} \indexentry{TAUT\_TAC@{\ptt TAUT\_TAC}}{9} hol88-2.02.19940316/Library/taut/Manual/taut.aux0000640000212700021270000000016405535606273017232 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{references.aux} \@input{index.aux} hol88-2.02.19940316/Library/taut/Manual/title.aux0000640000212700021270000000077305535606266017406 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/taut/Manual/taut.dvi0000640000212700021270000005334005535606273017223 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1025‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘h?³óHò"VáG cmbx10ëHThe– ‰‹HOL“taut“LibraryŽŸI­Û’Äæ¶ó7ò"Vff cmbx10âR.–…J.“BoultonŽ „ÃÒ‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’Ùú-July‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’™I¨ž£hó+X«Q cmr12ÖcŽŽŽ’•æó-!",š cmsy10Ø ŽŽŽŽ’¥ÐÁÖR.–ê¨J.“Boulton“1991ŽŽŽŒ‹È ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFLÛ1Ž‘ŸôThe–€taut“Library’J.ˆ1ŽŽ¤‘ŸôÖ1.1Ž‘,¦JAn–ê¨outline“of“the“methošSŽd“of“pro˜of‘¾‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ߎŒ‹» ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸGëHThe– ‰‹taut“LibraryŽŸÖx‰Ç>|Ÿ;ÖThis–èdošSŽcumen¬rt“describ˜es“the“facilities“proš¬rvided“b˜y“the“ó(ßêþÓ`PTAUT_CONV–¿ª--“false“for“at“least“one“interpretation`ŽŸ@$Öindicates–65that“the“argumenš¬rt“term“is“not“fully“univ˜ersally“quan˜ti ed“and“is“false“for“at“leastŽ¡one–ê¨in¬rterpretation“of“the“v‘ÿXäariables.Ž¡‘ aThe›„¼con•¬rv“ersion˜ÓTAUT_CONVŽ‘<ÆrÖp•SŽerforms˜a˜similar˜op“eration˜to˜ÓPTAUT_CONVŽ‘B†Öbut˜also˜w¬rorksŽ¡for–]instances“of“propSŽositional“formš¬rulae“pro˜vided“they“are“v‘ÿXäalid“(it“w˜on't“pro˜v˜e“in˜v‘ÿXäalidŽ¡formš¬rulae–žúfalse).‘¦An“instance“of“a“propSŽositional“form˜ula“is“a“form˜ula“in“whic˜h“one“or“moreŽ¡of–8Çthe“v‘ÿXäariables“ha•¬rv“e–8ÇbSŽeen“replaced“bš¬ry“terms“of“the“same“t˜yp•SŽe.‘ý•ÓTAUT_CONVŽ‘;óVÖdo“es–8Çnot“requireŽ¡the–ê¨v‘ÿXäariables“of“the“formš¬rula“to“bSŽe“univ˜ersally“quan˜ti ed“but“will“accept“suc˜h“terms.ŽŽŸ$ý’óŸÛ1ŽŽŒ‹/ ÌU ýFÓŸú™š‘êñëÛ2’ Chapter–€1.‘ €The“taut“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëó<ò"VG® cmbx10ç1.1Ž‘5oAn–Ÿ¼outline“of“the“metho›Od“of“pro˜ofŽŸù`‘êñëÖA‘,…propSŽositional–,Øformš¬rula“is“pro˜v˜ed“true“or“false“b˜y“pšSŽerforming“a“Bo˜olean“case“analysisŽ¤‘êñëon–Ñeacš¬rh“of“the“v‘ÿXäariables“in“the“form˜ula.‘Ï[The“outermost“univ˜ersally“quan˜ti ed“v‘ÿXäariable“isŽ¡‘êñëcš¬rhosen–j¼and“t˜w˜o“new“form˜ulae“are“generated:‘9 one“with“the“v‘ÿXäariable“replaced“b˜y“ÓT‘j›Ö(true)Ž¡‘êñëand–tthe“other“with“the“v‘ÿXäariable“replaced“b¬ry“ÓF–tlÖ(false).‘Ö˜A“propSŽositional–tsimpli er“is“thenŽ¡‘êñëcalled–Únon“eacš¬rh“of“these“form˜ulae.‘3wThe“en˜tire“proSŽcess“of“instan˜tiation“and“simpli cation“isŽ¡‘êñërepSŽeated– ‘for“eacš¬rh“of“the“resulting“form˜ulae.‘îØWhen“all“the“v‘ÿXäariables“ha˜v˜e“bSŽeen“instan˜tiated,Ž¡‘êñëthe–ê¨simpli er“will“return“either“ÓT“Öor“ÓFÖ.Ž©<‘öSzSuppSŽose–cthe“original“formš¬rula“w˜as“of“the“form“Ó"!x.‘¿ªf[x]"Ö.‘ªIf“the“theorems“returnedŽ¡‘êñëfrom–Sthe“subSŽcalls“are“Ó|-–¿ªf[T]“=“T‘RíÖand›SÓ|-“f[F]“=“TÖ,˜w¬re˜can˜deduce˜Ó|-“(!x.“f[x])“=“TÖ.Ž¡‘êñëIf–ê¨either“of“the“results“are“ÓF“Öw¬re“can“deduce“that“Ó|-–¿ª(!x.“f[x])“=“FÖ.Ž¦‘öSzThe–7proSŽcedure“is“optimized“for“terms“with“more“than“t•¬rw“o–7v‘ÿXäariables“b¬ry“eliminating“someŽ¡‘êñëduplicated–šsubSŽcalls.‘*¶These“arise“if“haš¬rving“instan˜tiated“a“v‘ÿXäariable“the“t˜w˜o“new“form˜ulaeŽ¡‘êñësimplify–§to“the“same“term.‘"XThe“prošSŽcedure“is“also“optimized“for“cases“when“the“b˜o˜dy“sim-Ž¡‘êñëpli es–(to“true“or“false“bšSŽefore“all“the“v‘ÿXäariables“ha•¬rv“e–(b˜een“analysed.‘`Also,‘¡uthe“simpli cationŽ¡‘êñëfunction–ê¨is“optimized“to“a•¬rv“oid–ê¨rebuilding“subterms“that“are“not“c¬rhanged.Ž¦‘öSzExpSŽerimen•¬rts›žha“v“e˜b•SŽeen˜p“erformed˜with˜sp“ecial˜co“de˜for˜cases˜when˜the˜ rst˜argumen¬rtŽ¡‘êñëof–Üa“conjunction,–Þõdisjunction,“implication,“or–Üconditional“simpli es“to“a“v‘ÿXäalue“that“mak¬resŽ¡‘êñësimpli cation–Ü»of“certain“other“argumenš¬rts“unnecessary–ÿV.‘4|ŽŽŽ ”/ß ýŸžW‘ÇaŸà˜0‰ffÇ IŸ4vÌÍŸYœ„8ÏŸffŸÓ!‘ ËÓ|-–¿ª(!x1“...“xn.“f[x1,...,xn])“=“TŽ¤ ‘ Ë|-–¿ª!x1“...“xn.“f[x1,...,xn]Ž¡‘ Ë|-–¿ª!x2“...“xn.“f[x1,...,xn]Ž¡‘ Ë|-–¿ª(!x2“...“xn.“f[x1,...,xn])“=“TŽŽ’Æq°„8ÏŸffŽŽŸÀ‰ffÇ IŽŽŽ¤0#‰‘ÇaÖHo•¬rw“ev“er–ê¨when“the“fully“quanš¬rti ed“term“is“false,“w˜e“ha˜v˜e:ŽŸ0#Š‘ÇaŸà˜0‰ffÇ IŸ4vÌÍŸYœ„8ÏŸffŸÓ!‘ ËÓ|-–¿ª(!x1“...“xn.“f[x1,...,xn])“=“FŽ¤ ‘ Ë|-–¿ª~(!x1“...“xn.“f[x1,...,xn])Ž¡‘ Ë|-–¿ª?x1.“~(!x2“...“xn.“f[x1,...,xn])Ž¡‘ Ë|-–¿ª?x1.“((!x2“...“xn.“f[x1,...,xn])“=“F)ŽŽ’Æq°„8ÏŸffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖwhereas–ê¨wš¬re“w˜an˜t:Ž¤‘ÇaŸô0‰ffÇ IŸ vÌÍŸYœ„ÏŸffŸú!‘ ËÓ|-–¿ª!x1.“((!x2“...“xn.“f[x1,...,xn])“=“F)ŽŽ’Æq°„ÏŸffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖbSŽecause–ê¨it“is“equiv‘ÿXäalen¬rt“to:Ž¡‘ÇaŸô0‰ffÇ IŸ vÌÍŸYœ„ÏŸffŸú!‘ ËÓ|-–¿ª(!x2“...“xn.“f[x1,...,xn])“=“FŽŽ’Æq°„ÏŸffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖThe›ê¨con•¬rv“ersions˜in˜the˜ÓtautŽ‘ÓøÖlibrary˜are˜not˜capable˜of˜pro“ving˜this˜theorem.ŽŸ(V‘Çaç1.3Ž‘@ åUsing–Ÿ¼the“libraryŽŸâ#‘ÇaÖThe‘dÊÓtautŽ‘È<Ölibrary–dÊcan“bSŽe“loaded“in¬rto“a“user's“ó"Kñ`y ó3 cmr10ÍHOL“Ösession“using“the“function“Óload_libraryŽŽ¤‘ÇaÖ(see–Ó:the“ÍHOL“Öman¬rual“for“a“general“description“of“library“loading).‘1The“ rst“action“in“theŽ¡‘Çaload–^msequence“initiated“bš¬ry“Óload_libraryŽ‘K¸ÒÖis“to“upSŽdate“the“ÍHOL“Öhelp“searc˜h“path.‘ "The“helpŽ¡‘Çasearc¬rh–?°path“is“upSŽdated“with“a“pathname“to“online“help“ les“for“the“ÍML“Öfunctions“in“theŽ¡‘Çalibrary‘ÿV.‘ü¶After–+ïupSŽdating“the“help“searc¬rh“path,‘|ŽŽŽ ”/ߎŒ‹*’ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|Ÿ zNëHML– ‰‹F‘ýunctions“in“the“taut“LibraryŽŸÖx‰Ç>|Ÿ;ˆ†ÖThis–úcš¬rhapter“pro˜vides“doSŽcumen˜tation“on“all“the“ÍML“Öfunctions“that“are“made“a˜v‘ÿXäailable“inŽ¤ÍHOL–´PÖwhen“the“ÓtautŽ‘gHÖlibrary“is“loaded.‘&ÃThis“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“online“via“theŽ¡ÓhelpŽ‘éPÖfacilit¬ry‘ÿV.ŽŸ7fSŸ¹IŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍóIßêþÓ|-–¿ª(!x1“...“xn.“t)“=“TŽŸ ™š‘>þ|-–¿ª(!x1“...“xn.“t)“=“FŽŸ™•ÖThis›¡Æcon•¬rv“ersion˜also˜accepts˜propSŽositional˜terms˜that˜are˜not˜fully˜univ“ersally˜quan“ti ed.Ž¡Ho•¬rw“ev“er,–ê¨for“sucš¬rh“a“term,“the“con˜v˜ersion“will“only“succeed“if“the“term“is“v‘ÿXäalid.ŽŸ ÌÆâF‘þž¸ailureŽ¦ÖF‘ÿVails–¦˜if“the“term“is“not“of“the“form“Ó"!x1–¿ª...“xn.“f[x1,...,xn]"–¦˜Öwhere“Óf[x1,...,xn]“Öis“aŽ¡propSŽositional–úformš¬rula“(except“that“the“v‘ÿXäariables“do“not“ha˜v˜e“to“bSŽe“univ˜ersally“quan˜ti edŽ¡if–ê¨the“term“is“v‘ÿXäalid).ŽŽŸ$ý’óŸÛ5ŽŽŒ‹+ ÌU ýFÓŸú™š‘êñëÛ6’¯›EChapter–€2.‘ €ML“F‘þàunctions“in“the“taut“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ&¼R‘êñëÓ#PTAUT_CONV–¿ª"!x“y“z“w.“(((x“\/“~y)“==>“z)“/\“(z“==>“~w)“/\“w)“==>“y";;Ž¤ ™š‘êñë|-–¿ª(!x“y“z“w.“(x“\/“~y“==>“z)“/\“(z“==>“~w)“/\“w“==>“y)“=“TŽ©34‘êñë#PTAUT_CONV–¿ª"(((x“\/“~y)“==>“z)“/\“(z“==>“~w)“/\“w)“==>“y";;Ž¡‘êñë|-–¿ª(x“\/“~y“==>“z)“/\“(z“==>“~w)“/\“w“==>“y“=“TŽ¦‘êñë#PTAUT_CONV–¿ª"!x.“x“=“T";;Ž¡‘êñë|-–¿ª(!x.“x“=“T)“=“FŽ¦‘êñë#PTAUT_CONV–¿ª"x“=“T";;Ž¡‘êñëevaluation‘¿ªfailed‘¾RPTAUT_CONVŽŸ7ÃC‘êñëâSee‘…alsoŽŸ:%‘êñëÓPTAUT_PROVE,–¿ªPTAUT_TAC,“TAUT_CONV.ŽŸH†‡Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPTAUT_PROVEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸAÎ'‘êñëÓPTAUT_PROVE–¿ª:“convŽ¤&‚-‘êñëâSynopsisŽ© ‹‘êñëÖT‘ÿVautology›ê¨c•¬rhec“k“er.‘8àPro“v“es˜propSŽositional˜form“ulae.Ž¡‘êñëâDescriptionŽ¦‘êñëÖGivš¬ren–ãŒa“term“that“con˜tains“only“BoSŽolean“constan˜ts,‘!ÅBoSŽolean-v›ÿXäalued“v˜ariables,‘!ÅBoSŽoleanŽ¤‘êñëequalities,–Gimplications,“conjunctions,“disjunctions,“negations–4îand“BoSŽolean-v‘ÿXäalued“condi-Ž¡‘êñëtionals,‘bÓPTAUT_PROVE‘?«Öreturns–?×the“term“as“a“theorem“if“it“is“v›ÿXäalid.‘ÿðThe“v˜ariables“in“the“termŽ¡‘êñëmaš¬ry–ê¨bSŽe“univ˜ersally“quan˜ti ed.ŽŸ&‚-‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–ê¨if“the“term“is“not“a“v‘ÿXäalid“propSŽositional“form¬rula.ŽŽŽŒ‹1õ ÌU ýFÓŸú™š‘ÇaÒPT–þó\Aš¦tUT‘Ái‰ffÇŽ‘ˆ„T“A˜C’v qÛ7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ;m‘ÇaÓ#PTAUT_PROVE–¿ª"!x“y“z“w.“(((x“\/“~y)“==>“z)“/\“(z“==>“~w)“/\“w)“==>“y";;Ž¤ ™š‘Ça|-–¿ª!x“y“z“w.“(x“\/“~y“==>“z)“/\“(z“==>“~w)“/\“w“==>“yŽ©34‘Ça#PTAUT_PROVE–¿ª"(((x“\/“~y)“==>“z)“/\“(z“==>“~w)“/\“w)“==>“y";;Ž¡‘Ça|-–¿ª(x“\/“~y“==>“z)“/\“(z“==>“~w)“/\“w“==>“yŽ¦‘Ça#PTAUT_PROVE–¿ª"!x.“x“=“T";;Ž¡‘Çaevaluation‘¿ªfailed‘¾RPTAUT_PROVEŽ¦‘Ça#PTAUT_PROVE–¿ª"x“=“T";;Ž¡‘Çaevaluation‘¿ªfailed‘¾RPTAUT_PROVEŽŸ-Žþ‘ÇaâSee‘…alsoŽŸ†Ä‘ÇaÓPTAUT_CONV,–¿ªPTAUT_TAC,“TAUT_PROVE.ŽŸ4ûŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPTAUT_TACŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ5æ‘ÇaÓPTAUT_TAC–¿ª:“tacticŽ¤´©‘ÇaâSynopsisŽ©í*‘ÇaÖT‘ÿVautology›ê¨c•¬rhec“k“er.‘8àPro“v“es˜propSŽositional˜goals.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖGivš¬ren–›a“goal“with“a“conclusion“that“con˜tains“only“BoSŽolean“constan˜ts,‘?jBoSŽolean-v›ÿXäalued“v˜ari-Ž¤‘Çaables,–BoSŽolean›Ýequalities,“implications,“conjunctions,“disjunctions,“negations˜and˜BoSŽolean-Ž¡‘Çav›ÿXäalued–÷Áconditionals,‘ûthis“tactic“will“pro•¬rv“e–÷Áthe“goal“if“it“is“v˜alid.‘`+If“all“the“v˜ariables“in“theŽ¡‘Çaconclusion–ê¨are“univš¬rersally“quan˜ti ed,“this“tactic“will“also“reduce“an“in˜v‘ÿXäalid“goal“to“false.ŽŸ´©‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–6Lif“the“conclusion“of“the“goal“is“not“of“the“form“Ó"!x1–¿ª...“xn.“f[x1,...,xn]"‘6LÖwhereŽ¡‘ÇaÓf[x1,...,xn]–x*Öis“a“propSŽositional“formš¬rula“(except“that“the“v‘ÿXäariables“do“not“ha˜v˜e“to“bSŽeŽ¡‘Çauniv•¬rersally›ê¨quan“ti ed˜if˜the˜goal˜is˜v‘ÿXäalid).ŽŸ´©‘ÇaâSee‘…alsoŽŸ†Ä‘ÇaÓPTAUT_CONV,–¿ªPTAUT_PROVE,“TAUT_TAC.ŽŽŽŒ‹7† ÌU ýFÓŸú™š‘êñëÛ8’¯›EChapter–€2.‘ €ML“F‘þàunctions“in“the“taut“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëITAUT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ/†ê‘êñëÓTAUT_CONV–¿ª:“convŽ¤R‘êñëâSynopsisŽ©‘êñëÖT‘ÿVautology›ê¨c•¬rhec“k“er.‘8àPro“v“es˜instances˜of˜propSŽositional˜form“ulae.Ž¡‘êñëâDescriptionŽ¦‘êñëÖGivš¬ren–žan“instance“of“a“v‘ÿXäalid“propSŽositional“form˜ula,‘+œÓTAUT_CONV‘‘Öpro˜v˜es“the“instance“of“theŽ¤‘êñëform¬rula–­uto“bšSŽe“true.‘ HA‘­prop˜ositional“formš¬rula“is“a“term“con˜taining“only“BoSŽolean“con-Ž¡‘êñëstan¬rts,›;çBoSŽolean-v–ÿXäalued‘+§v“ariables,˜BoSŽolean‘+§equalities,˜implications,˜conjunctions,˜disjunc-Ž¡‘êñëtions,‘t†negations–Výand“BoSŽolean-v‘ÿXäalued“conditionals.‘§An“instance“of“a“formš¬rula“is“the“form˜ulaŽ¡‘êñëwith–¾one“or“more“of“the“v‘ÿXäariables“replaced“bš¬ry“terms“of“the“same“t˜ypSŽe.‘²ûThe“con˜v˜ersionŽ¡‘êñëaccepts–ê¨terms“with“or“without“univš¬rersal“quan˜ti ers“for“the“v‘ÿXäariables.ŽŸR‘êñëâF‘þž¸ailureŽ¦‘êñëÖF‘ÿVails–L§if“the“term“is“not“an“instance“of“a“propSŽositional“form¬rula“or“if“the“instance“is“not“aŽ¡‘êñëv‘ÿXäalid‘ê¨form¬rula.ŽŸR‘êñëâExampleŽŸ®‘êñëÓ#TAUT_CONVŽ¤ ™š‘êñë#–¿ª"!x“n“y.“((((n“=“1)“\/“~x)“==>“y)“/\“(y“==>“~(n“<“0))“/\“(n“<“0))“==>“x";;Ž¡‘êñë|-–¿ª(!x“n“y.“((n“=“1)“\/“~x“==>“y)“/\“(y“==>“~n“<“0)“/\“n“<“0“==>“x)“=“TŽ©34‘êñë#TAUT_CONV–¿ª"((((n“=“1)“\/“~x)“==>“y)“/\“(y“==>“~(n“<“0))“/\“(n“<“0))“==>“x";;Ž¡‘êñë|-–¿ª((n“=“1)“\/“~x“==>“y)“/\“(y“==>“~n“<“0)“/\“n“<“0“==>“x“=“TŽ¦‘êñë#TAUT_CONV–¿ª"!n.“(n“<“0)“\/“(n“=“0)";;Ž¡‘êñëevaluation‘¿ªfailed‘¾RTAUT_CONVŽŸ({‘êñëâSee‘…alsoŽŸ ¯‘êñëÓTAUT_PROVE,–¿ªTAUT_TAC,“PTAUT_CONV.ŽŸ)0÷Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëITAUT_PROVEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ/†ê‘êñëÓTAUT_PROVE–¿ª:“convŽŽŽŒ‹ >b ÌU ýFÓŸú™š‘ÇaÒT–þó\Aš¦tUT‘Ái‰ffÇŽ‘ˆ„T“A˜C’~¨Û9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâSynopsisŽ¤‘ÇaÖT‘ÿVautology›ê¨c•¬rhec“k“er.‘8àPro“v“es˜propSŽositional˜form“ulae˜(and˜instances˜of˜them).Ž©«¯‘ÇaâDescriptionŽ¡‘ÇaÖGivš¬ren–øöan“instance“of“a“v‘ÿXäalid“propSŽositional“form˜ula,‘<‰ÓTAUT_PROVE‘ø°Öreturns“the“instance“ofŽ¡‘Çathe– Ëformš¬rula“as“a“theorem.‘™JA‘ propSŽositional“form˜ula“is“a“term“con˜taining“only“BoSŽoleanŽ¡‘Çaconstan¬rts,›à{BoSŽolean-v–ÿXäalued‘¯Pv“ariables,˜BoSŽolean‘¯Pequalities,˜implications,˜conjunctions,˜dis-Ž¡‘Çajunctions,‘Oìnegations–xand“BoSŽolean-v‘ÿXäalued“conditionals.‘’QAn“instance“of“a“form¬rula“is“theŽ¡‘Çaformš¬rula–’Zwith“one“or“more“of“the“v‘ÿXäariables“replaced“b˜y“terms“of“the“same“t˜ypSŽe.‘ /öTheŽ¡‘Çacon•¬rv“ersion–ê¨accepts“terms“with“or“without“univš¬rersal“quan˜ti ers“for“the“v‘ÿXäariables.Ž¦‘ÇaâF‘þž¸ailureŽ¡‘ÇaÖF‘ÿVails–L§if“the“term“is“not“an“instance“of“a“propSŽositional“form¬rula“or“if“the“instance“is“not“aŽ¡‘Çav‘ÿXäalid‘ê¨form¬rula.Ž¦‘ÇaâExampleŽŸor‘ÇaÓ#TAUT_PROVEŽ¤ ™š‘Ça#–¿ª"!x“n“y.“((((n“=“1)“\/“~x)“==>“y)“/\“(y“==>“~(n“<“0))“/\“(n“<“0))“==>“x";;Ž¡‘Ça|-–¿ª!x“n“y.“((n“=“1)“\/“~x“==>“y)“/\“(y“==>“~n“<“0)“/\“n“<“0“==>“xŽ©34‘Ça#TAUT_PROVE–¿ª"((((n“=“1)“\/“~x)“==>“y)“/\“(y“==>“~(n“<“0))“/\“(n“<“0))“==>“x";;Ž¡‘Ça|-–¿ª((n“=“1)“\/“~x“==>“y)“/\“(y“==>“~n“<“0)“/\“n“<“0“==>“xŽ¦‘Ça#TAUT_PROVE–¿ª"!n.“(n“<“0)“\/“(n“=“0)";;Ž¡‘Çaevaluation‘¿ªfailed‘¾RTAUT_PROVEŽŸ'‡‘ÇaâSee‘…alsoŽ¡‘ÇaÓTAUT_CONV,–¿ªTAUT_TAC,“PTAUT_PROVE.ŽŸ(Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëITAUT_TACŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.Á¸‘ÇaÓTAUT_TAC–¿ª:“tacticŽ¤«¯‘ÇaâSynopsisŽ©‘ÇaÖT‘ÿVautology›ê¨c•¬rhec“k“er.‘8àPro“v“es˜propSŽositional˜goals˜(and˜instances˜of˜them).Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖGivš¬ren–Mwa“goal“that“is“an“instance“of“a“propSŽositional“form˜ula,‘¦+this“tactic“will“pro˜v˜e“theŽ¦‘Çagoal––proš¬rvided“it“is“v‘ÿXäalid.‘ ;A‘•¢propSŽositional“form˜ula“is“a“term“con˜taining“only“BoSŽoleanŽŽŽŒ‹ Eä ÌU ýFÓŸú™š‘êñëÛ10’¨ÛEChapter–€2.‘ €ML“F‘þàunctions“in“the“taut“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖconstan¬rts,›à{BoSŽolean-v–ÿXäalued‘¯Pv“ariables,˜BoSŽolean‘¯Pequalities,˜implications,˜conjunctions,˜dis-Ž¤‘êñëjunctions,‘Oìnegations–xand“BoSŽolean-v‘ÿXäalued“conditionals.‘’QAn“instance“of“a“form¬rula“is“theŽ¡‘êñëformš¬rula–Ÿ|with“one“or“more“of“the“v‘ÿXäariables“replaced“b˜y“terms“of“the“same“t˜ypSŽe.‘ÑThe“tacticŽ¡‘êñëaccepts–ê¨goals“with“or“without“univš¬rersal“quan˜ti ers“for“the“v‘ÿXäariables.Ž©‘êñëâF‘þž¸ailureŽ¡‘êñëÖF‘ÿVails–b%if“the“conclusion“of“the“goal“is“not“an“instance“of“a“propSŽositional“form¬rula“or“if“theŽ¡‘êñëinstance–ê¨is“not“a“v‘ÿXäalid“form¬rula.Ž¦‘êñëâSee‘…alsoŽŸ ™š‘êñëÓTAUT_CONV,–¿ªTAUT_PROVE,“PTAUT_TAC.ŽŽŽŒ‹ N3 ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸGëHReferencesŽŸ‰Ç>|Ÿ;‘ßüÖ[1]ŽŽ‘' ÍDSTO–ê¨Öand“ÍSRI“ÖIn¬rternational,“ó.›»ˆ@ cmti12ÙThe–35HOL“System:‘fiDESCRIPTIONÖ,‘ê¨(1991).ŽŽŸ$ý’烈Û11ŽŽŒ‹ Q ÌU ýFÓ ”/ß ýáä‘êñ럳¸ä‰Ç>|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘êñëÖcase‘ê¨analysisŽ¤‘þñëon–ê¨BoSŽolean“v‘ÿXäalues,“2Ž©‘êñëduplicated‘ê¨subSŽcallsŽ¡‘þñëelimination–ê¨of,“2Ž¦‘êñëhelpŽ¡‘þñëupSŽdating–ê¨searc¬rh“path,“3Ž¦‘êñëinstan¬rtiation–ê¨of“v‘ÿXäariablesŽ¡‘þñëwith–ê¨terms,“1Ž¡‘þñëwith–ê¨true“and“false,“2Ž¦‘êñëó1߆µT cmtt12Üload_libraryÖ,‘ê¨3Ž¦‘êñëoptimization,‘ê¨2Ž¦‘êñëÜPTAUT_CONVÖ,‘ê¨5Ž¡‘êñëÜPTAUT_PROVEÖ,‘ê¨6Ž¡‘êñëÜPTAUT_TACÖ,‘ê¨7Ž¦‘êñërebuilding‘ê¨termsŽ¡‘þñëa•¬rv“oiding–ê¨when“no“c¬rhange,“2Ž¦‘êñësimpli erŽ¡‘þñëfor–ê¨propSŽositional“form¬rulae,“2Ž¦‘êñëÜTAUT_CONVÖ,‘ê¨8Ž¡‘êñëÜTAUT_PROVEÖ,‘ê¨8Ž¡‘êñëÜTAUT_TACÖ,‘ê¨9ŽŽŽŽŽŽŸ$ý’ÇÑ)Û12ŽŽŒøR‚ƒ’À;èÌUÚÝ óIßê index.tex @echo "\mbox{}" >> index.tex @echo "\end{theindex}" >> index.tex tex: ids @echo "TeX files made" ids: @echo "\chapter{ML Functions in the taut Library}">entries.tex @echo "\input{entries-intro}" >> entries.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex index: ${MAKEINDEX} taut.idx index.tex taut: latex taut.tex all: make clean; make tex; make taut; make index; make taut hol88-2.02.19940316/Library/taut/Manual/index.aux0000640000212700021270000000107605535606273017367 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{Index}{12}} \global\@namedef{cp@index}{ \setcounter{page}{13} \setcounter{equation}{0} \setcounter{enumi}{1} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{2} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/taut/Manual/entries-intro.tex0000640000212700021270000000032005071601754021046 0ustar cammcammThis chapter provides documentation on all the \ML\ functions that are made available in \HOL\ when the \ml{taut} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/taut/Manual/entries.tex0000640000212700021270000001542005535606246017732 0ustar cammcamm\chapter{ML Functions in the taut Library} \input{entries-intro} \DOC{PTAUT\_CONV} \TYPE {\small\verb%PTAUT_CONV : conv%}\egroup \SYNOPSIS Tautology checker. Proves closed propositional formulae true or false. \DESCRIBE Given a term of the form {\small\verb%"!x1 ... xn. t"%} where {\small\verb%t%} contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, and all the variables in {\small\verb%t%} appear in {\small\verb%x1 ... xn%}, the conversion {\small\verb%PTAUT_CONV%} proves the term to be either true or false, that is, one of the following theorems is returned: {\par\samepage\setseps\small \begin{verbatim} |- (!x1 ... xn. t) = T |- (!x1 ... xn. t) = F \end{verbatim} } \noindent This conversion also accepts propositional terms that are not fully universally quantified. However, for such a term, the conversion will only succeed if the term is valid. \FAILURE Fails if the term is not of the form {\small\verb%"!x1 ... xn. f[x1,...,xn]"%} where {\small\verb%f[x1,...,xn]%} is a propositional formula (except that the variables do not have to be universally quantified if the term is valid). \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PTAUT_CONV "!x y z w. (((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- (!x y z w. (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y) = T #PTAUT_CONV "(((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y = T #PTAUT_CONV "!x. x = T";; |- (!x. x = T) = F #PTAUT_CONV "x = T";; evaluation failed PTAUT_CONV \end{verbatim} } \SEEALSO PTAUT_PROVE, PTAUT_TAC, TAUT_CONV. \ENDDOC \DOC{PTAUT\_PROVE} \TYPE {\small\verb%PTAUT_PROVE : conv%}\egroup \SYNOPSIS Tautology checker. Proves propositional formulae. \DESCRIBE Given a term that contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, {\small\verb%PTAUT_PROVE%} returns the term as a theorem if it is valid. The variables in the term may be universally quantified. \FAILURE Fails if the term is not a valid propositional formula. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PTAUT_PROVE "!x y z w. (((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- !x y z w. (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y #PTAUT_PROVE "(((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y #PTAUT_PROVE "!x. x = T";; evaluation failed PTAUT_PROVE #PTAUT_PROVE "x = T";; evaluation failed PTAUT_PROVE \end{verbatim} } \SEEALSO PTAUT_CONV, PTAUT_TAC, TAUT_PROVE. \ENDDOC \DOC{PTAUT\_TAC} \TYPE {\small\verb%PTAUT_TAC : tactic%}\egroup \SYNOPSIS Tautology checker. Proves propositional goals. \DESCRIBE Given a goal with a conclusion that contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, this tactic will prove the goal if it is valid. If all the variables in the conclusion are universally quantified, this tactic will also reduce an invalid goal to false. \FAILURE Fails if the conclusion of the goal is not of the form {\small\verb%"!x1 ... xn. f[x1,...,xn]"%} where {\small\verb%f[x1,...,xn]%} is a propositional formula (except that the variables do not have to be universally quantified if the goal is valid). \SEEALSO PTAUT_CONV, PTAUT_PROVE, TAUT_TAC. \ENDDOC \DOC{TAUT\_CONV} \TYPE {\small\verb%TAUT_CONV : conv%}\egroup \SYNOPSIS Tautology checker. Proves instances of propositional formulae. \DESCRIBE Given an instance of a valid propositional formula, {\small\verb%TAUT_CONV%} proves the instance of the formula to be true. A propositional formula is a term containing only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals. An instance of a formula is the formula with one or more of the variables replaced by terms of the same type. The conversion accepts terms with or without universal quantifiers for the variables. \FAILURE Fails if the term is not an instance of a propositional formula or if the instance is not a valid formula. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #TAUT_CONV # "!x n y. ((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- (!x n y. ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x) = T #TAUT_CONV "((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x = T #TAUT_CONV "!n. (n < 0) \/ (n = 0)";; evaluation failed TAUT_CONV \end{verbatim} } \SEEALSO TAUT_PROVE, TAUT_TAC, PTAUT_CONV. \ENDDOC \DOC{TAUT\_PROVE} \TYPE {\small\verb%TAUT_PROVE : conv%}\egroup \SYNOPSIS Tautology checker. Proves propositional formulae (and instances of them). \DESCRIBE Given an instance of a valid propositional formula, {\small\verb%TAUT_PROVE%} returns the instance of the formula as a theorem. A propositional formula is a term containing only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals. An instance of a formula is the formula with one or more of the variables replaced by terms of the same type. The conversion accepts terms with or without universal quantifiers for the variables. \FAILURE Fails if the term is not an instance of a propositional formula or if the instance is not a valid formula. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #TAUT_PROVE # "!x n y. ((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- !x n y. ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x #TAUT_PROVE "((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x #TAUT_PROVE "!n. (n < 0) \/ (n = 0)";; evaluation failed TAUT_PROVE \end{verbatim} } \SEEALSO TAUT_CONV, TAUT_TAC, PTAUT_PROVE. \ENDDOC \DOC{TAUT\_TAC} \TYPE {\small\verb%TAUT_TAC : tactic%}\egroup \SYNOPSIS Tautology checker. Proves propositional goals (and instances of them). \DESCRIBE Given a goal that is an instance of a propositional formula, this tactic will prove the goal provided it is valid. A propositional formula is a term containing only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals. An instance of a formula is the formula with one or more of the variables replaced by terms of the same type. The tactic accepts goals with or without universal quantifiers for the variables. \FAILURE Fails if the conclusion of the goal is not an instance of a propositional formula or if the instance is not a valid formula. \SEEALSO TAUT_CONV, TAUT_PROVE, PTAUT_TAC. \ENDDOC hol88-2.02.19940316/Library/taut/Manual/index.tex0000640000212700021270000000144105535606263017365 0ustar cammcamm\begin{theindex} \item case analysis \subitem on Boolean values, 2 \indexspace \item duplicated subcalls \subitem elimination of, 2 \indexspace \item help \subitem updating search path, 3 \indexspace \item instantiation of variables \subitem with terms, 1 \subitem with true and false, 2 \indexspace \item {\ptt load\_library}, 3 \indexspace \item optimization, 2 \indexspace \item {\ptt PTAUT\_CONV}, 5 \item {\ptt PTAUT\_PROVE}, 6 \item {\ptt PTAUT\_TAC}, 7 \indexspace \item rebuilding terms \subitem avoiding when no change, 2 \indexspace \item simplifier \subitem for propositional formulae, 2 \indexspace \item {\ptt TAUT\_CONV}, 8 \item {\ptt TAUT\_PROVE}, 8 \item {\ptt TAUT\_TAC}, 9 \end{theindex} hol88-2.02.19940316/Library/taut/Manual/references.tex0000640000212700021270000000025305071601755020373 0ustar cammcamm\begin{thebibliography}{99} \bibitem{description} % OK {\small DSTO} and {\small SRI} International, {\it The HOL System: DESCRIPTION}, (1991). \end{thebibliography} hol88-2.02.19940316/Library/taut/Manual/title.tex0000640000212700021270000000353205071601757017400 0ustar cammcamm% ===================================================================== % % Standard titlepage for taut library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL taut Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf R.\ J.\ Boulton \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf July 1991 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ R.\ J.\ Boulton 1991 \end{center} \newpage hol88-2.02.19940316/Library/taut/help/0000750000212700021270000000000005227250234015235 5ustar cammcammhol88-2.02.19940316/Library/taut/help/entries/0000750000212700021270000000000005227270303016705 5ustar cammcammhol88-2.02.19940316/Library/taut/help/entries/PTAUT_CONV.doc0000640000212700021270000000260005071602060021111 0ustar cammcamm\DOC PTAUT_CONV \TYPE {PTAUT_CONV : conv} \SYNOPSIS Tautology checker. Proves closed propositional formulae true or false. \LIBRARY taut \DESCRIBE Given a term of the form {"!x1 ... xn. t"} where {t} contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, and all the variables in {t} appear in {x1 ... xn}, the conversion {PTAUT_CONV} proves the term to be either true or false, that is, one of the following theorems is returned: { |- (!x1 ... xn. t) = T |- (!x1 ... xn. t) = F } \noindent This conversion also accepts propositional terms that are not fully universally quantified. However, for such a term, the conversion will only succeed if the term is valid. \FAILURE Fails if the term is not of the form {"!x1 ... xn. f[x1,...,xn]"} where {f[x1,...,xn]} is a propositional formula (except that the variables do not have to be universally quantified if the term is valid). \EXAMPLE { #PTAUT_CONV "!x y z w. (((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- (!x y z w. (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y) = T #PTAUT_CONV "(((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y = T #PTAUT_CONV "!x. x = T";; |- (!x. x = T) = F #PTAUT_CONV "x = T";; evaluation failed PTAUT_CONV } \SEEALSO PTAUT_PROVE, PTAUT_TAC, TAUT_CONV. \ENDDOC hol88-2.02.19940316/Library/taut/help/entries/PTAUT_PROVE.doc0000640000212700021270000000162505071602060021245 0ustar cammcamm\DOC PTAUT_PROVE \TYPE {PTAUT_PROVE : conv} \SYNOPSIS Tautology checker. Proves propositional formulae. \LIBRARY taut \DESCRIBE Given a term that contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, {PTAUT_PROVE} returns the term as a theorem if it is valid. The variables in the term may be universally quantified. \FAILURE Fails if the term is not a valid propositional formula. \EXAMPLE { #PTAUT_PROVE "!x y z w. (((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- !x y z w. (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y #PTAUT_PROVE "(((x \/ ~y) ==> z) /\ (z ==> ~w) /\ w) ==> y";; |- (x \/ ~y ==> z) /\ (z ==> ~w) /\ w ==> y #PTAUT_PROVE "!x. x = T";; evaluation failed PTAUT_PROVE #PTAUT_PROVE "x = T";; evaluation failed PTAUT_PROVE } \SEEALSO PTAUT_CONV, PTAUT_TAC, TAUT_PROVE. \ENDDOC hol88-2.02.19940316/Library/taut/help/entries/PTAUT_TAC.doc0000640000212700021270000000142005071602061020753 0ustar cammcamm\DOC PTAUT_TAC \TYPE {PTAUT_TAC : tactic} \SYNOPSIS Tautology checker. Proves propositional goals. \LIBRARY taut \DESCRIBE Given a goal with a conclusion that contains only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals, this tactic will prove the goal if it is valid. If all the variables in the conclusion are universally quantified, this tactic will also reduce an invalid goal to false. \FAILURE Fails if the conclusion of the goal is not of the form {"!x1 ... xn. f[x1,...,xn]"} where {f[x1,...,xn]} is a propositional formula (except that the variables do not have to be universally quantified if the goal is valid). \SEEALSO PTAUT_CONV, PTAUT_PROVE, TAUT_TAC. \ENDDOC hol88-2.02.19940316/Library/taut/help/entries/TAUT_CONV.doc0000640000212700021270000000226305071602061020777 0ustar cammcamm\DOC TAUT_CONV \TYPE {TAUT_CONV : conv} \SYNOPSIS Tautology checker. Proves instances of propositional formulae. \LIBRARY taut \DESCRIBE Given an instance of a valid propositional formula, {TAUT_CONV} proves the instance of the formula to be true. A propositional formula is a term containing only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals. An instance of a formula is the formula with one or more of the variables replaced by terms of the same type. The conversion accepts terms with or without universal quantifiers for the variables. \FAILURE Fails if the term is not an instance of a propositional formula or if the instance is not a valid formula. \EXAMPLE { #TAUT_CONV # "!x n y. ((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- (!x n y. ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x) = T #TAUT_CONV "((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x = T #TAUT_CONV "!n. (n < 0) \/ (n = 0)";; evaluation failed TAUT_CONV } \SEEALSO TAUT_PROVE, TAUT_TAC, PTAUT_CONV. \ENDDOC hol88-2.02.19940316/Library/taut/help/entries/TAUT_PROVE.doc0000640000212700021270000000227605071602061021131 0ustar cammcamm\DOC TAUT_PROVE \TYPE {TAUT_PROVE : conv} \SYNOPSIS Tautology checker. Proves propositional formulae (and instances of them). \LIBRARY taut \DESCRIBE Given an instance of a valid propositional formula, {TAUT_PROVE} returns the instance of the formula as a theorem. A propositional formula is a term containing only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals. An instance of a formula is the formula with one or more of the variables replaced by terms of the same type. The conversion accepts terms with or without universal quantifiers for the variables. \FAILURE Fails if the term is not an instance of a propositional formula or if the instance is not a valid formula. \EXAMPLE { #TAUT_PROVE # "!x n y. ((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- !x n y. ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x #TAUT_PROVE "((((n = 1) \/ ~x) ==> y) /\ (y ==> ~(n < 0)) /\ (n < 0)) ==> x";; |- ((n = 1) \/ ~x ==> y) /\ (y ==> ~n < 0) /\ n < 0 ==> x #TAUT_PROVE "!n. (n < 0) \/ (n = 0)";; evaluation failed TAUT_PROVE } \SEEALSO TAUT_CONV, TAUT_TAC, PTAUT_PROVE. \ENDDOC hol88-2.02.19940316/Library/taut/help/entries/TAUT_TAC.doc0000640000212700021270000000151405071602061020637 0ustar cammcamm\DOC TAUT_TAC \TYPE {TAUT_TAC : tactic} \SYNOPSIS Tautology checker. Proves propositional goals (and instances of them). \LIBRARY taut \DESCRIBE Given a goal that is an instance of a propositional formula, this tactic will prove the goal provided it is valid. A propositional formula is a term containing only Boolean constants, Boolean-valued variables, Boolean equalities, implications, conjunctions, disjunctions, negations and Boolean-valued conditionals. An instance of a formula is the formula with one or more of the variables replaced by terms of the same type. The tactic accepts goals with or without universal quantifiers for the variables. \FAILURE Fails if the conclusion of the goal is not an instance of a propositional formula or if the instance is not a valid formula. \SEEALSO TAUT_CONV, TAUT_PROVE, PTAUT_TAC. \ENDDOC hol88-2.02.19940316/Library/taut/Makefile0000640000212700021270000000305005071601636015747 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: taut # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f taut_check_ml.o taut_check_ml.l @echo "===> library taut: all object code deleted" clobber: rm -f taut_check_ml.o taut_check_ml.l @echo "===> library taut: all object code deleted" # ===================================================================== # Entries for individual files. # ===================================================================== taut_check_ml.o: taut_check.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `taut_check`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: taut_check_ml.o @echo "===> library taut rebuilt" hol88-2.02.19940316/Library/taut/READ-ME0000640000212700021270000001001105071601636015237 0ustar cammcamm+ ===================================================================== + | | | LIBRARY : taut | | | | DESCRIPTION : A tautology checker. | | | | AUTHOR : R.J.Boulton | | DATE : 9th July 1991 | | | + ===================================================================== + + --------------------------------------------------------------------- + | | | FILES: | | | + --------------------------------------------------------------------- + taut_check.ml contains the tautology checker functions + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clean" 3) type "make all" + --------------------------------------------------------------------- + | | | DOCUMENTATION: | | | + --------------------------------------------------------------------- + Tautology checking by Boolean case analysis. Method suggested by Tom Melham. Simplification done after each variable instantiation. Optimised for terms with more than two variables by eliminating some duplicated sub-calls. Optimised for cases when the body simplifies to true or false before all the variables have been analysed. Simplification optimised to avoid rebuilding subterms that are not changed. Experiments have been performed with special code for cases when the first argument of AND, OR, IMP and COND simplifies to a value that makes simplification of certain other arguments unnecessary. The results suggested that in general slightly fewer intermediate theorems are generated, but that due to the overhead of testing, the execution times are slightly longer. PTAUT_CONV : conv Given a propositional term with all variables universally quantified, e.g. "!x1 ... xn. f[x1,...,xn]", this conversion proves the term to be either true or false, i.e. it returns one of: |- (!x1 ... xn. f[x1,...,xn]) = T |- (!x1 ... xn. f[x1,...,xn]) = F This conversion also accepts propositional terms that are not fully universally quantified. However, for such a term, the conversion will fail if it is not true. Consider the term "!x2 ... xn. f[x1,...,xn]". The conversion first proves one of: |- (!x1 ... xn. f[x1,...,xn]) = T |- (!x1 ... xn. f[x1,...,xn]) = F The former can be manipulated as follows: |- (!x1 ... xn. f[x1,...,xn]) = T |- !x1 ... xn. f[x1,...,xn] |- !x2 ... xn. f[x1,...,xn] |- (!x2 ... xn. f[x1,...,xn]) = T However when the fully quantified term is false, we have: |- (!x1 ... xn. f[x1,...,xn]) = F |- ~(!x1 ... xn. f[x1,...,xn]) |- ?x1. ~(!x2 ... xn. f[x1,...,xn]) |- ?x1. ((!x2 ... xn. f[x1,...,xn]) = F) whereas we want: |- !x1. ((!x2 ... xn. f[x1,...,xn]) = F) i.e. |- (!x2 ... xn. f[x1,...,xn]) = F The conversions given here are not capable of proving the latter theorem since it is not purely propositional. PTAUT_TAC : tactic Tactic for solving propositional terms. If the current goal is a tautology then PTAUT_TAC will prove it. PTAUT_PROVE : conv Given a propositional term "t", this conversion returns the theorem |- t if "t" is a tautology. Otherwise it fails. TAUT_CONV : conv Given a term, "t", that is a valid propositional formula or valid instance of a propositional formula, this conversion returns the theorem |- t = T. The variables in "t" do not have to be universally quantified. Example: TAUT_CONV "!x n y z. x \/ ~(n < 0) \/ y \/ z \/ (n < 0)" ---> |- (!x n y z. x \/ ~n < 0 \/ y \/ z \/ n < 0) = T TAUT_TAC : tactic Tactic for solving propositional formulae and instances of propositional formulae. TAUT_PROVE : conv Given a valid propositional formula, or a valid instance of a propositional formula, "t", this conversion returns the theorem |- t. hol88-2.02.19940316/Library/taut/taut.ml0000640000212700021270000000176505071601637015632 0ustar cammcamm% ===================================================================== % % FILE : taut.ml % % DESCRIPTION : loads the library "taut" into hol. % % % % AUTHOR : R.J.Boulton % % DATE : 9th July 1991 % % ===================================================================== % % --------------------------------------------------------------------- % % Add the taut help files to online help. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/taut/help/entries/` in print_string `Updating help search path`; print_newline(); set_help_search_path (union [path] (help_search_path()));; % --------------------------------------------------------------------- % % Load the compiled code into ml. % % --------------------------------------------------------------------- % let path st = library_pathname() ^ `/taut/` ^ st in load(path `taut_check`, get_flag_value `print_lib`);; hol88-2.02.19940316/Library/taut/taut_check.ml0000640000212700021270000010403305071601637016757 0ustar cammcamm%****************************************************************************% % FILE : taut_check.ml % % DESCRIPTION : Tautology checking by Boolean case analysis. % % % % Method suggested by Tom Melham. % % % % Simplification done after each variable instantiation. % % % % Optimised for terms with more than two variables by % % eliminating some duplicated sub-calls. % % % % Optimised for cases when the body simplifies to true or % % false before all the variables have been analysed. % % % % Simplification optimised to avoid rebuilding subterms that % % are not changed. % % % % Experiments have been performed with special code for % % cases when the first argument of AND, OR, IMP and COND % % simplifies to a value that makes simplification of certain % % other arguments unnecessary. The results suggested that in % % general slightly fewer intermediate theorems are % % generated, but that due to the overhead of testing, the % % execution times are slightly longer. % % % % READS FILES : % % WRITES FILES : % % % % AUTHOR : R.J.Boulton % % DATE : 9th July 1991 % % % % LAST MODIFIED : R.J.Boulton % % DATE : 24th September 1991 % %****************************************************************************% begin_section taut_check;; %============================================================================% % Discriminator functions for T (true) and F (false) % %============================================================================% let is_T = let T = "T" in \tm. tm = T and is_F = let F = "F" in \tm. tm = F;; %============================================================================% % Theorems used for Boolean case analysis % %============================================================================% %----------------------------------------------------------------------------% % BOOL_CASES_T_F = |- !f. (f T = F) ==> ((!x. f x) = F) % %----------------------------------------------------------------------------% let BOOL_CASES_T_F = prove ("!f. (f T = F) ==> ((!x. f x) = F)", REPEAT STRIP_TAC THEN REWRITE_TAC [] THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC "T" THEN ASM_REWRITE_TAC []);; %----------------------------------------------------------------------------% % BOOL_CASES_F_F = |- !f. (f F = F) ==> ((!x. f x) = F) % %----------------------------------------------------------------------------% let BOOL_CASES_F_F = prove ("!f. (f F = F) ==> ((!x. f x) = F)", REPEAT STRIP_TAC THEN REWRITE_TAC [] THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC "F" THEN ASM_REWRITE_TAC []);; %============================================================================% % Conversions for doing Boolean case analysis % %============================================================================% %----------------------------------------------------------------------------% % BOOL_CASES_BOTH_T_RULE : (thm # thm) -> conv % % % % BOOL_CASES_BOTH_T_RULE (|- f[T] = T, |- f[F] = T) "!x. f[x]" returns the % % theorem |- (!x. f[x]) = T. % %----------------------------------------------------------------------------% let BOOL_CASES_BOTH_T_RULE (thT,thF) tm = (let (x,body) = dest_forall tm in let cases_thm = SPEC x BOOL_CASES_AX in let thT' = TRANS (SUBST_CONV [ASSUME (mk_eq(x,"T")),x] body body) thT and thF' = TRANS (SUBST_CONV [ASSUME (mk_eq(x,"F")),x] body body) thF in let th = DISJ_CASES cases_thm thT' thF' in (EQT_INTRO o (GEN x) o EQT_ELIM) th ) ? failwith `BOOL_CASES_BOTH_T_RULE`;; %----------------------------------------------------------------------------% % BOOL_CASES_T_F_RULE : thm -> conv % % % % BOOL_CASES_T_F_RULE (|- f[T] = F) "!x. f[x]" returns the theorem % % |- (!x. f[x]) = F. % %----------------------------------------------------------------------------% let BOOL_CASES_T_F_RULE thT tm = (let (x,body) = dest_forall tm in let f = mk_abs (x,body) in let thT' = TRANS (BETA_CONV (mk_comb(f,"T"))) thT and th = AP_TERM "$!:(bool -> bool) -> bool" (ABS x (BETA_CONV (mk_comb(f,x)))) in let th1 = SPEC f BOOL_CASES_T_F in let th2 = MP th1 thT' in (SYM th) TRANS th2 ) ? failwith `BOOL_CASES_T_F_RULE`;; %----------------------------------------------------------------------------% % BOOL_CASES_F_F_RULE : thm -> conv % % % % BOOL_CASES_F_F_RULE (|- f[F] = F) "!x. f[x]" returns the theorem % % |- (!x. f[x]) = F. % %----------------------------------------------------------------------------% let BOOL_CASES_F_F_RULE thF tm = (let (x,body) = dest_forall tm in let f = mk_abs (x,body) in let thF' = TRANS (BETA_CONV (mk_comb(f,"F"))) thF and th = AP_TERM "$!:(bool -> bool) -> bool" (ABS x (BETA_CONV (mk_comb(f,x)))) in let th1 = SPEC f BOOL_CASES_F_F in let th2 = MP th1 thF' in (SYM th) TRANS th2 ) ? failwith `BOOL_CASES_F_F_RULE`;; %============================================================================% % Conversions that use failure to indicate that they have not changed their % % input term, and hence save the term from being rebuilt unnecessarily. % %============================================================================% %----------------------------------------------------------------------------% % Failure string indicating that a term has not been changed by the % % conversion applied to it. % %----------------------------------------------------------------------------% let qconv = `QCONV`;; %----------------------------------------------------------------------------% % QCONV : conv -> conv % % % % Takes a conversion that uses failure to indicate that it has not changed % % its argument term, and produces an ordinary conversion. % %----------------------------------------------------------------------------% let QCONV conv tm = (conv tm) ??[qconv](REFL tm);; %----------------------------------------------------------------------------% % ALL_QCONV : conv % % % % Identity conversion for conversions using failure. % %----------------------------------------------------------------------------% let ALL_QCONV:conv = \tm. failwith qconv;; %----------------------------------------------------------------------------% % THENQC : conv -> conv -> conv % % % % Takes two conversions that use failure and produces a conversion that % % applies them in succession. The new conversion also uses failure. It fails % % if neither of the two argument conversions cause a change. % %----------------------------------------------------------------------------% let THENQC conv1 conv2 tm = (let th1 = conv1 tm in ((th1 TRANS (conv2 (rhs (concl th1)))) ??[qconv] th1)) ??[qconv] (conv2 tm);; %----------------------------------------------------------------------------% % ORELSEQC : conv -> conv -> conv % % % % Takes two conversions that use failure and produces a conversion that % % tries the first one, and if this fails for a reason other than that the % % term is unchanged, it tries the second one. % %----------------------------------------------------------------------------% let ORELSEQC (conv1:conv) conv2 tm = (conv1 tm) ?\s if (s = qconv) then (failwith qconv) else (conv2 tm);; %----------------------------------------------------------------------------% % TRY_QCONV : conv -> conv % % % % Applies a conversion, and if it fails, raises a `qconv' failure indicating % % that the term is unchanged. % %----------------------------------------------------------------------------% let TRY_QCONV conv = ORELSEQC conv ALL_QCONV;; %----------------------------------------------------------------------------% % RAND_QCONV : conv -> conv % % % % Applies a conversion to the rand of a term, propagating any failure that % % indicates that the subterm is unchanged. % %----------------------------------------------------------------------------% let RAND_QCONV conv tm = let (rator,rand) = dest_comb tm ? failwith `RAND_QCONV` in AP_TERM rator (conv rand);; %----------------------------------------------------------------------------% % RATOR_QCONV : conv -> conv % % % % Applies a conversion to the rator of a term, propagating any failure that % % indicates that the subterm is unchanged. % %----------------------------------------------------------------------------% let RATOR_QCONV conv tm = let (rator,rand) = dest_comb tm ? failwith `RATOR_QCONV` in AP_THM (conv rator) rand;; %----------------------------------------------------------------------------% % ABS_QCONV : conv -> conv % % % % Applies a conversion to the body of an abstraction, propagating any % % failure that indicates that the subterm is unchanged. % %----------------------------------------------------------------------------% let ABS_QCONV conv tm = let (bv,body) = dest_abs tm ? failwith `ABS_QCONV` in let bodyth = conv body in ABS bv bodyth ? failwith `ABS_QCONV`;; %============================================================================% % Theorems used for simplifying Boolean terms % %============================================================================% %----------------------------------------------------------------------------% % T_REFL = |- T = T % % F_REFL = |- F = F % %----------------------------------------------------------------------------% let T_REFL = REFL "T" and F_REFL = REFL "F";; %============================================================================% % Conversions used for simplifying Boolean terms % %============================================================================% %----------------------------------------------------------------------------% % NOT_CONV : conv % % % % |- !t. ~~t = t % % |- ~T = F % % |- ~F = T % %----------------------------------------------------------------------------% let NOT_CONV = let [th1;th2;th3] = CONJUNCTS NOT_CLAUSES in \tm. (let arg = dest_neg tm in if (is_T arg) then th2 if (is_F arg) then th3 else SPEC (dest_neg arg) th1 ) ? failwith `NOT_CONV`;; %----------------------------------------------------------------------------% % EQ_CONV : conv % % % % |- (t = t) = T % % |- (T = t) = t % % |- (t = T) = t % % |- (F = t) = ~t % % |- (t = F) = ~t % %----------------------------------------------------------------------------% let EQ_CONV = let th1 = INST_TYPE [":bool",":*"] REFL_CLAUSE and [th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL EQ_CLAUSES)) in \tm. (let (arg1,arg2) = dest_eq tm in if (is_T arg1) then SPEC arg2 th2 if (is_T arg2) then SPEC arg1 th3 if (is_F arg1) then SPEC arg2 th4 if (is_F arg2) then SPEC arg1 th5 if (arg1 = arg2) then SPEC arg1 th1 else fail ) ? failwith `EQ_CONV`;; %----------------------------------------------------------------------------% % EQ_THEN_NOT_CONV : conv % % % % Behaves as for EQ_CONV, then if EQ_CONV generated a top level negation, it % % tries to apply NOT_CONV. % %----------------------------------------------------------------------------% let EQ_THEN_NOT_CONV tm = if ((is_F (rand (rator tm))) or (is_F (rand tm))) then (EQ_CONV THENC (TRY_CONV NOT_CONV)) tm else EQ_CONV tm;; %----------------------------------------------------------------------------% % AND_CONV : conv % % % % |- T /\ t = t % % |- t /\ T = t % % |- F /\ t = F % % |- t /\ F = F % % |- t /\ t = t % %----------------------------------------------------------------------------% let AND_CONV = let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) in \tm. (let (arg1,arg2) = dest_conj tm in if (is_T arg1) then SPEC arg2 th1 if (is_T arg2) then SPEC arg1 th2 if (is_F arg1) then SPEC arg2 th3 if (is_F arg2) then SPEC arg1 th4 if (arg1 = arg2) then SPEC arg1 th5 else fail ) ? failwith `AND_CONV`;; %----------------------------------------------------------------------------% % OR_CONV : conv % % % % |- T \/ t = T % % |- t \/ T = T % % |- F \/ t = t % % |- t \/ F = t % % |- t \/ t = t % %----------------------------------------------------------------------------% let OR_CONV = let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL OR_CLAUSES)) in \tm. (let (arg1,arg2) = dest_disj tm in if (is_T arg1) then SPEC arg2 th1 if (is_T arg2) then SPEC arg1 th2 if (is_F arg1) then SPEC arg2 th3 if (is_F arg2) then SPEC arg1 th4 if (arg1 = arg2) then SPEC arg1 th5 else fail ) ? failwith `OR_CONV`;; %----------------------------------------------------------------------------% % IMP_CONV : conv % % % % |- T ==> t = t % % |- t ==> T = T % % |- F ==> t = T % % |- t ==> t = T % % |- t ==> F = ~t % %----------------------------------------------------------------------------% let IMP_CONV = let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL IMP_CLAUSES)) in \tm. (let (arg1,arg2) = dest_imp tm in if (is_neg tm) then fail if (is_T arg1) then SPEC arg2 th1 if (is_T arg2) then SPEC arg1 th2 if (is_F arg1) then SPEC arg2 th3 if (is_F arg2) then SPEC arg1 th5 if (arg1 = arg2) then SPEC arg1 th4 else fail ) ? failwith `IMP_CONV`;; %----------------------------------------------------------------------------% % IMP_THEN_NOT_CONV : conv % % % % Behaves as for IMP_CONV, then if IMP_CONV generated a top level negation, % % it tries to apply NOT_CONV. % %----------------------------------------------------------------------------% let IMP_THEN_NOT_CONV tm = if (is_F (rand tm)) then (IMP_CONV THENC (TRY_CONV NOT_CONV)) tm else IMP_CONV tm;; %----------------------------------------------------------------------------% % IF_CONV : conv % % % % |- (T => t1 | t2) = t1 % % |- (F => t1 | t2) = t2 % %----------------------------------------------------------------------------% let IF_CONV = let [th1;th2] = map GEN_ALL (CONJUNCTS (SPEC_ALL (INST_TYPE [(":bool",":*")] COND_CLAUSES))) in \tm. (let (arg1,arg2,arg3) = dest_cond tm in if (is_T arg1) then SPECL [arg2;arg3] th1 if (is_F arg1) then SPECL [arg2;arg3] th2 else fail ) ? failwith `IF_CONV`;; %----------------------------------------------------------------------------% % SIMP_PROP_QCONV : conv % % % % Conversion for simplifying propositional terms containing constants, % % variables, equality, implication, AND, OR, NOT and conditionals. % % Uses failure to avoid rebuilding unchanged subterms. % %----------------------------------------------------------------------------% letrec SIMP_PROP_QCONV tm = let ARGS_QCONV tm = let (op,[arg1;arg2]) = strip_comb tm in (let th1 = SIMP_PROP_QCONV arg1 in let th = AP_TERM op th1 in (MK_COMB (th,SIMP_PROP_QCONV arg2)) ??[qconv](AP_THM th arg2)) ??[qconv](let th2 = SIMP_PROP_QCONV arg2 in AP_TERM (rator tm) th2) in (if ((is_const tm) or (is_var tm)) then ALL_QCONV tm if (is_neg tm) then (THENQC (RAND_QCONV SIMP_PROP_QCONV) (TRY_QCONV NOT_CONV)) tm if (is_eq tm) then (THENQC ARGS_QCONV (TRY_QCONV EQ_THEN_NOT_CONV)) tm if (is_conj tm) then (THENQC ARGS_QCONV (TRY_QCONV AND_CONV)) tm if (is_disj tm) then (THENQC ARGS_QCONV (TRY_QCONV OR_CONV)) tm if (is_imp tm) then (THENQC ARGS_QCONV (TRY_QCONV IMP_THEN_NOT_CONV)) tm if (is_cond tm) then (THENQC (THENQC (RATOR_QCONV (THENQC (RATOR_QCONV (RAND_QCONV SIMP_PROP_QCONV)) (RAND_QCONV SIMP_PROP_QCONV))) (RAND_QCONV SIMP_PROP_QCONV)) (TRY_QCONV IF_CONV)) tm else failwith `SIMP_PROP_QCONV` );; %============================================================================% % Tautology checking % %============================================================================% %----------------------------------------------------------------------------% % DEPTH_FORALL_QCONV : conv -> conv % % % % Auxiliary function for applying a conversion inside universal % % quantifications. % % Uses failure to avoid rebuilding unchanged subterms. % %----------------------------------------------------------------------------% letrec DEPTH_FORALL_QCONV conv tm = if (is_forall tm) then RAND_QCONV (ABS_QCONV (DEPTH_FORALL_QCONV conv)) tm else conv tm;; %----------------------------------------------------------------------------% % FORALL_T : term list -> thm % % % % Given a list of variables ["x1";...;"xn"] (allowed to be empty), this % % function returns the theorem |- (!x1 ... xn. T) = T. % %----------------------------------------------------------------------------% let FORALL_T vars = (if (null vars) then T_REFL else EQT_INTRO (GENL vars TRUTH) ) ? failwith `FORALL_T`;; %----------------------------------------------------------------------------% % FORALL_F : term list -> thm % % % % Given a list of variables ["x1";...;"xn"] (allowed to be empty), this % % function returns the theorem |- (!x1 ... xn. F) = F. % %----------------------------------------------------------------------------% let FORALL_F = let forall_simp = SPEC "F" (INST_TYPE [":bool",":*"] FORALL_SIMP) in letrec FORALL_F' vars = (if (null vars) then F_REFL else (FORALL_EQ (hd vars) (FORALL_F' (tl vars))) TRANS forall_simp ) ? failwith `FORALL_F` in FORALL_F';; %----------------------------------------------------------------------------% % TAUT_CHECK_CONV : conv % % % % Given a propositional term with all variables universally quantified, % % e.g. "!x1 ... xn. f[x1,...,xn]", this conversion proves the term to be % % either true or false, i.e. it returns one of: % % % % |- (!x1 ... xn. f[x1,...,xn]) = T % % |- (!x1 ... xn. f[x1,...,xn]) = F % %----------------------------------------------------------------------------% letrec TAUT_CHECK_CONV tm = (let (vars,tm') = strip_forall tm in if (is_T tm') then FORALL_T vars if (is_F tm') then FORALL_F vars else let (var,body) = dest_forall tm in let tmT = subst ["T",var] body in let thT1 = QCONV (DEPTH_FORALL_QCONV SIMP_PROP_QCONV) tmT in let tmT' = rhs (concl thT1) in let thT2 = TAUT_CHECK_CONV tmT' in let thT3 = thT1 TRANS thT2 in if (is_F (rhs (concl thT3))) then BOOL_CASES_T_F_RULE thT3 tm else let tmF = subst ["F",var] body in let thF1 = QCONV (DEPTH_FORALL_QCONV SIMP_PROP_QCONV) tmF in let tmF' = rhs (concl thF1) in let thF2 = if (tmF' = tmT') then thT2 else TAUT_CHECK_CONV tmF' in let thF3 = thF1 TRANS thF2 in if (is_F (rhs (concl thF3))) then BOOL_CASES_F_F_RULE thF3 tm else BOOL_CASES_BOTH_T_RULE (thT3,thF3) tm ) ? failwith `TAUT_CHECK_CONV`;; %----------------------------------------------------------------------------% % PTAUT_CONV :conv % % % % Given a propositional term with all variables universally quantified, % % e.g. "!x1 ... xn. f[x1,...,xn]", this conversion proves the term to be % % either true or false, i.e. it returns one of: % % % % |- (!x1 ... xn. f[x1,...,xn]) = T % % |- (!x1 ... xn. f[x1,...,xn]) = F % % % % This conversion tries to simplify before calling TAUT_CHECK_CONV. It also % % accepts propositional terms that are not fully universally quantified. % % However, for such a term, the conversion will fail if it is not true. % % Consider the term "!x2 ... xn. f[x1,...,xn]". TAUT_CHECK_CONV proves % % one of: % % % % |- (!x1 ... xn. f[x1,...,xn]) = T % % |- (!x1 ... xn. f[x1,...,xn]) = F % % % % The former can be manipulated as follows: % % % % |- (!x1 ... xn. f[x1,...,xn]) = T % % |- !x1 ... xn. f[x1,...,xn] % % |- !x2 ... xn. f[x1,...,xn] % % |- (!x2 ... xn. f[x1,...,xn]) = T % % % % However when the fully quantified term is false, we have: % % % % |- (!x1 ... xn. f[x1,...,xn]) = F % % |- ~(!x1 ... xn. f[x1,...,xn]) % % |- ?x1. ~(!x2 ... xn. f[x1,...,xn]) % % |- ?x1. ((!x2 ... xn. f[x1,...,xn]) = F) % % % % whereas we want: % % % % |- !x1. ((!x2 ... xn. f[x1,...,xn]) = F) % % % % i.e. % % % % |- (!x2 ... xn. f[x1,...,xn]) = F % % % % The conversions given here are not capable of proving the latter theorem % % since it is not purely propositional. % %----------------------------------------------------------------------------% let PTAUT_CONV tm = (let vars = frees tm in let tm' = list_mk_forall (vars,tm) in let th = ((QCONV (DEPTH_FORALL_QCONV SIMP_PROP_QCONV)) THENC TAUT_CHECK_CONV) tm' in if (null vars) then th else if (is_F (rhs (concl th))) then failwith `PTAUT_CONV -- false for at least one interpretation` else (EQT_INTRO o (SPECL vars) o EQT_ELIM) th ) ?\s if (s = `PTAUT_CONV -- false for at least one interpretation`) then failwith s else failwith `PTAUT_CONV`;; %----------------------------------------------------------------------------% % PTAUT_TAC : tactic % % % % Tactic for solving propositional terms. % %----------------------------------------------------------------------------% let PTAUT_TAC = CONV_TAC PTAUT_CONV;; %----------------------------------------------------------------------------% % PTAUT_PROVE : conv % % % % Given a propositional term "t", this conversion returns the theorem |- t % % if "t" is a tautology. Otherwise it fails. % %----------------------------------------------------------------------------% let PTAUT_PROVE tm = (EQT_ELIM (PTAUT_CONV tm)) ? failwith `PTAUT_PROVE`;; %============================================================================% % Tautology checking including instances of propositional tautologies % %============================================================================% %----------------------------------------------------------------------------% % non_prop_terms : term -> term list % % % % Computes a list of subterms of a term that are either variables or Boolean % % valued non-propositional terms. The result list may contain duplicates. % %----------------------------------------------------------------------------% letrec non_prop_terms tm = let non_prop_args tm = let (op,args) = ((fst o dest_const) # I) (strip_comb tm) in if (mem op [`T`;`F`;`~`;`=`;`/\\`;`\\/`;`==>`;`COND`]) then flat (map non_prop_terms args) else fail in non_prop_args tm ? if (dest_type (type_of tm) = (`bool`,[])) then [tm] else failwith `non_prop_terms`;; %----------------------------------------------------------------------------% % TAUT_CONV : conv % % % % Given a term, "t", that is a valid propositional formula or valid instance % % of a propositional formula, this conversion returns the theorem |- t = T. % % The variables in "t" do not have to be universally quantified. % % % % Example: % % % % TAUT_CONV "!x n y z. x \/ ~(n < 0) \/ y \/ z \/ (n < 0)" ---> % % |- (!x n y z. x \/ ~n < 0 \/ y \/ z \/ n < 0) = T % %----------------------------------------------------------------------------% let TAUT_CONV tm = (let (univs,tm') = strip_forall tm in let insts = setify (non_prop_terms tm') in let vars = map (genvar o type_of) insts in let tm'' = list_mk_forall (vars,subst (combine (vars,insts)) tm') in EQT_INTRO (GENL univs (SPECL insts (PTAUT_PROVE tm''))) ) ? failwith `TAUT_CONV`;; %----------------------------------------------------------------------------% % TAUT_TAC : tactic % % % % Tactic for solving propositional formulae and instances of propositional % % formulae. % %----------------------------------------------------------------------------% let TAUT_TAC = CONV_TAC TAUT_CONV;; %----------------------------------------------------------------------------% % TAUT_PROVE : conv % % % % Given a valid propositional formula, or a valid instance of a % % propositional formula, "t", this conversion returns the theorem |- t. % %----------------------------------------------------------------------------% let TAUT_PROVE tm = (EQT_ELIM (TAUT_CONV tm)) ? failwith `TAUT_PROVE`;; %============================================================================% % Export top-level functions from section % %============================================================================% (PTAUT_CONV,PTAUT_TAC,PTAUT_PROVE,TAUT_CONV,TAUT_TAC,TAUT_PROVE);; end_section taut_check;; let (PTAUT_CONV,PTAUT_TAC,PTAUT_PROVE,TAUT_CONV,TAUT_TAC,TAUT_PROVE) = it;; hol88-2.02.19940316/Library/Makefile0000640000212700021270000000465505536604137015013 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL SYSTEM LIBRARY # # ===================================================================== # ===================================================================== # SUMMARY OF MAIN ENTRIES: # # make library : rebuilds the library, compiling sources whenever # # make clean : removes all object code # # make clobber : removes all object code, and theories # # ===================================================================== # ===================================================================== # MACROS: # # Libraries = a list of all libraries to be made # # Hol = the pathname of the version of hol that will be used to # rebuild the library. # # LispType = the type of the lisp system, cl or franz # # Obj = the default filename extension for compiled lisp files. # # Lisp = the pathname of the common lisp system (not used for franz) # # Liszt = the pathname of the franz lisp compiler (not used for cl) # # LispDir = the directory where the Lisp sources are # ===================================================================== Libraries = unwind taut sets reduce arith pred_sets string finite_sets\ res_quan wellorder abs_theory reals window pair word\ record_proof parser prettyp trs latex-hol more_arithmetic\ numeral ind_defs # NB: UNITY, auxiliary, bags, convert, eval, fixpoints, group, int_mod, # integer, prog_logic88, and quotient moved to contrib, 1 Mar. 94 by RJB # NB: more_lists has been moved to contrib from the library 9 Feb. 94 by WW # NB: card, well_order, zet, csp temporarily removed from the library Hol=../hol LispType=cl Obj=fasl Lisp=cl Liszt= LispDir=/usr/local/hol/lisp clean: for lib in ${Libraries} ; \ do (cd $$lib; $(MAKE) Obj=${Obj} clean; cd ..) ; \ done @echo "===> all library object code deleted" clobber: for lib in ${Libraries} ; \ do (cd $$lib; $(MAKE) Obj=${Obj} clobber; cd ..) ; \ done @echo "===> all library object code and theory files deleted" library: for lib in ${Libraries} ; \ do (cd $$lib; $(MAKE) LispType=${LispType}\ Obj=${Obj}\ Lisp=${Lisp}\ Liszt=${Liszt}\ LispDir=${LispDir}\ Hol=${Hol} all; cd ..) ; \ done @echo "=======> library rebuilt" hol88-2.02.19940316/Library/sets/0000750000212700021270000000000005533117167014315 5ustar cammcammhol88-2.02.19940316/Library/sets/help/0000750000212700021270000000000005227250237015241 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/0000750000212700021270000000000005227250237016214 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/card/0000750000212700021270000000000005227272046017127 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/card/LESS_CARD_DIFF.doc0000640000212700021270000000020505223321216021731 0ustar cammcamm\THEOREM LESS_CARD_DIFF sets |- !t. FINITE t ==> (!s. FINITE s ==> (CARD t) < (CARD s) ==> 0 < (CARD(s DIFF t))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/SING_IFF_CARD1.doc0000640000212700021270000000012205100100440021662 0ustar cammcamm\THEOREM SING_IFF_CARD1 sets |- !s. SING s = (CARD s = 1) /\ FINITE s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_PSUBSET.doc0000640000212700021270000000014505100100440021507 0ustar cammcamm\THEOREM CARD_PSUBSET sets |- !s. FINITE s ==> (!t. t PSUBSET s ==> (CARD t) < (CARD s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_SUBSET.doc0000640000212700021270000000014405100100441021367 0ustar cammcamm\THEOREM CARD_SUBSET sets |- !s. FINITE s ==> (!t. t SUBSET s ==> (CARD t) <= (CARD s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_UNION.doc0000640000212700021270000000023605100100441021254 0ustar cammcamm\THEOREM CARD_UNION sets |- !s. FINITE s ==> (!t. FINITE t ==> ((CARD(s UNION t)) + (CARD(s INTER t)) = (CARD s) + (CARD t))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_INTER_LESS_EQ.doc0000640000212700021270000000014505100100442022460 0ustar cammcamm\THEOREM CARD_INTER_LESS_EQ sets |- !s. FINITE s ==> (!t. (CARD(s INTER t)) <= (CARD s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_DELETE.doc0000640000212700021270000000017505100100442021331 0ustar cammcamm\THEOREM CARD_DELETE sets |- !s. FINITE s ==> (!x. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_INSERT.doc0000640000212700021270000000017405100100443021373 0ustar cammcamm\THEOREM CARD_INSERT sets |- !s. FINITE s ==> (!x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_DEF.doc0000640000212700021270000000022205100102606020762 0ustar cammcamm\THEOREM CARD_DEF sets |- (CARD{{}} = 0) /\ (!s. FINITE s ==> (!x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_EMPTY.doc0000640000212700021270000000006505100102726021272 0ustar cammcamm\THEOREM CARD_EMPTY sets |- CARD{{}} = 0 \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_EQ_0.doc0000640000212700021270000000012405100102766021120 0ustar cammcamm\THEOREM CARD_EQ_0 sets |- !s. FINITE s ==> ((CARD s = 0) = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_SING.doc0000640000212700021270000000007105100103005021120 0ustar cammcamm\THEOREM CARD_SING sets |- !x. CARD{{x}} = 1 \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/card/CARD_DIFF.doc0000640000212700021270000000020305151735760021116 0ustar cammcamm\THEOREM CARD_DIFF sets |- !t. FINITE t ==> (!s. FINITE s ==> (CARD(s DIFF t) = (CARD s) - (CARD(s INTER t)))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/0000750000212700021270000000000005227272112017000 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/fun/INJ_EMPTY.doc0000640000212700021270000000013605140001167021060 0ustar cammcamm\THEOREM INJ_EMPTY sets |- !f. (!s. INJ f{{}}s) /\ (!s. INJ f s{{}} = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/INJ_DEF.doc0000640000212700021270000000023105137777626020606 0ustar cammcamm\THEOREM INJ_DEF sets |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/INJ_ID.doc0000640000212700021270000000006605137777647020515 0ustar cammcamm\THEOREM INJ_ID sets |- !s. INJ(\x. x)s s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/INJ_COMPOSE.doc0000640000212700021270000000013605137777654021322 0ustar cammcamm\THEOREM INJ_COMPOSE sets |- !f g s t u. INJ f s t /\ INJ g t u ==> INJ(g o f)s u \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/SURJ_DEF.doc0000640000212700021270000000022105137777702020743 0ustar cammcamm\THEOREM SURJ_DEF sets |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/SURJ_ID.doc0000640000212700021270000000007005137777707020650 0ustar cammcamm\THEOREM SURJ_ID sets |- !s. SURJ(\x. x)s s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/SURJ_COMPOSE.doc0000640000212700021270000000014205137777720021454 0ustar cammcamm\THEOREM SURJ_COMPOSE sets |- !f g s t u. SURJ f s t /\ SURJ g t u ==> SURJ(g o f)s u \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/IMAGE_SURJ.doc0000640000212700021270000000011505137777744021177 0ustar cammcamm\THEOREM IMAGE_SURJ sets |- !f s t. SURJ f s t = (IMAGE f s = t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/BIJ_COMPOSE.doc0000640000212700021270000000013605137777761021305 0ustar cammcamm\THEOREM BIJ_COMPOSE sets |- !f g s t u. BIJ f s t /\ BIJ g t u ==> BIJ(g o f)s u \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/BIJ_DEF.doc0000640000212700021270000000012105137777762020571 0ustar cammcamm\THEOREM BIJ_DEF sets |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/BIJ_ID.doc0000640000212700021270000000006605137777762020477 0ustar cammcamm\THEOREM BIJ_ID sets |- !s. BIJ(\x. x)s s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/LINV_DEF.doc0000640000212700021270000000014105140000005020672 0ustar cammcamm\THEOREM LINV_DEF sets |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/RINV_DEF.doc0000640000212700021270000000014205140000014020701 0ustar cammcamm\THEOREM RINV_DEF sets |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/SURJ_EMPTY.doc0000640000212700021270000000015605140001201021212 0ustar cammcamm\THEOREM SURJ_EMPTY sets |- !f. (!s. SURJ f{{}}s = (s = {{}})) /\ (!s. SURJ f s{{}} = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fun/BIJ_EMPTY.doc0000640000212700021270000000015305140001215021035 0ustar cammcamm\THEOREM BIJ_EMPTY sets |- !f. (!s. BIJ f{{}}s = (s = {{}})) /\ (!s. BIJ f s{{}} = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/0000750000212700021270000000000005227272231016766 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_PSUBSET_INFINITE.doc0000640000212700021270000000016405100100436023112 0ustar cammcamm\THEOREM FINITE_PSUBSET_INFINITE sets |- !s. INFINITE s = (!t. FINITE t ==> t SUBSET s ==> t PSUBSET s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/IN_INFINITE_NOT_FINITE.doc0000640000212700021270000000015505100100437023014 0ustar cammcamm\THEOREM IN_INFINITE_NOT_FINITE sets |- !s t. INFINITE s /\ FINITE t ==> (?x. x IN s /\ ~x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/INFINITE_SUBSET.doc0000640000212700021270000000014005100100437021727 0ustar cammcamm\THEOREM INFINITE_SUBSET sets |- !s. INFINITE s ==> (!t. s SUBSET t ==> INFINITE t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/IMAGE_11_INFINITE.doc0000640000212700021270000000021005100100437022043 0ustar cammcamm\THEOREM IMAGE_11_INFINITE sets |- !f. (!x y. (f x = f y) ==> (x = y)) ==> (!s. INFINITE s ==> INFINITE(IMAGE f s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/INFINITE_DEF.doc0000640000212700021270000000010505100100533021316 0ustar cammcamm\THEOREM INFINITE_DEF sets |- !s. INFINITE s = ~FINITE s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/INFINITE_UNIV.doc0000640000212700021270000000021205100104054021502 0ustar cammcamm\THEOREM INFINITE_UNIV sets |- INFINITE (UNIV:(*)set) = (?f:*->*. (!x y. (f x = f y) ==> (x = y)) /\ (?y. !x. ~(f x = y))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/INFINITE_DIFF_FINITE.doc0000640000212700021270000000014605100104404022474 0ustar cammcamm\THEOREM INFINITE_DIFF_FINITE sets |- !s t. INFINITE s /\ FINITE t ==> ~(s DIFF t = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_PSUBSET_UNIV.doc0000640000212700021270000000014305100100436022463 0ustar cammcamm\THEOREM FINITE_PSUBSET_UNIV sets |- INFINITE UNIV = (!s. FINITE s ==> s PSUBSET UNIV) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/NOT_IN_FINITE.doc0000640000212700021270000000013405100100437021524 0ustar cammcamm\THEOREM NOT_IN_FINITE sets |- INFINITE UNIV = (!s. FINITE s ==> (?x. ~x IN s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/IMAGE_FINITE.doc0000640000212700021270000000012305100100444021314 0ustar cammcamm\THEOREM IMAGE_FINITE sets |- !s. FINITE s ==> (!f. FINITE(IMAGE f s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_DIFF.doc0000640000212700021270000000012105100100445021201 0ustar cammcamm\THEOREM FINITE_DIFF sets |- !s. FINITE s ==> (!t. FINITE(s DIFF t)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/PSUBSET_FINITE.doc0000640000212700021270000000013405100100446021623 0ustar cammcamm\THEOREM PSUBSET_FINITE sets |- !s. FINITE s ==> (!t. t PSUBSET s ==> FINITE t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/SUBSET_FINITE.doc0000640000212700021270000000013205100100446021501 0ustar cammcamm\THEOREM SUBSET_FINITE sets |- !s. FINITE s ==> (!t. t SUBSET s ==> FINITE t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/INTER_FINITE.doc0000640000212700021270000000012305100100447021356 0ustar cammcamm\THEOREM INTER_FINITE sets |- !s. FINITE s ==> (!t. FINITE(s INTER t)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_UNION.doc0000640000212700021270000000013105100100447021364 0ustar cammcamm\THEOREM FINITE_UNION sets |- !s t. FINITE(s UNION t) = FINITE s /\ FINITE t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_DELETE.doc0000640000212700021270000000011705100100450021434 0ustar cammcamm\THEOREM FINITE_DELETE sets |- !x s. FINITE(s DELETE x) = FINITE s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_INSERT.doc0000640000212700021270000000011705100100450021476 0ustar cammcamm\THEOREM FINITE_INSERT sets |- !x s. FINITE(x INSERT s) = FINITE s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_DEF.doc0000640000212700021270000000016705100104636021107 0ustar cammcamm\THEOREM FINITE_DEF sets |- !s. FINITE s = (!P. P{{}} /\ (!s'. P s' ==> (!e. P(e INSERT s'))) ==> P s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_EMPTY.doc0000640000212700021270000000006505100104652021402 0ustar cammcamm\THEOREM FINITE_EMPTY sets |- FINITE{{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_INDUCT.doc0000640000212700021270000000022505100104663021472 0ustar cammcamm\THEOREM FINITE_INDUCT sets |- !P. P{{}} /\ (!s. FINITE s /\ P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> (!s. FINITE s ==> P s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/fin/FINITE_ISO_NUM.doc0000640000212700021270000000027005100104677021662 0ustar cammcamm\THEOREM FINITE_ISO_NUM sets |- !s. FINITE s ==> (?f. (!n m. n < (CARD s) /\ m < (CARD s) ==> (f n = f m) ==> (n = m)) /\ (s = {{f n | n < (CARD s)}})) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/0000750000212700021270000000000005227272332017276 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_EQ_EMPTY.doc0000640000212700021270000000012205151504646022150 0ustar cammcamm\THEOREM IMAGE_EQ_EMPTY sets |- !s f. (IMAGE f s = {{}}) = (s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_INTER.doc0000640000212700021270000000015505100100452021531 0ustar cammcamm\THEOREM IMAGE_INTER sets |- !f s t. (IMAGE f(s INTER t)) SUBSET ((IMAGE f s) INTER (IMAGE f t)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_SUBSET.doc0000640000212700021270000000014405100100452021653 0ustar cammcamm\THEOREM IMAGE_SUBSET sets |- !s t. s SUBSET t ==> (!f. (IMAGE f s) SUBSET (IMAGE f t)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_UNION.doc0000640000212700021270000000014405100100453021537 0ustar cammcamm\THEOREM IMAGE_UNION sets |- !f s t. IMAGE f(s UNION t) = (IMAGE f s) UNION (IMAGE f t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_DELETE.doc0000640000212700021270000000014005100100453021605 0ustar cammcamm\THEOREM IMAGE_DELETE sets |- !f x s. ~x IN s ==> (IMAGE f(s DELETE x) = IMAGE f s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_INSERT.doc0000640000212700021270000000014105100100454021651 0ustar cammcamm\THEOREM IMAGE_INSERT sets |- !f x s. IMAGE f(x INSERT s) = (f x) INSERT (IMAGE f s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_COMPOSE.doc0000640000212700021270000000012605100100454021755 0ustar cammcamm\THEOREM IMAGE_COMPOSE sets |- !f g s. IMAGE(f o g)s = IMAGE f(IMAGE g s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_ID.doc0000640000212700021270000000007405100100455021147 0ustar cammcamm\THEOREM IMAGE_ID sets |- !s. IMAGE(\x. x)s = s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_IN.doc0000640000212700021270000000012205100100456021154 0ustar cammcamm\THEOREM IMAGE_IN sets |- !x s. x IN s ==> (!f. (f x) IN (IMAGE f s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IN_IMAGE.doc0000640000212700021270000000013305100100457021157 0ustar cammcamm\THEOREM IN_IMAGE sets |- !y s f. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_DEF.doc0000640000212700021270000000011205100105646021251 0ustar cammcamm\THEOREM IMAGE_DEF sets |- !f s. IMAGE f s = {{f x | x IN s}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/image/IMAGE_EMPTY.doc0000640000212700021270000000010005100105673021546 0ustar cammcamm\THEOREM IMAGE_EMPTY sets |- !f. IMAGE f{{}} = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/0000750000212700021270000000000005227272416017127 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/diff/DIFF_UNIV.doc0000640000212700021270000000007605100105257021157 0ustar cammcamm\THEOREM DIFF_UNIV sets |- !s. s DIFF UNIV = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/DIFF_DEF.doc0000640000212700021270000000012105100107142020756 0ustar cammcamm\THEOREM DIFF_DEF sets |- !s t. s DIFF t = {{x | x IN s /\ ~x IN t}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/DIFF_EMPTY.doc0000640000212700021270000000007405100107153021267 0ustar cammcamm\THEOREM DIFF_EMPTY sets |- !s. s DIFF {{}} = s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/DIFF_EQ_EMPTY.doc0000640000212700021270000000007705100107162021657 0ustar cammcamm\THEOREM DIFF_EQ_EMPTY sets |- !s. s DIFF s = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/EMPTY_DIFF.doc0000640000212700021270000000007705100107170021271 0ustar cammcamm\THEOREM EMPTY_DIFF sets |- !s. {{}} DIFF s = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/DIFF_DIFF.doc0000640000212700021270000000011205100100510021060 0ustar cammcamm\THEOREM DIFF_DIFF sets |- !s t. (s DIFF t) DIFF t = s DIFF t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/diff/IN_DIFF.doc0000640000212700021270000000012105100100511020657 0ustar cammcamm\THEOREM IN_DIFF sets |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/0000750000212700021270000000000005227272711017136 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/chre/CHOICE_INSERT_REST.doc0000640000212700021270000000014505100106576022474 0ustar cammcamm\THEOREM CHOICE_INSERT_REST sets |- !s. ~(s = {{}}) ==> ((CHOICE s) INSERT (REST s) = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/CHOICE_DEF.doc0000640000212700021270000000011405100107600021212 0ustar cammcamm\THEOREM CHOICE_DEF sets |- !s. ~(s = {{}}) ==> (CHOICE s) IN s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/REST_PSUBSET.doc0000640000212700021270000000012105100107614021567 0ustar cammcamm\THEOREM REST_PSUBSET sets |- !s. ~(s = {{}}) ==> (REST s) PSUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/REST_SUBSET.doc0000640000212700021270000000007705100100474021456 0ustar cammcamm\THEOREM REST_SUBSET sets |- !s. (REST s) SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/CHOICE_NOT_IN_REST.doc0000640000212700021270000000011405100100475022502 0ustar cammcamm\THEOREM CHOICE_NOT_IN_REST sets |- !s. ~(CHOICE s) IN (REST s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/REST_DEF.doc0000640000212700021270000000010705100100535021037 0ustar cammcamm\THEOREM REST_DEF sets |- !s. REST s = s DELETE (CHOICE s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/CHOICE_SING.doc0000640000212700021270000000007505100103276021367 0ustar cammcamm\THEOREM CHOICE_SING sets |- !x. CHOICE{{x}} = x \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/REST_SING.doc0000640000212700021270000000007405100103417021206 0ustar cammcamm\THEOREM REST_SING sets |- !x. REST{{x}} = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/chre/SING_IFF_EMPTY_REST.doc0000640000212700021270000000013505100103501022640 0ustar cammcamm\THEOREM SING_IFF_EMPTY_REST sets |- !s. SING s = ~(s = {{}}) /\ (REST s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/0000750000212700021270000000000005227251174017166 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/unin/INTER_UNIV.doc0000640000212700021270000000013105100100514021350 0ustar cammcamm\THEOREM INTER_UNIV sets |- (!s. UNIV INTER s = s) /\ (!s. s INTER UNIV = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_UNIV.doc0000640000212700021270000000013705100100520021362 0ustar cammcamm\THEOREM UNION_UNIV sets |- (!s. UNIV UNION s = UNIV) /\ (!s. s UNION UNIV = UNIV) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_DEF.doc0000640000212700021270000000012205100110174021170 0ustar cammcamm\THEOREM INTER_DEF sets |- !s t. s INTER t = {{x | x IN s /\ x IN t}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_EMPTY.doc0000640000212700021270000000014005100110214021463 0ustar cammcamm\THEOREM INTER_EMPTY sets |- (!s. {{}} INTER s = {{}}) /\ (!s. s INTER {{}} = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_DEF.doc0000640000212700021270000000012205100110235021175 0ustar cammcamm\THEOREM UNION_DEF sets |- !s t. s UNION t = {{x | x IN s \/ x IN t}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_EMPTY.doc0000640000212700021270000000013205100110244021476 0ustar cammcamm\THEOREM UNION_EMPTY sets |- (!s. {{}} UNION s = s) /\ (!s. s UNION {{}} = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/EMPTY_UNION.doc0000640000212700021270000000013505100111562021505 0ustar cammcamm\THEOREM EMPTY_UNION sets |- !s t. (s UNION t = {{}}) = (s = {{}}) /\ (t = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_OVER_UNION.doc0000640000212700021270000000015205100100513022314 0ustar cammcamm\THEOREM INTER_OVER_UNION sets |- !s t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_OVER_INTER.doc0000640000212700021270000000015205100100514022315 0ustar cammcamm\THEOREM UNION_OVER_INTER sets |- !s t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/SUBSET_INTER_ABSORPTION.doc0000640000212700021270000000013005100100515023334 0ustar cammcamm\THEOREM SUBSET_INTER_ABSORPTION sets |- !s t. s SUBSET t = (s INTER t = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_SUBSET.doc0000640000212700021270000000014705100100516021605 0ustar cammcamm\THEOREM INTER_SUBSET sets |- (!s t. (s INTER t) SUBSET s) /\ (!s t. (t INTER s) SUBSET s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_COMM.doc0000640000212700021270000000010405100100516021324 0ustar cammcamm\THEOREM INTER_COMM sets |- !s t. s INTER t = t INTER s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_IDEMPOT.doc0000640000212700021270000000007505100100517021702 0ustar cammcamm\THEOREM INTER_IDEMPOT sets |- !s. s INTER s = s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/INTER_ASSOC.doc0000640000212700021270000000013305100100517021444 0ustar cammcamm\THEOREM INTER_ASSOC sets |- !s t u. (s INTER t) INTER u = s INTER (t INTER u) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/IN_INTER.doc0000640000212700021270000000012205100100517021100 0ustar cammcamm\THEOREM IN_INTER sets |- !s t x. x IN (s INTER t) = x IN s /\ x IN t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/SUBSET_UNION_ABSORPTION.doc0000640000212700021270000000013005100100521023340 0ustar cammcamm\THEOREM SUBSET_UNION_ABSORPTION sets |- !s t. s SUBSET t = (s UNION t = t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/SUBSET_UNION.doc0000640000212700021270000000014705100100522021611 0ustar cammcamm\THEOREM SUBSET_UNION sets |- (!s t. s SUBSET (s UNION t)) /\ (!s t. s SUBSET (t UNION s)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_COMM.doc0000640000212700021270000000010405100100522021330 0ustar cammcamm\THEOREM UNION_COMM sets |- !s t. s UNION t = t UNION s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_IDEMPOT.doc0000640000212700021270000000007505100100523021706 0ustar cammcamm\THEOREM UNION_IDEMPOT sets |- !s. s UNION s = s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/UNION_ASSOC.doc0000640000212700021270000000013305100100523021450 0ustar cammcamm\THEOREM UNION_ASSOC sets |- !s t u. (s UNION t) UNION u = s UNION (t UNION u) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/unin/IN_UNION.doc0000640000212700021270000000012205100100524021105 0ustar cammcamm\THEOREM IN_UNION sets |- !s t x. x IN (s UNION t) = x IN s \/ x IN t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/0000750000212700021270000000000005227251373017172 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/subs/EMPTY_SUBSET.doc0000640000212700021270000000007405100110671021627 0ustar cammcamm\THEOREM EMPTY_SUBSET sets |- !s. {{}} SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/NOT_PSUBSET_EMPTY.doc0000640000212700021270000000010305100110715022457 0ustar cammcamm\THEOREM NOT_PSUBSET_EMPTY sets |- !s. ~s PSUBSET {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/SUBSET_EMPTY.doc0000640000212700021270000000011105100110733021616 0ustar cammcamm\THEOREM SUBSET_EMPTY sets |- !s. s SUBSET {{}} = (s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/PSUBSET_MEMBER.doc0000640000212700021270000000014605100100477022023 0ustar cammcamm\THEOREM PSUBSET_MEMBER sets |- !s t. s PSUBSET t = s SUBSET t /\ (?y. y IN t /\ ~y IN s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/PSUBSET_UNIV.doc0000640000212700021270000000011505100100524021622 0ustar cammcamm\THEOREM PSUBSET_UNIV sets |- !s. s PSUBSET UNIV = (?x. ~x IN s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/NOT_UNIV_PSUBSET.doc0000640000212700021270000000010205100100525022337 0ustar cammcamm\THEOREM NOT_UNIV_PSUBSET sets |- !s. ~UNIV PSUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/PSUBSET_IRREFL.doc0000640000212700021270000000007505100100526022033 0ustar cammcamm\THEOREM PSUBSET_IRREFL sets |- !s. ~s PSUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/PSUBSET_TRANS.doc0000640000212700021270000000013605100100527021736 0ustar cammcamm\THEOREM PSUBSET_TRANS sets |- !s t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/UNIV_SUBSET.doc0000640000212700021270000000011005100100527021500 0ustar cammcamm\THEOREM UNIV_SUBSET sets |- !s. UNIV SUBSET s = (s = UNIV) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/SUBSET_UNIV.doc0000640000212700021270000000007305100100527021510 0ustar cammcamm\THEOREM SUBSET_UNIV sets |- !s. s SUBSET UNIV \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/SUBSET_ANTISYM.doc0000640000212700021270000000012705100100530022045 0ustar cammcamm\THEOREM SUBSET_ANTISYM sets |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/SUBSET_REFL.doc0000640000212700021270000000007005100100530021446 0ustar cammcamm\THEOREM SUBSET_REFL sets |- !s. s SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/SUBSET_TRANS.doc0000640000212700021270000000013205100100531021605 0ustar cammcamm\THEOREM SUBSET_TRANS sets |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/PSUBSET_DEF.doc0000640000212700021270000000012405100100540021435 0ustar cammcamm\THEOREM PSUBSET_DEF sets |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/subs/SUBSET_DEF.doc0000640000212700021270000000012305100100541021315 0ustar cammcamm\THEOREM SUBSET_DEF sets |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/0000750000212700021270000000000005227251557017153 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/disj/DISJOINT_DEF.doc0000640000212700021270000000012205100111326021512 0ustar cammcamm\THEOREM DISJOINT_DEF sets |- !s t. DISJOINT s t = (s INTER t = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/DISJOINT_EMPTY_REFL.doc0000640000212700021270000000011705100111337022630 0ustar cammcamm\THEOREM DISJOINT_EMPTY_REFL sets |- !s. (s = {{}}) = DISJOINT s s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/DISJOINT_SYM.doc0000640000212700021270000000011405100100512021560 0ustar cammcamm\THEOREM DISJOINT_SYM sets |- !s t. DISJOINT s t = DISJOINT t s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/IN_DISJOINT.doc0000640000212700021270000000012605100100513021422 0ustar cammcamm\THEOREM IN_DISJOINT sets |- !s t. DISJOINT s t = ~(?x. x IN s /\ x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/DISJOINT_UNION.doc0000640000212700021270000000015005151457141022023 0ustar cammcamm\THEOREM DISJOINT_UNION sets |- !s t u. DISJOINT(s UNION t)u = DISJOINT s u /\ DISJOINT t u \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/DISJOINT_EMPTY.doc0000640000212700021270000000012305223301017022017 0ustar cammcamm\THEOREM DISJOINT_EMPTY sets |- !s. DISJOINT {{}} s /\ DISJOINT s {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/disj/DISJOINT_DELETE_SYM.doc0000640000212700021270000000015005223605040022616 0ustar cammcamm\THEOREM DISJOINT_DELETE_SYM sets |- !s t x. DISJOINT(s DELETE x)t = DISJOINT(t DELETE x)s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/0000750000212700021270000000000005227251560017517 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/emuniv/EMPTY_DEF.doc0000640000212700021270000000007205100112056021544 0ustar cammcamm\THEOREM EMPTY_DEF sets |- {{}} = SPEC(\x. F) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/NOT_IN_EMPTY.doc0000640000212700021270000000007105100112075022174 0ustar cammcamm\THEOREM NOT_IN_EMPTY sets |- !x. ~x IN {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/MEMBER_NOT_EMPTY.doc0000640000212700021270000000011505100112127022632 0ustar cammcamm\THEOREM MEMBER_NOT_EMPTY sets |- !s. (?x. x IN s) = ~(s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/EQ_UNIV.doc0000640000212700021270000000007705100100531021336 0ustar cammcamm\THEOREM EQ_UNIV sets |- (!x. x IN s) = (s = UNIV) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/IN_UNIV.doc0000640000212700021270000000006305100100531021332 0ustar cammcamm\THEOREM IN_UNIV sets |- !x. x IN UNIV \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/UNIV_DEF.doc0000640000212700021270000000007105100100542021423 0ustar cammcamm\THEOREM UNIV_DEF sets |- UNIV = SPEC(\x. T) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/EMPTY_NOT_UNIV.doc0000640000212700021270000000007305100105267022456 0ustar cammcamm\THEOREM EMPTY_NOT_UNIV sets |- ~({{}} = UNIV) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/emuniv/UNIV_NOT_EMPTY.doc0000640000212700021270000000007305100105305022447 0ustar cammcamm\THEOREM UNIV_NOT_EMPTY sets |- ~(UNIV = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sdef/0000750000212700021270000000000005227251722017135 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/sdef/set_ISO_DEF.doc0000640000212700021270000000014505100100544021571 0ustar cammcamm\THEOREM set_ISO_DEF sets |- (!a. SPEC(CHF a) = a) /\ (!r. (\p. T)r = (CHF(SPEC r) = r)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sdef/set_TY_DEF.doc0000640000212700021270000000011005100100544021463 0ustar cammcamm\THEOREM set_TY_DEF sets |- ?rep. TYPE_DEFINITION(\p. T)rep \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/0000750000212700021270000000000005227252375017477 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_DEF.doc0000640000212700021270000000011005100106227021557 0ustar cammcamm\THEOREM DELETE_DEF sets |- !s x. s DELETE x = s DIFF {{x}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/EMPTY_DELETE.doc0000640000212700021270000000010305100106251022056 0ustar cammcamm\THEOREM EMPTY_DELETE sets |- !x. {{}} DELETE x = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_DEF.doc0000640000212700021270000000012505100106606021630 0ustar cammcamm\THEOREM INSERT_DEF sets |- !x s. x INSERT s = {{y | (y = x) \/ y IN s}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/NOT_EMPTY_INSERT.doc0000640000212700021270000000011105100106624022643 0ustar cammcamm\THEOREM NOT_EMPTY_INSERT sets |- !x s. ~({{}} = x INSERT s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/NOT_INSERT_EMPTY.doc0000640000212700021270000000011105100106641022642 0ustar cammcamm\THEOREM NOT_INSERT_EMPTY sets |- !x s. ~(x INSERT s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/SET_CASES.doc0000640000212700021270000000013505100112246021515 0ustar cammcamm\THEOREM SET_CASES sets |- !s. (s = {{}}) \/ (?x t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_DELETE.doc0000640000212700021270000000013005100100476022167 0ustar cammcamm\THEOREM INSERT_DELETE sets |- !x s. x IN s ==> (x INSERT (s DELETE x) = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_INSERT.doc0000640000212700021270000000020305100100476022170 0ustar cammcamm\THEOREM DELETE_INSERT sets |- !x y s. (x INSERT s) DELETE y = ((x = y) => s DELETE y | x INSERT (s DELETE y)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/PSUBSET_INSERT_SUBSET.doc0000640000212700021270000000015605100100500023433 0ustar cammcamm\THEOREM PSUBSET_INSERT_SUBSET sets |- !s t. s PSUBSET t = (?x. ~x IN s /\ (x INSERT s) SUBSET t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DIFF_INSERT.doc0000640000212700021270000000013305100100500021724 0ustar cammcamm\THEOREM DIFF_INSERT sets |- !s t x. s DIFF (x INSERT t) = (s DELETE x) DIFF t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/SUBSET_INSERT_DELETE.doc0000640000212700021270000000015005100100501023243 0ustar cammcamm\THEOREM SUBSET_INSERT_DELETE sets |- !x s t. s SUBSET (x INSERT t) = (s DELETE x) SUBSET t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/SUBSET_DELETE.doc0000640000212700021270000000014105100100501022157 0ustar cammcamm\THEOREM SUBSET_DELETE sets |- !x s t. s SUBSET (t DELETE x) = ~x IN s /\ s SUBSET t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_SUBSET.doc0000640000212700021270000000010705100100504022164 0ustar cammcamm\THEOREM DELETE_SUBSET sets |- !x s. (s DELETE x) SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_COMM.doc0000640000212700021270000000013705100100504021715 0ustar cammcamm\THEOREM DELETE_COMM sets |- !x y s. (s DELETE x) DELETE y = (s DELETE y) DELETE x \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_DELETE.doc0000640000212700021270000000012405100100504022120 0ustar cammcamm\THEOREM DELETE_DELETE sets |- !x s. (s DELETE x) DELETE x = s DELETE x \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/IN_DELETE_EQ.doc0000640000212700021270000000016605100100504022057 0ustar cammcamm\THEOREM IN_DELETE_EQ sets |- !s x x'. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_NON_ELEMENT.doc0000640000212700021270000000012105100100505022757 0ustar cammcamm\THEOREM DELETE_NON_ELEMENT sets |- !x s. ~x IN s = (s DELETE x = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/IN_DELETE.doc0000640000212700021270000000012605100100505021467 0ustar cammcamm\THEOREM IN_DELETE sets |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_DIFF.doc0000640000212700021270000000016605100100505021737 0ustar cammcamm\THEOREM INSERT_DIFF sets |- !s t x. (x INSERT s) DIFF t = (x IN t => s DIFF t | x INSERT (s DIFF t)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/SUBSET_INSERT.doc0000640000212700021270000000014605100100505022232 0ustar cammcamm\THEOREM SUBSET_INSERT sets |- !x s. ~x IN s ==> (!t. s SUBSET (x INSERT t) = s SUBSET t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_SUBSET.doc0000640000212700021270000000014005100100505022224 0ustar cammcamm\THEOREM INSERT_SUBSET sets |- !x s t. (x INSERT s) SUBSET t = x IN t /\ s SUBSET t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DISJOINT_INSERT.doc0000640000212700021270000000014505100100506022450 0ustar cammcamm\THEOREM DISJOINT_INSERT sets |- !x s t. DISJOINT(x INSERT s)t = DISJOINT s t /\ ~x IN t \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_INTER.doc0000640000212700021270000000017205100100506022106 0ustar cammcamm\THEOREM INSERT_INTER sets |- !x s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_UNION_EQ.doc0000640000212700021270000000014105100100506022476 0ustar cammcamm\THEOREM INSERT_UNION_EQ sets |- !x s t. (x INSERT s) UNION t = x INSERT (s UNION t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_UNION.doc0000640000212700021270000000017205100100506022115 0ustar cammcamm\THEOREM INSERT_UNION sets |- !x s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_COMM.doc0000640000212700021270000000013705100100507021762 0ustar cammcamm\THEOREM INSERT_COMM sets |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_INSERT.doc0000640000212700021270000000012405100100507022227 0ustar cammcamm\THEOREM INSERT_INSERT sets |- !x s. x INSERT (x INSERT s) = x INSERT s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/ABSORPTION.doc0000640000212700021270000000011005100100507021612 0ustar cammcamm\THEOREM ABSORPTION sets |- !x s. x IN s = (x INSERT s = s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DECOMPOSITION.doc0000640000212700021270000000013405100100507022154 0ustar cammcamm\THEOREM DECOMPOSITION sets |- !s x. x IN s = (?t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/DELETE_INTER.doc0000640000212700021270000000013605151447226022067 0ustar cammcamm\THEOREM DELETE_INTER sets |- !s t x. (s DELETE x) INTER t = (s INTER t) DELETE x \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/IN_INSERT.doc0000640000212700021270000000012505100100510021524 0ustar cammcamm\THEOREM IN_INSERT sets |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/COMPONENT.doc0000640000212700021270000000007705147252210021522 0ustar cammcamm\THEOREM COMPONENT sets |- !x s. x IN (x INSERT s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/insdel/INSERT_UNIV.doc0000640000212700021270000000010205100100507022000 0ustar cammcamm\THEOREM INSERT_UNIV sets |- !x. x INSERT UNIV = UNIV \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/0000750000212700021270000000000005261374100016764 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/mem/NOT_EQUAL_SETS.doc0000640000212700021270000000012405100100533021663 0ustar cammcamm\THEOREM NOT_EQUAL_SETS sets |- !s t. ~(s = t) = (?x. x IN t = ~x IN s) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/IN_DEF.doc0000640000212700021270000000007305100100543020426 0ustar cammcamm\THEOREM IN_DEF sets |- !x s. x IN s = CHF s x \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/EXTENSION.doc0000640000212700021270000000011505101042512021015 0ustar cammcamm\THEOREM EXTENSION sets |- !s t. (s = t) = (!x. x IN s = x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/GSPEC_DEF.doc0000640000212700021270000000011505102771033020770 0ustar cammcamm\THEOREM GSPEC_DEF sets |- !f. GSPEC f = SPEC(\y. ?x. y,T = f x) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/SPECIFICATION.doc0000640000212700021270000000010505102770330021427 0ustar cammcamm\THEOREM SPECIFICATION sets |- !P x. x IN (SPEC P) = P x \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/GSPECIFICATION.doc0000640000212700021270000000012305102771054021542 0ustar cammcamm\THEOREM GSPECIFICATION sets |- !f v. v IN (GSPEC f) = (?x. v,T = f x) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/NUM_SET_WOP.doc0000640000212700021270000000014405261372060021355 0ustar cammcamm\THEOREM NUM_SET_WOP sets |- !s. (?n. n IN s) = (?n. n IN s /\ (!m. m IN s ==> n <= m)) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/mem/SET_MINIMUM.doc0000640000212700021270000000015605261373607021317 0ustar cammcamm\THEOREM SET_MINIMUM sets |- !s M. (?x. x IN s) = (?x. x IN s /\ (!y. y IN s ==> (M x) <= (M y))) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/0000750000212700021270000000000005227252704017155 5ustar cammcammhol88-2.02.19940316/Library/sets/help/thms/sing/SING_FINITE.doc0000640000212700021270000000010105100100445021413 0ustar cammcamm\THEOREM SING_FINITE sets |- !s. SING s ==> FINITE s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/DELETE_EQ_SING.doc0000640000212700021270000000014105100103310021762 0ustar cammcamm\THEOREM DELETE_EQ_SING sets |- !s x. x IN s ==> ((s DELETE x = {{}}) = (s = {{x}})) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/DISJOINT_SING_EMPTY.doc0000640000212700021270000000010705100103325022644 0ustar cammcamm\THEOREM DISJOINT_SING_EMPTY sets |- !x. DISJOINT{{x}}{{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/EQUAL_SING.doc0000640000212700021270000000011005100103337021307 0ustar cammcamm\THEOREM EQUAL_SING sets |- !x y. ({{x}} = {{y}}) = (x = y) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/FINITE_SING.doc0000640000212700021270000000007105100103347021425 0ustar cammcamm\THEOREM FINITE_SING sets |- !x. FINITE{{x}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/INSERT_SING_UNION.doc0000640000212700021270000000012005100103357022417 0ustar cammcamm\THEOREM INSERT_SING_UNION sets |- !s x. x INSERT s = {{x}} UNION s \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/IN_SING.doc0000640000212700021270000000010005100103367020750 0ustar cammcamm\THEOREM IN_SING sets |- !x y. x IN {{y}} = (x = y) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/NOT_EMPTY_SING.doc0000640000212700021270000000010005100103400022044 0ustar cammcamm\THEOREM NOT_EMPTY_SING sets |- !x. ~({{}} = {{x}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/NOT_SING_EMPTY.doc0000640000212700021270000000010005100103411022046 0ustar cammcamm\THEOREM NOT_SING_EMPTY sets |- !x. ~({{x}} = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/SING.doc0000640000212700021270000000006005100103432020360 0ustar cammcamm\THEOREM SING sets |- !x. SING{{x}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/SING_DEF.doc0000640000212700021270000000010305100103446021041 0ustar cammcamm\THEOREM SING_DEF sets |- !s. SING s = (?x. s = {{x}}) \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/thms/sing/SING_DELETE.doc0000640000212700021270000000010305100103456021406 0ustar cammcamm\THEOREM SING_DELETE sets |- !x. {{x}} DELETE x = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/sets/help/entries/0000750000212700021270000000000005227252766016723 5ustar cammcammhol88-2.02.19940316/Library/sets/help/entries/INSERT_CONV.doc0000640000212700021270000000543705147306524021246 0ustar cammcamm\DOC INSERT_CONV \TYPE {INSERT_CONV : conv -> conv} \SYNOPSIS Reduce {x INSERT {{x1,...,x,...,xn}}} to {{{x1,...,x,...,xn}}}. \LIBRARY sets \DESCRIBE The function {INSERT_CONV} is a parameterized conversion for reducing finite sets of the form {"t INSERT {{t1,...,tn}}"}, where {{{t1,...,tn}}} is a set of type {(ty)set} and {t} is equal to some element {ti} of this set. The first argument to {INSERT_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion, the function {INSERT_CONV} returns a conversion that maps a term of the form {"t INSERT {{t1,...,tn}}"} to the theorem { |- t INSERT {{t1,...,tn}} = {{t1,...,tn}} } \noindent if {t} is alpha-equivalent to any {ti} in the set {{{t1,...,tn}}}, or if the supplied conversion proves {|- (t = ti) = T} for any {ti}. \EXAMPLE In the following example, the conversion {num_EQ_CONV} is supplied as a parameter and used to test equality of the inserted value {2} with the remaining elements of the set. { #INSERT_CONV num_EQ_CONV "2 INSERT {{1,SUC 1,3}}";; |- {{2,1,SUC 1,3}} = {{1,SUC 1,3}} } \noindent In this example, the supplied conversion {num_EQ_CONV} is able to prove that {2} is equal to {SUC 1} and the set is therefore reduced. Note that {"2 INSERT {{1,SUC 1,3}}"} is just {"{{2,1,SUC 1,3}}"}. A call to {INSERT_CONV} fails when the value being inserted is provably not equal to any of the remaining elements: { #INSERT_CONV num_EQ_CONV "1 INSERT {{2,3}}";; evaluation failed INSERT_CONV } \noindent But this failure can, if desired, be caught using {TRY_CONV}. The behaviour of the supplied conversion is irrelevant when the inserted value is alpha-equivalent to one of the remaining elements: { #INSERT_CONV NO_CONV "(y:*) INSERT {{x,y,z}}";; |- {{y,x,y,z}} = {{x,y,z}} } \noindent The conversion {NO_CONV} always fails, but {INSERT_CONV} is nontheless able in this case to prove the required result. Note that {DEPTH_CONV(INSERT_CONV conv)} can be used to remove duplicate elements from a finite set, but the following conversion is faster: { #letrec REDUCE_CONV conv tm = (SUB_CONV (REDUCE_CONV conv) THENC (TRY_CONV (INSERT_CONV conv))) tm;; REDUCE_CONV = - : (conv -> conv) #REDUCE_CONV num_EQ_CONV "{{1,2,1,3,2,4,3,5,6}}";; |- {{1,2,1,3,2,4,3,5,6}} = {{1,2,4,3,5,6}} } \FAILURE {INSERT_CONV conv} fails if applied to a term not of the form {"t INSERT {{t1,...,tn}}"}. A call {INSERT_CONV conv "t INSERT {{t1,...,tn}}"} fails unless {t} is alpha-equivalent to some {ti}, or {conv "t = ti"} returns {|- (t = ti) = T} for some {ti}. \SEEALSO DELETE_CONV. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/IN_CONV.doc0000640000212700021270000000443405135607521020542 0ustar cammcamm\DOC IN_CONV \TYPE {IN_CONV : conv -> conv} \SYNOPSIS Decision procedure for membership in finite sets. \LIBRARY sets \DESCRIBE The function {IN_CONV} is a parameterized conversion for proving or disproving membership assertions of the general form: { "t IN {{t1,...,tn}}" } \noindent where {{{t1,...,tn}}} is a set of type {(ty)set} and {t} is a value of the base type {ty}. The first argument to {IN_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion, the function {IN_CONV} returns a conversion that maps a term of the form {"t IN {{t1,...,tn}}"} to the theorem { |- t IN {{t1,...,tn}} = T } \noindent if {t} is alpha-equivalent to any {ti}, or if the supplied conversion proves {|- (t = ti) = T} for any {ti}. If the supplied conversion proves {|- (t = ti) = F} for every {ti}, then the result is the theorem { |- t IN {{t1,...,tn}} = F } \noindent In all other cases, {IN_CONV} will fail. \EXAMPLE In the following example, the conversion {num_EQ_CONV} is supplied as a parameter and used to test equality of the candidate element {1} with the actual elements of the given set. { #IN_CONV num_EQ_CONV "2 IN {{0,SUC 1,3}}";; |- 2 IN {{0,SUC 1,3}} = T } \noindent The result is {T} because {num_EQ_CONV} is able to prove that {2} is equal to {SUC 1}. An example of a negative result is: { #IN_CONV num_EQ_CONV "1 IN {{0,2,3}}";; |- 1 IN {{0,2,3}} = F } \noindent Finally the behaviour of the supplied conversion is irrelevant when the value to be tested for membership is alpha-equivalent to an actual element: { #IN_CONV NO_CONV "1 IN {{3,2,1}}";; |- 1 IN {{3,2,1}} = T } \noindent The conversion {NO_CONV} always fails, but {IN_CONV} is nontheless able in this case to prove the required result. \FAILURE {IN_CONV conv} fails if applied to a term that is not of the form {"t IN {{t1,...,tn}}"}. A call {IN_CONV conv "t IN {{t1,...,tn}}"} fails unless the term {t} is alpha-equivalent to some {ti}, or {conv "t = ti"} returns {|- (t = ti) = T} for some {ti}, or {conv "t = ti"} returns {|- (t = ti) = F} for every {ti}. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/UNION_CONV.doc0000640000212700021270000000462605135613362021127 0ustar cammcamm\DOC UNION_CONV \TYPE {UNION_CONV : conv -> conv} \SYNOPSIS Reduce {{{t1,...,tn}} UNION s} to {t1 INSERT (... (tn INSERT s))}. \LIBRARY sets \DESCRIBE The function {UNION_CONV} is a parameterized conversion for reducing sets of the form {"{{t1,...,tn}} UNION s"}, where {{{t1,...,tn}}} and {s} are sets of type {(ty)set}. The first argument to {UNION_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion, the function {UNION_CONV} returns a conversion that maps a term of the form {"{{t1,...,tn}} UNION s"} to the theorem { |- t UNION {{t1,...,tn}} = ti INSERT ... (tj INSERT s) } \noindent where {{{ti,...,tj}}} is the set of all terms {t} that occur as elements of {{{t1,...,tn}}} for which the conversion {IN_CONV conv} fails to prove that {|- (t IN s) = T} (that is, either by proving {|- (t IN s) = F} instead, or by failing outright). \EXAMPLE In the following example, {num_EQ_CONV} is supplied as a parameter to {UNION_CONV} and used to test for membership of each element of the first finite set {{{1,2,3}}} of the union in the second finite set {{{SUC 0,3,4}}}. { #UNION_CONV num_EQ_CONV "{{1,2,3}} UNION {{SUC 0,3,4}}";; |- {{1,2,3}} UNION {{SUC 0,3,4}} = {{2,SUC 0,3,4}} } \noindent The result is {{{2,SUC 0,3,4}}}, rather than {{{1,2,SUC 0,3,4}}}, because {UNION_CONV} is able by means of a call to { IN_CONV num_EQ_CONV "1 IN {{SUC 0,3,4}}" } \noindent to prove that {1} is already an element of the set {{{SUC 0,3,4}}}. The conversion supplied to {UNION_CONV} need not actually prove equality of elements, if simplification of the resulting set is not desired. For example: { #UNION_CONV NO_CONV "{{1,2,3}} UNION {{SUC 0,3,4}}";; |- {{1,2,3}} UNION {{SUC 0,3,4}} = {{1,2,SUC 0,3,4}} } \noindent In this case, the resulting set is just left unsimplified. Moreover, the second set argument to {UNION} need not be a finite set: { #UNION_CONV NO_CONV "{{1,2,3}} UNION s";; |- {{1,2,3}} UNION s = 1 INSERT (2 INSERT (3 INSERT s)) } \noindent And, of course, in this case the conversion argument to {UNION_CONV} is irrelevant. \FAILURE {UNION_CONV conv} fails if applied to a term not of the form {"{{t1,...,tn}} UNION s"}. \SEEALSO IN_CONV. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/DELETE_CONV.doc0000640000212700021270000000371705136110407021172 0ustar cammcamm\DOC DELETE_CONV \TYPE {DELETE_CONV : conv -> conv} \SYNOPSIS Reduce {{{x1,...,xn}} DELETE x} by deleting {x} from {{{x1,...,xn}}}. \LIBRARY sets \DESCRIBE The function {DELETE_CONV} is a parameterized conversion for reducing finite sets of the form {"{{t1,...,tn}} DELETE t"}, where {{{t1,...,tn}}} is a set of type {(ty)set} and {t} is a term of type {ty}. The first argument to {DELETE_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion {conv}, the function {DELETE_CONV} returns a conversion that maps a term of the form {"{{t1,...,tn}} DELETE t"} to the theorem { |- {{t1,...,tn}} DELETE t = {{ti,...,tj}} } \noindent where {{{ti,...,tj}}} is the subset of {{{t1,...,tn}}} for which the supplied equality conversion {conv} proves { |- (ti = t) = F, ..., |- (tj = t) = F } \noindent and for all the elements {tk} in {{{t1,...,tn}}} but not in {{{ti,...,tj}}}, either {conv} proves {|- (tk = t) = T} or {tk} is alpha-equivalent to {t}. That is, the reduced set {{{ti,...,tj}}} comprises all those elements of the original set that are provably not equal to the deleted element {t}. \EXAMPLE In the following example, the conversion {num_EQ_CONV} is supplied as a parameter and used to test equality of the deleted value {2} with the elements of the set. { #DELETE_CONV num_EQ_CONV "{{2,1,SUC 1,3}} DELETE 2";; |- {{2,1,SUC 1,3}} DELETE 2 = {{1,3}} } \FAILURE {DELETE_CONV conv} fails if applied to a term not of the form {"{{t1,...,tn}} DELETE t"}. A call {DELETE_CONV conv "{{t1,...,tn}} DELETE t"} fails unless for each element {ti} of the set {{{t1,...,tn}}}, the term {t} is either alpha-equivalent to {ti} or {conv "ti = t"} returns {|- (ti = t) = T} or {|- (ti = t) = F}. \SEEALSO INSERT_CONV. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/FINITE_CONV.doc0000640000212700021270000000105705115421462021204 0ustar cammcamm\DOC FINITE_CONV \TYPE {FINITE_CONV : conv} \SYNOPSIS Proves finiteness of sets of the form {"{{x1,...,xn}}"}. \LIBRARY sets \DESCRIBE The conversion {FINITE_CONV} expects its term argument to be an assertion of the form {"FINITE {{x1,...,xn}}"}. Given such a term, the conversion returns the theorem { |- FINITE {{x1,...,xn}} = T } \EXAMPLE { #FINITE_CONV "FINITE {{1,2,3}}";; |- FINITE{{1,2,3}} = T #FINITE_CONV "FINITE ({{}}:num set)";; |- FINITE{{}} = T } \FAILURE Fails if applied to a term not of the form {"FINITE {{x1,...,xn}}"}. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/SET_SPEC_CONV.doc0000640000212700021270000000175105115421474021477 0ustar cammcamm\DOC SET_SPEC_CONV \TYPE {SET_SPEC_CONV : conv} \SYNOPSIS Axiom-scheme of specification for set abstractions. \LIBRARY sets \DESCRIBE The conversion {SET_SPEC_CONV} expects its term argument to be an assertion of the form {"t IN {{E | P}}"}. Given such a term, the conversion returns a theorem that defines the condition under which this membership assertion holds. When {E} is just a variable {v}, the conversion returns: { |- t IN {{v | P}} = P[t/v] } \noindent and when {E} is not a variable but some other expression, the theorem returned is: { |- t IN {{E | P}} = ?x1...xn. (t = E) /\ P } \noindent where {x1}, ..., {xn} are the variables that occur free both in the expression {E} and in the proposition {P}. \EXAMPLE { #SET_SPEC_CONV "12 IN {{n | n > N}}";; |- 12 IN {{n | n > N}} = 12 > N #SET_SPEC_CONV "p IN {{(n,m) | n < m}}";; |- p IN {{(n,m) | n < m}} = (?n m. (p = n,m) /\ n < m) } \FAILURE Fails if applied to a term that is not of the form {"t IN {{E | P}}"}. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/IMAGE_CONV.doc0000640000212700021270000000760305136110466021055 0ustar cammcamm\DOC IMAGE_CONV \TYPE {IMAGE_CONV : conv -> conv -> conv} \SYNOPSIS Compute the image of a function on a finite set. \LIBRARY sets \DESCRIBE The function {IMAGE_CONV} is a parameterized conversion for computing the image of a function {f:ty1->ty2} on a finite set {"{{t1,...,tn}}"} of type {(ty1)set}. The first argument to {IMAGE_CONV} is expected to be a conversion that computes the result of applying the function {f} to each element of this set. When applied to a term {"f ti"}, this conversion should return a theorem of the form {|- (f ti) = ri}, where {ri} is the result of applying the function {f} to the element {ti}. This conversion is used by {IMAGE_CONV} to compute a theorem of the form { |- IMAGE f {{t1,...,tn}} = {{r1,...,rn}} } \noindent The second argument to {IMAGE_CONV} is used (optionally) to simplify the resulting image set {{{r1,...,rn}}} by removing redundant occurrences of values. This conversion expected to decide equality of values of the result type {ty2}; given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty2}, the conversion should return either {|- (e1 = e2) = T} or {|- (e1 = e2) = F}, as appropriate. Given appropriate conversions {conv1} and {conv2}, the function {IMAGE_CONV} returns a conversion that maps a term of the form {"IMAGE f {{t1,...,tn}}"} to the theorem { |- IMAGE f {{t1,...,tn}} = {{rj,...,rk}} } \noindent where {conv1} proves a theorem of the form {|- (f ti) = ri} for each element {ti} of the set {{{t1,...,tn}}}, and where the set {{{rj,...,rk}}} is the smallest subset of {{{r1,...,rn}}} such no two elements are alpha-equivalent and {conv2} does not map {"rl = rm"} to the theorem {|- (rl = rm) = T} for any pair of values {rl} and {rm} in {{{rj,...,rk}}}. That is, {{{rj,...,rk}}} is the set obtained by removing multiple occurrences of values from the set {{{r1,...,rn}}}, where the equality conversion {conv2} (or alpha-equivalence) is used to determine which pairs of terms in {{{r1,...,rn}}} are equal. \EXAMPLE The following is a very simple example in which {REFL} is used to construct the result of applying the function {f} to each element of the set {{{1,2,1,4}}}, and {NO_CONV} is the supplied `equality conversion'. { #IMAGE_CONV REFL NO_CONV "IMAGE (f:num->num) {{1,2,1,4}}";; |- IMAGE f{{1,2,1,4}} = {{f 2,f 1,f 4}} } \noindent The result contains only one occurrence of `{f 1}', even though {NO_CONV} always fails, since {IMAGE_CONV} simplifies the resulting set by removing elements that are redundant up to alpha-equivalence. For the next example, we construct a conversion that maps {SUC n} for any numeral {n} to the numeral standing for the successor of {n}. { #let SUC_CONV tm = let n = int_of_string(fst(dest_const(rand tm))) in let sucn = mk_const(string_of_int(n+1), ":num") in SYM (num_CONV sucn);; SUC_CONV = - : conv } \noindent The result is a conversion that inverts {num_CONV}: { #num_CONV "4";; |- 4 = SUC 3 #SUC_CONV "SUC 3";; |- SUC 3 = 4 } \noindent The conversion {SUC_CONV} can then be used to compute the image of the successor function on a finite set: { #IMAGE_CONV SUC_CONV NO_CONV "IMAGE SUC {{1,2,1,4}}";; |- IMAGE SUC{{1,2,1,4}} = {{3,2,5}} } \noindent Note that {2} (= {SUC 1}) appears only once in the resulting set. Fianlly, here is an example of using {IMAGE_CONV} to compute the image of a paired addition function on a set of pairs of numbers: { #IMAGE_CONV (PAIRED_BETA_CONV THENC ADD_CONV) num_EQ_CONV "IMAGE (\(n,m).n+m) {{(1,2), (3,4), (0,3), (1,3)}}";; |- IMAGE(\(n,m). n + m){{(1,2),(3,4),(0,3),(1,3)}} = {{7,3,4}} } \FAILURE {IMAGE_CONV conv1 conv2} fails if applied to a term not of the form {"IMAGE f {{t1,...,tn}}"}. An application of {IMAGE_CONV conv1 conv2} to a term {"IMAGE f {{t1,...,tn}}"} fails unless for all {ti} in the set {{{t1,...,tn}}}, evaluating {conv1 "f ti"} returns {|- (f ti) = ri} for some {ri}. \ENDDOC hol88-2.02.19940316/Library/sets/help/entries/SET_INDUCT_TAC.doc0000640000212700021270000000231205136111745021567 0ustar cammcamm\DOC SET_INDUCT_TAC \TYPE {SET_INDUCT_TAC : tactic} \SYNOPSIS Tactic for induction on finite sets. \LIBRARY sets \DESCRIBE {SET_INDUCT_TAC} is an induction tacic for proving properties of finite sets. When applied to a goal of the form { !s. FINITE s ==> P[s] } \noindent {SET_INDUCT_TAC} reduces this goal to proving that the property {\s.P[s]} holds of the empty set and is preserved by insertion of an element into an arbitrary finite set. Since every finite set can be built up from the empty set {"{{}}"} by repeated insertion of values, these subgoals imply that the property {\s.P[s]} holds of all finite sets. The tactic specification of {SET_INDUCT_TAC} is: { A ?- !s. FINITE s ==> P ========================================================== SET_INDUCT_TAC A |- P[{{}}/s] A u {{FINITE s', P[s'/s], ~e IN s'}} ?- P[e INSERT s'/s] } \noindent where {e} is a variable chosen so as not to appear free in the assumptions {A}, and {s'} is a primed variant of {s} that does not appear free in {A} (usually, {s'} is just {s}). \FAILURE {SET_INDUCT_TAC (A,g)} fails unless {g} has the form {!s. FINITE s ==> P}, where the variable {s} has type {(ty)set} for some type {ty}. \ENDDOC hol88-2.02.19940316/Library/sets/Manual/0000750000212700021270000000000005535606116015531 5ustar cammcammhol88-2.02.19940316/Library/sets/Manual/description.tex0000640000212700021270000016473405145043077020614 0ustar cammcamm\chapter{The sets Library} The \HOL\ \ml{sets} library contains a theory of sets based on a defined logical type \ml{(*)set}, values of which are collections or `sets' of elements of type \ml{*}. The library was originally written in June 1989 by Philippe Leveilley. Since then, it has been completely revised and extended with new theorems by the present author. There is only one theory in the library, namely the theory `\ml{sets}', which contains all the definitions and theorems in the \ml{sets} library. This document explains the logical basis of the \ml{sets} library and describes the theorem-proving support it provides. This includes conversions for expanding set specifications and for evaluating various operations on finite sets described by enumeration of their elements. The library also provides parser and pretty-printer support for terms that denote sets. \section{The type definition}\index{definition!of (*)set@of {\ptt (*)set}|(} The basis of the library is the polymorphic type of sets \ml{(*)set}, which is defined in the library theory \ml{sets}. Values of this type are not true sets, but just unordered collections of values of the base type \ml{*}. The type \ml{(*)set} is, in fact, just an object-language abbreviation for the type \ml{*->bool}, values of which are predicates on \ml{*}. The elements of a set \ml{S:(*)set} are just those values of type \ml{*} for which the corresponding predicate is true. The type \ml{(*)set} is defined formally in the library by the type definition: \begin{hol} \index{set\_TY\_DEF@{\ptt set\_TY\_DEF}} \begin{verbatim} set_TY_DEF |- ?rep:(*)set -> (* -> bool). TYPE_DEFINITION(\p. T)rep \end{verbatim}\end{hol} \noindent This definitional axiom asserts the existence of a bijection \ml{rep} between sets with elements of type \ml{*} and the set of all predicates on \ml{*}. In the library theory \ml{sets}, a pair of constant functions is introduced using the built-in function \ml{define\_new\_type\_bijections}\index{define\_new\_type\_bijections@{\ptt define\_new\_type\_bijections}} to denote this bijection and its inverse: \begin{hol} \index{SPEC@{\ptt SPEC}} \index{CHF@{\ptt CHF}} \begin{alltt} CHF : (*)set -> (* -> bool) {\normalsize\rm and} SPEC : (* -> bool) -> (*)set \end{alltt}\end{hol} \noindent {\samepage The defining property of these constants is the constant specification \ml{set\_ISO\_DEF}\index{set\_ISO\_DEF@{\ptt set\_ISO\_DEF}}: \begin{hol} \index{definition!of CHF@of {\ptt CHF}} \index{definition!of SPEC@of {\ptt SPEC}} \begin{verbatim} |- (!a. SPEC(CHF a) = a) /\ (!r. (\p. T)r = (CHF(SPEC r) = r)) \end{verbatim}\end{hol} \noindent which states that \ml{CHF} and \ml{SPEC} are} the inverses of one another. These two functions can be used to move freely between sets and the predicates to which they correspond; the function \ml{CHF} maps a set to its characteristic predicate, and \ml{SPEC} maps a predicate to the set of values for which it holds. The\index{naming conventions!for definitions|(} theorems \ml{set\_TY\_DEF} and \ml{set\_ISO\_DEF} shown above are named according to the general convention that all definitions in the \ml{sets} library are given names ending in `{\small\verb!_DEF!}'.\index{naming conventions!for definitions|)}% \index{definition!of (*)set@of {\ptt (*)set}|)} \section{Membership and the axioms of set theory} A value \ml{x} is defined to be an element of a set exactly when the characteristic predicate of the set is true of \ml{x}. The bijection \ml{CHF} just maps sets to their characteristic predicates, so this membership relation for sets is straightforward to define\index{definition!of IN@of {\ptt IN}} as follows: \begin{hol} \index{IN\_DEF@{\ptt IN\_DEF}} \begin{verbatim} IN_DEF |- !x s. x IN s = CHF s x \end{verbatim}\end{hol} \noindent The infix function constant \ml{IN} defined here is essentially just an abbreviation for \ml{CHF}. The functions \ml{IN} and \ml{SPEC} (introduced above) constitute the basic language for the theory of sets in the \ml{sets} library; all operators and predicates on sets are ultimately defined in terms of these two functions. The first significant theorem in the \ml{sets} library states what is usually called the {\it axiom of extension\/}\index{axiom of extension} for sets. This is not, of course, an {\it axiom\/} of the \ml{sets} theory, but rather a theorem: \begin{hol} \index{EXTENSION@{\ptt EXTENSION}} \begin{verbatim} EXTENSION |- !s t. (s = t) = (!x. x IN s = x IN t) \end{verbatim}\end{hol} \noindent \ml{EXTENSION} states that two sets are equal exactly when they have the same elements. This follows directly from the definition of \ml{IN} and the fact that the function \ml{CHF} has a left inverse and is therefore injective. The second main theorem in the library concerns the function \ml{SPEC}. This function maps an arbitrary predicate \ml{P:(*->bool)} on values of type \ml{*} to the set of all values \ml{x:*} such that \ml{P x} is true. The \ml{SPEC} function can therefore be used to construct sets from predicates that describe or `specify' their elements. A value is in the constructed set exactly when the predicate is true of that value: \begin{hol} \index{SPECIFICATION@{\ptt SPECIFICATION}} \begin{verbatim} SPECIFICATION |- !P x. x IN (SPEC P) = P x \end{verbatim}\end{hol} \noindent This theorem corresponds to what is usually called the {\it axiom of specification\/}\index{axiom of specification} for sets. It follows directly from the definition of \ml{IN} and the fact that \ml{CHF} is the left inverse of \ml{SPEC}. Once the theorems \ml{EXTENSION} and \ml{SPECIFICATION} have been proved, they provide a complete basis for all further reasoning about sets. Given these two theorems, users of the library should never have to appeal to the definition of \ml{IN} or make use of the theorems in the previous section about the formal definition of the type \ml{(*)set}. The library theory \ml{sets} itself is developed entirely on the basis of these two `axioms' of set theory. \section{Generalized set specifications} In addition to the basic function \ml{SPEC}, which allows one to construct a set from a predicate that specifies its elements, the \ml{sets} library also provides way of constructing sets from more general forms of set specifications. Roughly speaking, there are two components to a generalized set specification: an expression \ml{E[x]} and a predicate \ml{P[x]}. For any such expression and predicate, there is a corresponding set {\small\verb!{E[x] | P[x]}!}, the set of all values {\small\verb!E[x]!} for which {\small\verb!P[x]!} holds. The \ml{sets} library supports generalized set specifications by means of the constant: \begin{hol} \index{GSPEC@{\ptt GSPEC}} \begin{verbatim} GSPEC : (** -> (* # bool)) -> (*)set \end{verbatim}\end{hol} \noindent The function \ml{GSPEC} takes a function \ml{f : ** -> (* \# bool)} and constructs the set of all values \ml{FST(f x)} for which \ml{SND(f x)} holds, for some value \ml{x} of type \ml{**}. The formal definition of the constant \ml{GSPEC} is: \begin{hol} \index{definition!of GSPEC@of {\ptt GSPEC}} \index{GSPEC\_DEF@{\ptt GSPEC\_DEF}} \begin{verbatim} GSPEC_DEF |- !f. GSPEC f = SPEC(\y. ?x. (y,T) = f x) \end{verbatim}\end{hol} \noindent The following analogue to the axiom of specification\index{axiom of specification!for generalized set specifications} for \ml{SPEC} follows immediately from this definition: \begin{hol} \index{GSPECIFICATION@{\ptt GSPECIFICATION}} \begin{verbatim} GSPECIFICATION |- !f v. v IN (GSPEC f) = (?x. v,T = f x) \end{verbatim}\end{hol} \noindent This states that a value \ml{v} is an element of the set specified by \ml{f} exactly when \ml{v} is one of the values of \ml{FST(f x)} for which \ml{SND(f x)} is true. To see how this supports the notion of generalized set specification described above, let \ml{f} in this definition be the function {\small\verb!\x.E[x],P[x]!}. With a little simplification, we would then have: \begin{hol} \begin{verbatim} |- !v. v IN (GSPEC \x.E[x],P[x]) = ?x. (v = E[x]) /\ P[x] \end{verbatim}\end{hol} \noindent That is, a value \ml{v} is in the set constructed by \ml{GSPEC} exactly when for some \ml{x} for which \ml{P[x]}, the value \ml{v} is equal to \ml{E[x]}. The constructed set therefore contains all values \ml{E[x]} for which \ml{P[x]} holds. \subsection{Parser and pretty-printer support}\label{abst} To facilitate the use of sets constructed by generalized set specification, the \ml{sets} library provides parser and pretty-printer support for set abstractions of the form {\small\verb!"{!$E$\verb! | !$P$\verb!}"!}. The built-in \ML\ function \ml{define\_set\_abstraction\_syntax}% \index{define\_set\_abstraction\_syntax@{\ptt define\_set\_abstraction\_syntax}} (see the manual~\cite{description} for details) is used to introduce this \mbox{notation} when the library is loaded. The call made to this function extends the \HOL\ parser so that a quotation of the form {\small\verb!"{!$E$\verb! | !$P$\verb!}"!} {\samepage parses to: \begin{hol} \begin{alltt} GSPEC (\bk(\m{x\sb{1}},\(\dots\),\m{x\sb{n}}).(\(E\),\(P\))) \end{alltt} \end{hol} \noindent where $x_1$, \dots, $x_n$ are} the variables that occur free in both the expression $E$ and the proposition $P$ (i.e.\ the set $\{x_1,\dots,x_n\}$ is the intersection of the set of free variables of $E$ and the set of free variables of $P$). If there are {\it no\/} variables free in both $E$ and $P$, then a parser error is generated. When the \ml{print\_set}\index{print\_set@{\ptt print\_set} (flag)} flag is \ml{true}, the quotation pretty-printer inverts this transformation. A simple example of this set abstraction notation is shown in the following \HOL\ session, in which it is assumed that the \ml{sets} library has already been loaded. (See section~\ref{using} for a description of how \ml{sets} is loaded.) \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #let gtr = new_definition (`gtr`, "gtr N = {n | n > N}");; gtr = |- !N. gtr N = {n | n > N} #set_flag (`print_set`,false);; true : bool #"{n | n > N}";; "GSPEC(\n. (n,n > N))" : term \end{verbatim}\end{session} \noindent The term {\small\verb!{n | n > N}!} in the definition of \ml{gtr} denotes the set of all natural numbers greater than \ml{N}. It is important to note that the variable \ml{N} is a free variable in this term, since it occurs on only one side of the bar `{\small\verb!|!}'. The set abstraction {\small\verb!{n | n > N}!} therefore parses to the generalized set specification \begin{hol}\begin{verbatim} GSPEC(\n. (n,n > N)) \end{verbatim}\end{hol} \noindent This is what gives this set abstraction the (presumably intended) interpretation `the set of all \ml{n} greater than \ml{N}'. By contrast, the term \begin{hol}\begin{verbatim} GSPEC(\(n,N). (n,n > N)) \end{verbatim}\end{hol} \noindent denotes the set of all numbers \ml{n} greater than some number \ml{N}---i.e., the set $\{\ml{1},\ml{2},\ml{3},\dots\}$. This is {\it not\/} the default interpretation of the parser, which constructs a generalized set specification that binds the variable \ml{n} only. Note that only default interpretations are pretty-printed using the set abstraction notation: \begin{session}\begin{verbatim} #set_flag(`print_set`,true);; false : bool #"GSPEC (\n. (n,n>N))";; "{n | n > N}" : term #"GSPEC (\(n,N). (n,n>N))";; "GSPEC(\(n,N). (n,n > N))" : term \end{verbatim}\end{session} \noindent That is, a term of the form: \begin{hol}\begin{alltt} GSPEC (\bk(\m{x\sb{1}},\(\dots\),\m{x\sb{n}}).(\(E\),\(P\))) \end{alltt}\end{hol} \noindent prints as {\small\verb!"{!$E$\verb! | !$P$\verb!}"!} only if the \pagebreak[3] variables $x_1$, \dots, $x_n$ occur free in both $E$ and $P$. In general, the expression $E$ in a set abstraction {\small\verb!"{!$E$\verb! | !$P$\verb!}"!} need not be just a variable. Consider, for example, the following \HOL\ session: \begin{session}\begin{verbatim} #let S = "{(n,m) | n < m}";; S = "{(n,m) | n < m}" : term #set_flag(`print_set`,false);; true : bool #"{(n,m) | n < m}";; "GSPEC(\(n,m). ((n,m),n < m))" : term \end{verbatim}\end{session} \noindent Here, a set abstraction is used to construct the set of all pairs of numbers \ml{(n,m)} for which \ml{n} is less than \ml{m}. Note that both variables \ml{n} and \ml{m} are bound in the underlying generalized set specification. \subsection{Theorem-proving support} \index{SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|(} \index{conversions!SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|(} The \ml{sets} library provides proof support for the set abstraction notation in the form of a conversion called \ml{SET\_SPEC\_CONV}. This conversion implements the axiom of specification for set abstractions.% \index{axiom of specification!for set abstractions} When $v$ is a variable, evaluating: \begin{hol}\def\m#1{\mbox{\small$#1$}}\begin{alltt} SET_SPEC_CONV "\m{t} IN \lb\m{v} \vb \m{P}\rb";; \end{alltt}\end{hol} \noindent returns the theorem: \begin{hol}\def\m#1{\mbox{\small$#1$}}\begin{alltt} {\vb}- \m{t} IN \lb\m{v} \vb \m{P}\rb = \m{P[t/v]} \end{alltt}\end{hol} \noindent This states that $t$ is an element of the set of all $v$ such that $P$ exactly when $P[t/v]$ holds. Note that, in general, the term $t$ need not be a variable. The following session illustrates this use of \ml{SET\_SPEC\_CONV} for membership in a particular set abstraction: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #SET_SPEC_CONV "12 IN {n | n > N}";; |- 12 IN {n | n > N} = 12 > N \end{verbatim}\end{session} The conversion \ml{SET\_SPEC\_CONV} behaves differently when applied to terms of the form {\small\verb!"!$t$\verb! IN {!$E$\verb! | !$P$\verb!}"!} where {\small $E$} is not a variable. Applying the conversion to a term of this kind yields the theorem: \begin{hol}\def\m#1{\mbox{\small$#1$}}\begin{alltt} {\vb}- \m{t} IN \lb\m{E} \vb \m{P}\rb = ?\m{x\sb{1}\dots x\sb{n}}. (\m{t} = \m{E}) /\bk \m{P} \end{alltt}\end{hol} \noindent where $x_1$, \dots, $x_n$ are the variables that occur free in both $E$ and $P$. The expression $E$ cannot in general be eliminated in this case, as it can by the substitution $P[t/v]$ when $E$ is just a variable $v$. \pagebreak[3] The following session illustrates the form of the theorem proved by \ml{SET\_SPEC\_CONV} for the second type of input term discussed above: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #let th1 = SET_SPEC_CONV "p IN {(n,m) | n < m}";; th1 = |- p IN {(n,m) | n < m} = (?n m. (p = n,m) /\ n < m) #let th2 = SET_SPEC_CONV "(a,b) IN {(n,m) | n < m}";; th2 = |- (a,b) IN {(n,m) | n < m} = (?n m. (a,b = n,m) /\ n < m) #let th3 = SET_SPEC_CONV "a IN {n + m | n < m}";; th3 = |- a IN {n + m | n < m} = (?n m. (a = n + m) /\ n < m) \end{verbatim}\end{session} \noindent The right-hand sides of \ml{th1} and \ml{th2} could, in principle, be further simplified. The value of the expression `\ml{(n,m)}' is an injective function of the values of \ml{n} and \ml{m}, and so by eliminating the existential quantifiers these two theorems could be simplified to: \begin{hol}\begin{verbatim} th1 |- p IN {(n,m) | n < m} = (FST p < SND p) th2 |- (a,b) IN {(n,m) | n < m} = (a < b) \end{verbatim}\end{hol} \noindent But in general the value of {\small $E$} in a set abstraction {\small\verb!"{!$E$\verb! | !$P$\verb!}"!} will not be an injective function of its free variables, as for example is the case in theorem \ml{th3}. The conversion \ml{SET\_SPEC\_CONV} therefore attempts no further simplification of its result than is described above for the general case.\index{SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|)}% \index{conversions!SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|)} \section{The empty and universal sets} The following two set-valued constants are defined in the \ml{sets} library: \ml{EMPTY:(*)set}, which denotes the empty set; and \ml{UNIV:(*)set}, which denotes the universe, or set of all values of type \ml{*}. These constants are defined formally as follows: \begin{hol} \index{definition!of EMPTY@of {\ptt EMPTY}} \index{EMPTY\_DEF@{\ptt EMPTY\_DEF}} \index{definition!of UNIV@of {\ptt UNIV}} \index{UNIV\_DEF@{\ptt UNIV\_DEF}} \begin{verbatim} EMPTY_DEF |- EMPTY = SPEC(\x. F) UNIV_DEF |- UNIV = SPEC(\x. T) \end{verbatim}\end{hol} \noindent Note that because of the restriction on free variables discussed above, the set abstractions {\small\verb!"{x | T}"!} and {\small\verb!"{x | F}"!} cannot be used in these definitions; the more primitive form of set construction provided by \ml{SPEC} must be used instead. But users of the library will never need to appeal to these definitions, since the following theorems about \ml{EMPTY} and \ml{UNIV} are also made available in the theory \ml{sets}: \begin{hol} \index{NOT\_IN\_EMPTY@{\ptt NOT\_IN\_EMPTY}} \index{IN\_UNIV@{\ptt IN\_UNIV}} \begin{verbatim} NOT_IN_EMPTY |- !x. ~x IN EMPTY IN_UNIV |- !x. x IN UNIV \end{verbatim}\end{hol} \noindent That is, nothing is an element of \ml{EMPTY} and everything is an element of \ml{UNIV}. These properties follow directly from the definitions and the theorem \ml{SPECIFICATION}. Other pre-proved theorems about the empty and universal sets are also available in the library; see chapter~\ref{theorems} for a complete list. \section{Set inclusion} The infix functions \ml{SUBSET} and \ml{PSUBSET} denote the binary relations of set inclusion and proper set inclusion, respectively. These are defined formally in the obvious way: \begin{hol} \index{definition!of SUBSET@of {\ptt SUBSET}} \index{SUBSET\_DEF@{\ptt SUBSET\_DEF}} \index{definition!of PSUBSET@of {\ptt PSUBSET}} \index{PSUBSET\_DEF@{\ptt PSUBSET\_DEF}} \begin{verbatim} SUBSET_DEF |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) PSUBSET_DEF |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) \end{verbatim}\end{hol} \noindent That is, \ml{s} is a subset of \ml{t} if every element of \ml{s} is also an element of \ml{t}; and \ml{s} is a proper subset of \ml{t} if it is a subset of \ml{t} but not equal to \ml{t}. Various pre-proved theorems about the subset and proper subset relations are supplied by the \ml{sets} library. For example, the fact that \ml{SUBSET} is a partial order is stated by the three built-in theorems shown below. \begin{hol} \index{SUBSET\_TRANS@{\ptt SUBSET\_TRANS}} \index{SUBSET\_REFL@{\ptt SUBSET\_REFL}} \index{SUBSET\_ANTISYM@{\ptt SUBSET\_ANTISYM}} \begin{verbatim} SUBSET_REFL |- !s. s SUBSET s SUBSET_TRANS |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u SUBSET_ANTISYM |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) \end{verbatim}\end{hol} \noindent Also provided are built-in theorems about the relationship between set inclusion and other constants or operations on sets. For example, there are the following facts about set inclusion and the empty and universal sets: \begin{hol} \index{EMPTY\_SUBSET@{\ptt EMPTY\_SUBSET}} \index{SUBSET\_UNIV@{\ptt SUBSET\_UNIV}} \index{NOT\_PSUBSET\_EMPTY@{\ptt NOT\_PSUBSET\_EMPTY}} \index{NOT\_UNIV\_PSUBSET@{\ptt NOT\_UNIV\_PSUBSET}} \begin{verbatim} EMPTY_SUBSET |- !s. {} SUBSET s SUBSET_UNIV |- !s. s SUBSET UNIV NOT_PSUBSET_EMPTY |- !s. ~s PSUBSET {} NOT_UNIV_PSUBSET |- !s. ~UNIV PSUBSET s \end{verbatim}\end{hol} \noindent As\index{naming conventions!for theorems generally|(} these examples illustrate, the names of theorems in the \ml{sets} library are generally constructed from the names of the constants they contain. Furthermore, the ordering of elements in the name of a theorem attempts to reflect the content of the theorem itself.\index{naming conventions!for theorems generally|)} \section{Union, intersection, and set difference} The binary operations of union, intersection and set difference are all defined using the set abstraction notation introduced above in section~\ref{abst}. The formal definitions are: \begin{hol} \index{definition!of UNION@of {\ptt UNION}} \index{UNION\_DEF@{\ptt UNION\_DEF}} \index{definition!of INTER@of {\ptt INTER}} \index{INTER\_DEF@{\ptt INTER\_DEF}} \index{definition!of DIFF@of {\ptt DIFF}} \index{DIFF\_DEF@{\ptt DIFF\_DEF}} \begin{verbatim} UNION_DEF |- !s t. s UNION t = {x | x IN s \/ x IN t} INTER_DEF |- !s t. s INTER t = {x | x IN s /\ x IN t} DIFF_DEF |- !s t. s DIFF t = {x | x IN s /\ ~x IN t} \end{verbatim}\end{hol} \noindent These definitions illustrate the practical utility of the scheme for variable binding in set abstractions discussed above in section~\ref{abst}. An abstraction {\small\verb!"{!$E$\verb! | !$P$\verb!}"!} binds only the variables that occur in both {\small $E$} and {\small $P$}, and the variables \ml{s} and \ml{t} in the set abstractions shown above may therefore be made parameters to the sets\pagebreak[3] constructed by them. Using \ml{SET\_EQ\_CONV}, it is trivial to derive the following membership conditions for \ml{UNION}, \ml{INTER} and \ml{DIFF} from the definitions given above. As\index{naming conventions!for membership conditions|(} a general rule, theorems stating membership conditions of the kind illustrated by these examples are given names of the form {\small\verb!IN_!$\langle\hbox{\it constant\/}\rangle$} ending in the name of the operation used to construct the set in question.\index{naming conventions!for membership conditions|)} \begin{hol} \index{IN\_UNION@{\ptt IN\_UNION}} \index{IN\_INTER@{\ptt IN\_INTER}} \index{IN\_DIFF@{\ptt IN\_DIFF}} \begin{verbatim} IN_UNION |- !s t x. x IN (s UNION t) = x IN s \/ x IN t IN_INTER |- !s t x. x IN (s INTER t) = x IN s /\ x IN t IN_DIFF |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t \end{verbatim}\end{hol} \noindent These theorems, which are saved in the library under the names indicated above, may in practice be used as the defining properties of union, intersection and set difference; users should almost never have to appeal directly to the definitions of these operations. Other built-in theorems about \ml{UNION}, \ml{INTER} and \ml{DIFF} may be found in chapter~\ref{theorems}. \section{Disjoint sets} Two sets are {\it disjoint\/} if they have no elements in common. This concept is formalized in the \ml{sets} library by the constant \ml{DISJOINT}, the definition of which is: \begin{hol} \index{definition!of DISJOINT@of {\ptt DISJOINT}} \index{DISJOINT\_DEF@{\ptt DISJOINT\_DEF}} \begin{verbatim} DISJOINT_DEF |- !s t. DISJOINT s t = (s INTER t = {}) \end{verbatim}\end{hol} \noindent At present, there are relatively few pre-proved theorems about the \ml{DISJOINT} relation in the library. But see chapter~\ref{theorems} for the few theorems about \ml{DISJOINT} that are in fact available in the \ml{sets} library. \section{Insertion and deletion of an element} To aid in the construction of particular sets of values (especially finite sets) the library contains definitions of two constants \ml{INSERT} and \ml{DELETE}. These denote the operations of augmenting a set with a given value and removing a value from a set, respectively. The formal definitions of these operations are: \begin{hol} \index{definition!of INSERT@of {\ptt INSERT}} \index{INSERT\_DEF@{\ptt INSERT\_DEF}} \index{definition!of DELETE@of {\ptt DELETE}} \index{DELETE\_DEF@{\ptt DELETE\_DEF}} \begin{verbatim} INSERT_DEF |- !x s. x INSERT s = {y | (y = x) \/ y IN s} DELETE_DEF |- !s x. s DELETE x = s DIFF (INSERT x EMPTY) \end{verbatim}\end{hol} \noindent The elements of the set denoted by {\small\verb!x INSERT s!} are all the elements of the set \ml{s} together with the value \ml{x}, which may or may not be an element of \ml{s} itself. The set denoted by {\small\verb!s DELETE x!} contains all the elements of \ml{s} except the value \ml{x}. {\samepage The membership conditions for sets constructed using \ml{INSERT} and \ml{DELETE} are given by the following pre-proved theorems: \begin{hol} \index{IN\_INSERT@{\ptt IN\_INSERT}} \index{IN\_DELETE@{\ptt IN\_DELETE}} \begin{verbatim} IN_INSERT |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s IN_DELETE |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) \end{verbatim}\end{hol} \noindent In addition, the library} contains a substantial collection of theorems about the relationship between the operations \ml{INSERT} and \ml{DELETE} and other relations and operations on sets. Chapter~\ref{theorems} gives a complete list of these theorems. \subsection{Parser and pretty-printer support}\label{finite} The \ml{sets} library provides special parser and pretty-printer support for finite sets that are constructed by enumeration of their elements. This notation is introduced by a call made when the library is loaded to the built-in \ML\ function \ml{define\_finite\_set\_syntax}% \index{define\_finite\_set\_syntax@{\ptt define\_finite\_set\_syntax}} (see~\cite{description} for details of this function). This has the effect of extending the \HOL\ parser so that a quotation of the form {\small\verb!"{!\tt$t_1$,$t_2$,\dots,$t_n$\verb!}"!} parses to the following set built up from \ml{EMPTY} by repeatedly using the function \ml{INSERT}: \begin{hol}\begin{alltt} INSERT \m{t\sb{1}} (INSERT \m{t\sb{2}} \dots (INSERT \m{t\sb{n}} EMPTY)\dots) \end{alltt}\end{hol} \noindent Note that the quotation {\small\verb!"{}"!} just parses to the constant \ml{EMPTY}. When the \ml{print\_set}\index{print\_set@{\ptt print\_set} (flag)} flag is \ml{true}, the \HOL\ pretty-printer for terms inverts this transformation. Users should note that care must be taken with regard to the precedence of comma in a context {\small\verb!"{!\dots\verb!}"!}, as the following session illustrates: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #set_flag(`print_set`,false);; true : bool #"{1,2,3,4}";; "1 INSERT (2 INSERT (3 INSERT (4 INSERT EMPTY)))" : term #"{(1,2),(3,4)}";; "(1,2) INSERT ((3,4) INSERT EMPTY)" : term #"{((1,2),(3,4))}";; "((1,2),3,4) INSERT EMPTY" : term \end{verbatim}\end{session} \noindent Different grouping by means of enclosing parentheses has given sets with four elements (each a number), two elements (each of which is a pair), and one element (a pair of pairs) respectively. \subsection{Conversions for enumerated finite sets} The \ml{sets} library provides a collection of optimized conversions for computing the results of operations and predicates on finite sets specified by enumeration of their elements. All these conversions, the current implementations of which are somewhat experimental, are designed to work only for finite sets of the form {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!}. The sections that follow describe most of these conversions; the remainder are discussed in later sections of this manual. \subsubsection{Membership}\label{inconv} The\index{IN\_CONV@{\ptt IN\_CONV}|(}% \index{conversions!IN\_CONV@{\ptt IN\_CONV}|(} most basic conversion for finite sets is a decision procedure for membership called \ml{IN\_CONV}. In general, a way of deciding equality of elements is needed in order to determine whether a given value is an element of a particular finite set. The function \begin{hol}\begin{verbatim} IN_CONV : conv -> conv \end{verbatim}\end{hol} \noindent must therefore be supplied with a conversion that implements a decision procedure for equality of set elements. It is assumed that this conversion will map equations {\small\tt"$e_1$ = $e_2$"} between elements of a base type \ml{ty} to the theorem {\small\tt |- ($e_1$ = $e_2$) = T} or to the theorem {\small\tt |- ($e_1$ = $e_2$) = F}, as appropriate. If \ml{conv} is an equality conversion of the kind described above, then the function returned by \ml{IN\_CONV conv} is a conversion that decides membership in finite sets of values of the base type \ml{ty}. In particular, a call: \begin{hol}\begin{alltt} IN\_CONV conv "\m{t} IN \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb" \end{alltt}\end{hol} \noindent returns the theorem \begin{hol}\begin{alltt} |- \m{t} IN \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb = T \end{alltt}\end{hol} \noindent if the term $t$ is alpha-equivalent to some term $t_i$ or if the supplied conversion \ml{conv} proves {\tt |- ($t$ = $t_i$) = T} for some $i$ where $1 \leq i \leq n$. If, on the other hand \ml{conv} proves the theorem {\tt |- ($t$ = $t_i$) = F} for all $i$ where $1 \leq i \leq n$, then the result is the theorem \begin{hol}\begin{alltt} |- \m{t} IN \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb = F \end{alltt}\end{hol} \noindent In all other cases, the call to \ml{IN\_CONV} shown above will fail. The following session shows how \ml{IN\_CONV} can be used in practice. \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #IN_CONV num_EQ_CONV "1 IN {2,1,3}";; |- 1 IN {2,1,3} = T #IN_CONV num_EQ_CONV "4 IN {2,1,3}";; |- 4 IN {2,1,3} = F \end{verbatim}\end{session} \noindent The built-in conversion \ml{num\_EQ\_CONV} is used here to decide equality of the natural numbers involved in the membership assertions\pagebreak[3] being proved. An example in which \ml{IN\_CONV} fails is the following: \begin{session}\begin{verbatim} #IN_CONV num_EQ_CONV "x IN {1,2,3}";; evaluation failed IN_CONV #num_EQ_CONV "x = 1";; evaluation failed num_EQ_CONV \end{verbatim}\end{session} \noindent Failure occurs in this case because the term \ml{x} is a variable, and \ml{num\_EQ\_CONV} therefore cannot determine if it is equal to any of the set elements \ml{1}, \ml{2} or \ml{3}. Note, however, that the supplied conversion is not required to prove anything if the value being tested for membership happens to be syntactically identical to an element of the given set: \begin{session}\begin{verbatim} #IN_CONV NO_CONV "x IN {1,x,3}";; |- x IN {1,x,3} = T \end{verbatim}\end{session} \noindent In this case, the supplied conversion, namely \ml{NO\_CONV}, always fails; but the call to \ml{IN\_CONV} nonetheless succeeds and returns the appropriate result.\index{IN\_CONV@{\ptt IN\_CONV}|)}% \index{conversions!IN\_CONV@{\ptt IN\_CONV}|)} \subsubsection{Union} The\index{UNION\_CONV@{\ptt UNION\_CONV}|(}% \index{conversions!UNION\_CONV@{\ptt UNION\_CONV}|(} \ml{sets} library contains a conversion \begin{hol}\begin{verbatim} UNION_CONV : conv -> conv \end{verbatim}\end{hol} \noindent that can be used to compute the union of two finite sets. The first argument to \ml{UNION\_CONV} (i.e.\ the conversion argument) is expected to be an equality conversion of the same kind required as an argument by \ml{IN\_CONV} (see section~\ref{inconv}). As will be seen below, this conversion is used by \ml{UNION\_CONV} to simplify the set that it computes as the result of taking the union of two finite sets. Given an equality conversion \ml{conv}, the function \ml{UNION\_CONV} returns a conversion that computes the union of a finite set {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} and another set {\small$s$}. The second set {\small$s$} in fact need not be finite. Ignoring, for the moment, the possible simplification done using the supplied conversion \ml{conv}, a call: \begin{hol}\begin{alltt} UNION\_CONV conv "\lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb UNION \m{s}" \end{alltt}\end{hol} \noindent just returns the theorem \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb UNION \m{s} = \m{t\sb{1}} INSERT (\m{\dots} (\m{t\sb{n}} INSERT \m{s})\m{\dots}) \end{alltt}\end{hol} \noindent That is, \ml{UNION\_CONV} computes the required union as a repeated insertion of values into the set {\small$s$}.\pagebreak[3] When {\small$s$} is a finite set of the form {\small\verb!"{!\tt$u_1$,\dots,$u_m$\verb!}"!}, the {\samepage resulting theorem will have the form shown below. \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb UNION \lb\m{u\sb{1}},\dots,\m{u\sb{m}}\rb = \lb\m{t\sb{1}},\m{\dots},\m{t\sb{n}},\m{u\sb{1}},\m{\dots},\m{u\sb{m}}\rb \end{alltt}\end{hol} \noindent When computing} theorems of this form (i.e.\ when the second set of the union is a finite set {\small\verb!"{!\tt$u_1$,\dots,$u_m$\verb!}"!}) the function \ml{UNION\_CONV} attempts to remove redundant elements in the resulting set using the supplied equality conversion \ml{conv}. In particular, if \ml{conv} is able to prove that some element {\small$t_i$} of {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} is equal to any element {\small$u_j$} of {\small\verb!"{!\tt$u_1$,\dots,$u_m$\verb!}"!}, that is if the conversion \ml{conv} maps the term {\small\verb!"!$t_i$\verb! = !$u_j$\verb!"!} to the theorem {\small\verb!|- (!$t_i$\verb! = !$u_j$\verb!) = T!}, then the resulting theorem will be \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots\m{t\sb{i}},\dots,\m{t\sb{n}}\rb UNION \lb\m{u\sb{1}},\dots,\m{u\sb{j}},\dots,\m{u\sb{m}}\rb = \lb\m{t\sb{1}},\m{\dots},\m{t\sb{n}},\m{u\sb{1}},\dots,\m{u\sb{j}},\dots,\m{u\sb{m}}\rb \end{alltt}\end{hol} \noindent That is, the redundant term \m{t_i} will be removed from the initial sequence of elements in the resulting finite set. The function \ml{UNION\_CONV} also checks for and eliminates alpha-equivalent elements. Some examples of \ml{UNION\_CONV} in use are shown in the following \HOL\ session: \begin{session}\begin{verbatim} #UNION_CONV NO_CONV "{1,2,3} UNION {4,5,6}";; |- {1,2,3} UNION {4,5,6} = {1,2,3,4,5,6} #UNION_CONV NO_CONV "{1,2,3} UNION {3,2,SUC 0}";; |- {1,2,3} UNION {3,2,SUC 0} = {1,3,2,SUC 0} \end{verbatim}\end{session} \noindent The supplied equality conversion in these examples is \ml{NO\_CONV}, and only the elements of the first set {\small\verb!{1,2,3}!} that are redundant by virtue of being alpha-equivalent to elements of the second set are eliminated from the resulting set. An example in which the equality conversion is actually used is: \begin{session}\begin{verbatim} #UNION_CONV num_EQ_CONV "{1,2,3} UNION {3,2,SUC 0}";; |- {1,2,3} UNION {3,2,SUC 0} = {3,2,SUC 0} \end{verbatim}\end{session} \noindent In this case, \ml{num\_EQ\_CONV} is used to prove that {\small\verb!1!} is equal to {\small\verb!SUC 0!}, so that the resulting union is the set {\small\verb!"{3,2,SUC 0}"!}, rather than {\small\verb!"{1,3,2,SUC 0}!"}.\index{UNION\_CONV@{\ptt UNION\_CONV}|)}% \index{conversions!UNION\_CONV@{\ptt UNION\_CONV}|)} \subsubsection{Insertion} The\index{INSERT\_CONV@{\ptt INSERT\_CONV}|(}% \index{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|(} conversion \ml{INSERT\_CONV} performs the following reduction on finite sets: \begin{hol}\begin{alltt} {\normalsize\rm reduce}\quad"\m{t} INSERT \lb\m{t\sb{1}},\dots,\m{t\sb{i}},\dots,\m{t\sb{n}}\rb"\quad\m{\normalsize\rm to}\quad"\lb\m{t\sb{1}},\dots,\m{t\sb{i}},\dots,\m{t\sb{n}}\rb" \end{alltt}\end{hol} \noindent if a supplied equality conversion can prove {\small\verb!|- (!$t$\verb! = !$t_i$\verb!) = T!}. Since the enumerated set notation {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} is just a parser-supported abbreviation (see section~\ref{finite}), this is equivalent to reducing the set {\small\verb!"{!\tt$t$,$t_1$,\dots,$t_i$,\dots,$t_n$\verb!}"!} to {\small\verb!"{!\tt$t_1$,\dots,$t_i$,\dots,$t_n$\verb!}"!} when the terms {\small$t$} and {\small$t_i$} are provably equal.\pagebreak[3] More specifically, if for some {\small$t_i$} in {\small\verb!{!$t_1$\verb!,!\dots\verb!,!$t_n$\verb!}!}, the terms {\small$t$} and {\small$t_i$} are alpha-equivalent, of if the conversion \ml{conv} maps {\small\verb!"!$t$\verb! = !$t_i$\verb!"!} to the theorem {\small\verb!|- (!$t$\verb! = !$t_i$\verb!) = T!}, then the call: \begin{hol}\begin{alltt} INSERT\_CONV conv "\m{t} INSERT \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb";; \end{alltt}\end{hol} \noindent will return the theorem: \begin{hol}\begin{alltt} |- \m{t} INSERT \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb = \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb \end{alltt}\end{hol} Here is an example of \ml{INSERT\_CONV} in use: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #INSERT_CONV num_EQ_CONV "(SUC 2) INSERT {0,1,2,3}";; |- {SUC 2,0,1,2,3} = {0,1,2,3} \end{verbatim}\end{session} When applied repeatedly, \ml{INSERT\_CONV} can be used to reduce finite sets by eliminating as many redundant occurrences of elements as possible. An easy to program, but slow-running, way of doing this is to use \ml{DEPTH\_CONV}: \begin{session}\begin{verbatim} #DEPTH_CONV (INSERT_CONV num_EQ_CONV) "{1,3,x,SUC 1,SUC(SUC 1),2,1,3,x}";; |- {1,3,x,SUC 1,SUC(SUC 1),2,1,3,x} = {2,1,3,x} \end{verbatim}\end{session} \noindent For a faster alternative to this method, see the reference entry for \ml{INSERT\_CONV} in chapter~\ref{entries}.\index{INSERT\_CONV@{\ptt INSERT\_CONV}|)}% \index{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|)} \subsubsection{Deletion} The\index{DELETE\_CONV@{\ptt DELETE\_CONV}|(}% \index{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|(} conversion \ml{DELETE\_CONV} reduces terms of the form {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!} DELETE !$t$\verb!"!} by deleting all elements provably equal to {\small$t$} from the set {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!}. Like \ml{IN\_CONV} and \ml{INSERT\_CONV}, the function \ml{DELETE\_CONV} takes a conversion for deciding equality of set elements as an argument. If \ml{conv} is such a conversion, the call: \begin{hol}\begin{alltt} DELETE\_CONV conv "\lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb DELETE \m{t}";; \end{alltt}\end{hol} \noindent will return the theorem: \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb DELETE \m{t} = \lb\m{t\sb{i}},\dots,\m{t\sb{j}}\rb \end{alltt}\end{hol} \noindent where the resulting set {\small\verb!{!\tt$t_i$,\dots,$t_j$\verb!}!} is the set of all values {\small$t_k$} in the original set {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!} for which \ml{conv} proves {\tt |- ($t_k$ = $t$) = F}, and where for all {\small$t_k$} in {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!} but not in {\small\verb!{!\tt$t_i$,\dots,$t_j$\verb!}!}, either {\small$t_k$} is alpha-equivalent to {\small$t$} or \ml{conv} proves {\tt |- ($t_k$ = $t$) = T}. Note that the conversion \ml{conv} must prove either equality or inequality for every element of the original set that is not simply alpha-equivalent to the deleted value. The following session shows \ml{DELETE\_CONV} in use: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #DELETE_CONV num_EQ_CONV "{0,1,2,3} DELETE (SUC 1)";; |- {0,1,2,3} DELETE (SUC 1) = {0,1,3} \end{verbatim}\end{session}% \index{DELETE\_CONV@{\ptt DELETE\_CONV}|)}% \index{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|)} \section{Singleton sets} A {\it singleton\/} set is a set that contains precisely one element. In the \ml{sets} library, the property of being a singleton set is expressed by the definition: \begin{hol} \index{definition!of SING@of {\ptt SING}} \index{SING\_DEF@{\ptt SING\_DEF}} \begin{verbatim} SING_DEF |- !s. SING s = (?x. s = {x}) \end{verbatim}\end{hol} \noindent The library contains several built-in theorems about singleton sets. These are sometimes expressed in terms of the predicate \ml{SING}, as for example in the theorem \begin{hol} \index{SING@{\ptt SING}} \begin{verbatim} SING |- !x. SING{x} \end{verbatim}\end{hol} \noindent But properties of singleton sets are more usually formulated as theorems about sets of the form `{\small\verb"{x}"}'. For example, the built-in theorems about singleton sets include: \begin{hol} \index{SING@{\ptt SING}} \begin{verbatim} NOT_SING_EMPTY |- !x. ~({x} = {}) IN_SING |- !x y. x IN {y} = (x = y) EQUAL_SING |- !x y. ({x} = {y}) = (x = y) \end{verbatim}\end{hol} \noindent A\index{naming conventions!for theorems about singletons|(} general convention is that theorems about singleton sets are given names that contain the element `\ml{SING}', regardless of whether or not they actually contain the predicate \ml{SING}.\index{naming conventions!for theorems about singletons|)} \section{The {\tt CHOICE} and {\tt REST} functions} The \ml{sets} library contains the definition of a functions \ml{CHOICE} which can be used to select an arbitrary element from a non-empty set. The function \ml{CHOICE} is defined formally by the following constant specification: \begin{hol} \index{definition!of CHOICE@of {\ptt CHOICE}} \index{CHOICE\_DEF@{\ptt CHOICE\_DEF}} \begin{verbatim} CHOICE_DEF |- !s. ~(s = {}) ==> (CHOICE s) IN s \end{verbatim}\end{hol} \noindent This theorem alone is the defining property for the constant \ml{CHOICE}, which is therefore an only partially specified function from sets to values. Note, in particular, that there is no information given by this definition about the result of applying \ml{CHOICE} to an empty set. The library also contains a function \ml{REST}, which is defined in terms of the \ml{CHOICE} function as follows \begin{hol} \index{definition!of REST@of {\ptt REST}} \index{REST\_DEF@{\ptt REST\_DEF}} \begin{verbatim} REST_DEF |- !s. REST s = s DELETE (CHOICE s) \end{verbatim}\end{hol} \noindent For any non-empty set \ml{s}, the set \ml{REST s} comprises all those elements of \ml{s} except the value selected from \ml{s} by \ml{CHOICE}. The library contains various built-in theorems about the functions \ml{CHOICE} and \ml{REST}; for a full list of these theorems, see chapter~\ref{theorems}. \section{Image of a function on a set} The {\it image\/} of a function {\small\verb!f:*->**!} on a set {\small\verb!s:(*)set!} is the set of values {\small\verb!f(x)!} for all \ml{x} in \ml{s}. In the \ml{sets} library, the image of a function on a set is defined in terms of the obvious set abstraction: \begin{hol} \index{definition!of IMAGE@of {\ptt IMAGE}} \index{IMAGE\_DEF@{\ptt IMAGE\_DEF}} \begin{verbatim} IMAGE_DEF |- !f s. IMAGE f s = {f x | x IN s} \end{verbatim}\end{hol} \noindent Using \ml{SET\_SPEC\_CONV}, is is trivial to prove from this definition the following membership condition for sets constructed using \ml{IMAGE}: \begin{hol} \index{IN\_IMAGE@{\ptt IN\_IMAGE}} \begin{verbatim} IN_IMAGE |- !y s f. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) \end{verbatim}\end{hol} \noindent The \ml{sets} library contains various theorems about \ml{IMAGE} in addition to this membership theorem. These include, for example, theorems about the image of a function on sets constructed by the operations of union and intersection. For a full list of theorems about \ml{IMAGE}, see chapter~\ref{theorems}. \subsection{Theorem-proving support} The\index{IMAGE\_CONV@{\ptt IMAGE\_CONV}|(}% \index{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|(} \ml{sets} library contains a conversion for computing the image of a function {\small\verb!f!} on a finite set {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!}. The function \begin{hol}\begin{verbatim} IMAGE_CONV : conv -> conv -> conv \end{verbatim}\end{hol} \noindent is parameterized by two conversions. The first conversion is expected to compute the result of applying the function {\small\verb!f!} to each element {\small$t_1$}, \dots, {\small $t_n$}. The second parameter is an equality conversion which is used to simplify the resulting image set by removing redundant occurrences of its elements. The following session shows a simple example of the use of \ml{IMAGE\_CONV} on terms of the form {\small\tt\verb!"IMAGE (\x.x+2) {!$t_1$,\dots,$t_n$\verb!}"!}. We first define a conversion that evaluates the result of applying the function {\small\verb!(\x.x+2)!} to a term {\small$t$}. \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #let AP_CONV = BETA_CONV THENC (TRY_CONV ADD_CONV);; AP_CONV = - : conv #AP_CONV "(\n.n+2) 7";; |- (\n. n + 2)7 = 9 \end{verbatim}\end{session} \noindent This conversion, together with the function \ml{IMAGE\_CONV}, gives a conversion for computing the image of {\small\verb!(\x.x+2)!} on a finite set of numerical values. \begin{session}\begin{verbatim} #IMAGE_CONV AP_CONV NO_CONV "IMAGE (\x.x+2) {1,2,3,4}";; |- IMAGE(\x. x + 2){1,2,3,4} = {3,4,5,6} #IMAGE_CONV AP_CONV NO_CONV "IMAGE (\x.x+2) {n,1,n}";; |- IMAGE(\x. x + 2){n,1,n} = {3,n + 2} \end{verbatim}\end{session} \noindent In this case, the second parameter supplied to \ml{IMAGE\_CONV} is the conversion \ml{NO\_CONV}. This means that no reduction of the resulting image set is done, beyond the elimination of elements that are provably redundant by virtue of being alpha-equivalent to some other element (as in the second example above). The following session illustrates the use of the second parameter to \ml{IMAGE\_CONV}. \begin{session}\begin{verbatim} #IMAGE_CONV BETA_CONV NO_CONV "IMAGE (\x. SUC x) {1,SUC 0,2,0}";; |- IMAGE(\x. SUC x){1,SUC 0,2,0} = {SUC 1,SUC(SUC 0),SUC 2,SUC 0} #IMAGE_CONV BETA_CONV num_EQ_CONV "IMAGE (\x. SUC x) {1,SUC 0,2,0}";; |- IMAGE(\x. SUC x){1,SUC 0,2,0} = {SUC(SUC 0),SUC 2,SUC 0} \end{verbatim}\end{session} \noindent In the first evaluation, just applying \ml{BETA\_CONV} to the application of {\small\verb!(\x. SUC x)!} to each element has resulted in an image set containing both {\small\verb!SUC 1!} and {\small\verb!SUC(SUC 0)!}. In the second example, \ml{num\_EQ\_CONV} is used to prove these values equal, and therefore to simplify the resulting set by eliminating one of them from it. For more detail about \ml{IMAGE\_CONV}, see the reference entry for this conversion in chapter~\ref{entries}.\index{IMAGE\_CONV@{\ptt IMAGE\_CONV}|)}% \index{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|)} \section{Mappings between sets} The \ml{sets} library contains a few basic definitions and theorems having to do with mappings between sets. A function \ml{f:*->**} is an {\it injective\/} (one-to-one) mapping from a set \ml{s:(*)set} to a set \ml{t:(**)set} if it takes distinct elements of \ml{s} to distinct element of \ml{t}: \begin{hol} \index{definition!of INJ@of {\ptt INJ}} \index{INJ\_DEF@{\ptt INJ\_DEF}} \begin{verbatim} INJ_DEF = |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) \end{verbatim}\end{hol} \noindent Likewise, a function \ml{f:*->**} is a {\it surjective\/} (onto) mapping from \ml{s} to \ml{t} if for every element \ml{x} of \ml{t} there is some element \ml{y} of \ml{s} for which {\small\verb!f y = x!}: \begin{hol} \index{definition!of SURJ@of {\ptt SURJ}} \index{SURJ\_DEF@{\ptt SURJ\_DEF}} \begin{verbatim} SURJ_DEF = |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) \end{verbatim}\end{hol} \noindent Finally, a function \ml{f:*->**} is a {\it bijection\/} from \ml{s} to \ml{t} if it is both injective and surjective: \begin{hol} \index{definition!of BIJ@of {\ptt BIJ}} \index{BIJ\_DEF@{\ptt BIJ\_DEF}} \begin{verbatim} BIJ_DEF = |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t \end{verbatim}\end{hol} There are a few pre-proved theorems about the predicates \ml{INJ}, \ml{SURJ}, and \ml{BIJ} available in the library; see chapter~\ref{theorems} for a full list of these theorems. The library also contains constant specifications for two functions \ml{LINV} and \ml{RINV}, which yield left and right inverses to injective and surjective mappings respectively. These functions are defined by: \begin{hol} \index{definition!of LINV@of {\ptt LINV}} \index{LINV\_DEF@{\ptt LINV\_DEF}} \index{definition!of RINV@of {\ptt RINV}} \index{RINV\_DEF@{\ptt RINV\_DEF}} \begin{verbatim} LINV_DEF = |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) RINV_DEF = |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) \end{verbatim}\end{hol} \noindent There are, at present, no additional built-in theorems about these two functions. Furthermore, the definitions of \ml{LINV} and \ml{RINV} shown above should be regarded as only provisional; they may be changed in future versions. \section{Finite and infinite sets} The \ml{sets} library includes the definition of a predicate called \ml{FINITE}, which is true of finite sets and false of infinite ones. The definition of this constant is shown below. \begin{hol} \index{definition!of FINITE@of {\ptt FINITE}} \index{FINITE\_DEF@{\ptt FINITE\_DEF}} \begin{verbatim} FINITE_DEF |- !s. FINITE s = (!P. P{} /\ (!s'. P s' ==> (!e. P(e INSERT s'))) ==> P s) \end{verbatim}\end{hol} \noindent That is, a set \ml{s} is finite precisely when it is in the smallest class of sets that contains the empty set and is closed under the \ml{INSERT} operation. This inductive definition makes \ml{FINITE} true of just those sets that can be constructed from the empty set by a finite sequence of applications of the \ml{INSERT} operation. The \ml{sets} library contains various built-in theorems that follow from the definition of \ml{FINITE} given above. Among these are the two fundamental theorems shown below: \begin{hol} \index{FINITE\_EMPTY@{\ptt FINITE\_EMPTY}} \index{FINITE\_INSERT@{\ptt FINITE\_INSERT}} \begin{verbatim} FINITE_EMPTY |- FINITE{} FINITE_INSERT |- !x s. FINITE(x INSERT s) = FINITE s \end{verbatim}\end{hol} \noindent These state that the empty set is indeed finite and insertion constructs finite sets only from other finite sets. See chapter~\ref{theorems} for other built-in theorems about finite sets. The above definition of \ml{FINITE} formalizes the notion of a finite set in logic, and it therefore also determines the form of definition for the complementary notion of an infinite set. In the \ml{sets} library, the predicate \ml{INFINITE} is defined as follows: \begin{hol} \index{definition!of INFINITE@of {\ptt INFINITE}} \index{INFINITE\_DEF@{\ptt INFINITE\_DEF}} \begin{verbatim} INFINITE_DEF |- !s. INFINITE s = ~FINITE s \end{verbatim}\end{hol} \noindent There are a few consequences of this definition stored in the \ml{sets} library. The following theorem, for example, states that the image of an injective function on an infinite set is infinite: \begin{hol} \index{IMAGE\_11\_INFINITE@{\ptt IMAGE\_11\_INFINITE}} \begin{verbatim} IMAGE_11_INFINITE |- !f. (!x y. (f x = f y) ==> (x = y)) ==> (!s. INFINITE s ==> INFINITE(IMAGE f s)) \end{verbatim}\end{hol} \noindent Other built-in theorems about \ml{INFINITE} can be found in chapter~\ref{theorems}. \subsection{Theorem-proving support} There are two \ML\ functions in the \ml{sets} library for reasoning about propositions that involve the finiteness predicate \ml{FINITE}. The\index{FINITE\_CONV@{\ptt FINITE\_CONV}|(} \index{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|(} first of these is a conversion \ml{FINITE\_CONV} which automatically proves that sets of the form {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} are finite. Evaluating \begin{hol}\begin{alltt} FINITE\_CONV "FINITE \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb";; \end{alltt}\end{hol} \noindent yields the theorem {\small\verb!|- FINITE {!\tt$t_1$,\dots,$t_n$\verb!} = T!}.% \index{FINITE\_CONV@{\ptt FINITE\_CONV}|)}% \index{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|)} The\index{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(} \index{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(} second \ML\ function for reasoning about the predicate \ml{FINITE} is an induction tactic called \ml{SET\_INDUCT\_TAC}. When applied to a goal of the form {\small\verb!"!!$s$\verb!. FINITE !$s$\verb! ==> !$P$\verb!"!}, this tactic reduces it to proving that the property of sets expressed by {\small\verb!\!$s$\verb!.!$P$} holds of the empty set and is preserved by the insertion of an element into an arbitrary finite set. Since every finite set can be built up from the empty set by repeated insertion of values, these subgoals imply that this property holds of all finite sets. The following session illustrates the use of the tactic \ml{SET\_INDUCT\_TAC} for proving that the intersection of an arbitrary set \ml{t} with a finite set \ml{s} is finite. We first set up an appropriate goal: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #g "!s:(*)set. FINITE s ==> !t. FINITE(s INTER t)";; "!s. FINITE s ==> (!t. FINITE(s INTER t))" () : void \end{verbatim}\end{session} \noindent Expanding with \ml{SET\_INDUCT\_TAC} yields: \begin{session}\begin{verbatim} #expand SET_INDUCT_TAC;; OK.. 2 subgoals "!t. FINITE((e INSERT s) INTER t)" [ "FINITE s" ] [ "!t. FINITE(s INTER t)" ] [ "~e IN s" ] "!t. FINITE({} INTER t)" () : void \end{verbatim}\end{session} \noindent The resulting subgoals are easy to prove, given the two basic theorems \ml{FINITE\_EMPTY} and \ml{FINITE\_INSERT} shown in the previous section. Note that it may be assumed in the step case that the value \ml{e} being inserted into the set \ml{s} is not already an element of \ml{s}.\index{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}% \index{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)} \section{Cardinality of finite sets} The {\it cardinality\/} of a finite set is the number of elements it contains. In the \ml{sets} library, this is formalized by a constant \ml{CARD} defined by means of the following constant specification: \begin{hol} \index{definition!of CARD@of {\ptt CARD}} \index{CARD\_DEF@{\ptt CARD\_DEF}} \begin{verbatim} CARD_DEF |- (CARD{} = 0) /\ (!s. FINITE s ==> (!x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)))) \end{verbatim}\end{hol} \noindent This theorem is the sole defining property of \ml{CARD}. Because the equation in the second clause holds only under the assumption that \ml{s} is finite, this form of definition allows nothing significant to be deduced about the cardinality `\ml{CARD s}' of an {\it infinite\/} set \ml{s}. The built-in theorems about cardinality are all restricted to finite sets only, either implicitly as in the theorem: \begin{hol} \index{CARD\_SING@{\ptt CARD\_SING}} \begin{verbatim} CARD_SING |- !x. CARD{x} = 1 \end{verbatim}\end{hol} \noindent or explicitly, as in: \begin{hol} \index{FINITE\_ISO\_NUM@{\ptt FINITE\_ISO\_NUM}} \begin{verbatim} FINITE_ISO_NUM |- !s:(*)set. FINITE s ==> (?f:num->*. (!n m. n < (CARD s) /\ m < (CARD s) ==> (f n = f m) ==> (n = m)) /\ (s = {f n | n < (CARD s)})) \end{verbatim}\end{hol} \noindent This second theorem states that the elements of a finite set can always be put into a one-to-one correspondence with the natural numbers less than the set's cardinality---i.e. the elements of a finite set \ml{s} can be numbered \ml{0}, \ml{1}, \dots, {\small\verb!(CARD s)-1!}. Other theorems involving the cardinality function \ml{CARD} can be found in chapter~\ref{theorems}. \section{Using the library}\label{using} The \ml{sets} library is loaded into a user's \HOL\ session using the function \ml{load\_library} (see the \HOL\ manual for a general description of library loading). The first action in the load sequence is to update the internal \HOL\ search paths. A pathname to the library is added to the search path so that theorems may be autoloaded from the library theory \ml{sets}; and the \HOL\ help search path is updated with a pathname to online help files for the \ML\ functions in the library. After the search paths are updated, the actions taken by the load sequence for \ml{sets} depend on the current state of the \HOL\ session. If the system is in draft mode, the library theory \ml{sets} is added as a new parent to the current theory. If the system is not in draft mode, but the current theory is an ancestor of the \ml{sets} theory in the library (e.g.\ the user is in a fresh \HOL\ session) then \ml{sets} is made the current theory. In both cases, the \ML\ functions provided by the library are loaded into \HOL\, and all the theorems in the library (including definitions) are set up to be autoloaded on demand. The parser and pretty-printer for the notation described above in sections~\ref{abst} and~\ref{finite} are then activated, and the \ML\ functions provided by the library for reasoning about sets are loaded. The \ml{sets} library is then fully loaded into the user's \HOL\ session. \subsection{Example session} The following session shows how the \ml{sets} library may be loaded using \ml{load\_library}. Suppose, beginning in a fresh \HOL\ session, the user wishes to create a theory \ml{foo} whose parents include the theory \ml{sets} in the library. This may be done as follows: \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #new_theory `foo`;; () : void #load_library `sets`;; \(\vdots\) Library sets loaded. () : void \end{alltt}\end{session} \noindent Loading the library while drafting the theory \ml{foo} makes the library theory \ml{sets} into a parent of \ml{foo}. The same effect could have been achieved (in a fresh session) by first loading the library and then creating \ml{foo}: \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #load_library `sets`;; \(\vdots\) Library sets loaded. () : void #new_theory `foo`;; () : void \end{alltt}\end{session} \noindent The theory \ml{sets} is first made the current theory of the new session. It then automatically becomes a parent of \ml{foo} when this theory is created by \ml{new\_theory}. Now, suppose that \ml{foo} has been created as shown above, and the user does some work in this theory, quits \HOL, and in a later session wishes to load the theory \ml{foo}. This must be done by {\it first\/} loading the \ml{sets} library and {\it then\/} loading the theory \ml{foo}. \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #load_library `sets`;; \(\vdots\) Library sets loaded. () : void #load_theory `foo`;; Theory foo loaded () : void \end{alltt}\end{session} \noindent This sequence of actions ensures that the system can find the parent theory \ml{sets} when it comes to load \ml{foo}, since loading the library updates the search path. \subsection{The {\tt load\_sets} function}% \index{load\_sets@{\ptt load\_sets}|(} The \ml{sets} library may in many cases simply be loaded into the system as illustrated by the examples given above. There are, however, certain situations in which the library cannot be fully loaded at the time when the \ml{load\_library} is used. This occurs when the system is not in draft mode and the current theory is not an ancestor of the theory \ml{sets}. In this case, loading the library can (and will) update the search paths. But the theory \ml{sets} can neither be made into a parent of the current theory nor be made the current theory. This means that autoloading from the library can not at this stage be activated; and the \ML\ code in the library can not be loaded into \HOL, since it requires access to some of the theorems in the library. In the situation described above---when the system is not in draft mode and the current theory is not an ancestor of the theory \ml{sets}---the library load sequence defines an \ML\ function called \ml{load\_sets} in the current \HOL\ session. If at a future point in the session the \ml{sets} theory (now accessible via the search path) becomes an ancestor of the current theory, this function can then be used to complete loading of the library. Evaluating {\small\verb!load_sets()!} in such a context loads the \ML\ functions of the \ml{sets} library into \HOL\ and activates autoloading from its theory files. It also activates the parser and pretty-printer support for set abstractions and finite sets. The function \ml{load\_sets} fails if the theory \ml{sets} is not an ancestor of the current \HOL\ theory. Note that the function \ml{load\_sets} becomes available upon loading the \ml{sets} library only if the library theory \ml{sets} at the point of loading the library can neither be made into a new parent (i.e.\ the system is not in draft mode) nor be made the current theory.\index{load\_sets@{\ptt load\_sets}|)} hol88-2.02.19940316/Library/sets/Manual/entries-intro.tex0000640000212700021270000000032005104533027021041 0ustar cammcammThis chapter provides documentation on all the \ML\ functions that are made available in \HOL\ when the \ml{sets} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/sets/Manual/sets.log0000640000212700021270000000372005535606171017216 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:24 **sets.tex (sets.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file sets.idx (sets.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) (title.tex [1 ] [2]) (sets.toc [3 ]) \tf@toc=\write4 [4] (description.tex Chapter 1. [1 ] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12] [13] [14] [15] [16] [17] [18] [19] [20]) [21] (entries.tex [22 ] Chapter 2. (entries-intro.tex) [23] [24] [25] [26] [27] [28] [29] [30] [31]) [32] (theorems.tex Chapter 3. (theorems-intro.tex) [33 ] [34] [35] [36] [37] [38] [39] [40] [41] [42] [43] [44] [45] [46]) [47] (references.tex [48 ]) [49] (index.tex [50 ] [51] [52] [53 ]) (sets.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) ) Here is how much of TeX's memory you used: 474 strings out of 11977 3897 string characters out of 87025 41650 words of memory out of 262141 2298 multiletter control sequences out of 9500 19808 words of font info for 76 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 18i,12n,19p,248b,580s stack positions out of 300i,100n,60p,3000b,4000s Output written on sets.dvi (57 pages, 129604 bytes). hol88-2.02.19940316/Library/sets/Manual/title.tex0000640000212700021270000000353305100101310017347 0ustar cammcamm% ===================================================================== % % Standard titlepage for sets library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL sets Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf T.\ F.\ Melham \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf October 1991 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ T.\ F.\ Melham 1991 \end{center} \newpage hol88-2.02.19940316/Library/sets/Manual/index.tex0000640000212700021270000002077405535606120017370 0ustar cammcamm\begin{theindex} \item {\ptt ABSORPTION}, 38 \item axiom of extension, 2 \item axiom of specification, 2 \subitem for generalized set specifications, 3 \subitem for set abstractions, 5 \indexspace \item {\ptt BIJ\_COMPOSE}, 42 \item {\ptt BIJ\_DEF}, 17, 42 \item {\ptt BIJ\_EMPTY}, 42 \item {\ptt BIJ\_ID}, 42 \indexspace \item {\ptt CARD\_DEF}, 19, 46 \item {\ptt CARD\_DELETE}, 46 \item {\ptt CARD\_DIFF}, 46 \item {\ptt CARD\_EMPTY}, 46 \item {\ptt CARD\_EQ\_0}, 46 \item {\ptt CARD\_INSERT}, 46 \item {\ptt CARD\_INTER\_LESS\_EQ}, 46 \item {\ptt CARD\_PSUBSET}, 46 \item {\ptt CARD\_SING}, 19, 46 \item {\ptt CARD\_SUBSET}, 46 \item {\ptt CARD\_UNION}, 47 \item {\ptt CHF}, 1 \item {\ptt CHOICE\_DEF}, 14, 40 \item {\ptt CHOICE\_INSERT\_REST}, 40 \item {\ptt CHOICE\_NOT\_IN\_REST}, 40 \item {\ptt CHOICE\_SING}, 40 \item {\ptt COMPONENT}, 38 \item conversions \subitem {\ptt DELETE\_CONV}, 13 \subitem {\ptt FINITE\_CONV}, 18 \subitem {\ptt IMAGE\_CONV}, 15--16 \subitem {\ptt IN\_CONV}, 10--11 \subitem {\ptt INSERT\_CONV}, 12--13 \subitem {\ptt SET\_SPEC\_CONV}, 5--6 \subitem {\ptt UNION\_CONV}, 11--12 \indexspace \item {\ptt DECOMPOSITION}, 38 \item {\ptt define\_finite\_set\_syntax}, 9 \item {\ptt define\_new\_type\_bijections}, 1 \item {\ptt define\_set\_abstraction\_syntax}, 3 \item definition \subitem of {\ptt (*)set}, 1--2 \subitem of {\ptt BIJ}, 17 \subitem of {\ptt CARD}, 19 \subitem of {\ptt CHF}, 1 \subitem of {\ptt CHOICE}, 14 \subitem of {\ptt DELETE}, 8 \subitem of {\ptt DIFF}, 7 \subitem of {\ptt DISJOINT}, 8 \subitem of {\ptt EMPTY}, 6 \subitem of {\ptt FINITE}, 17 \subitem of {\ptt GSPEC}, 3 \subitem of {\ptt IMAGE}, 15 \subitem of {\ptt IN}, 2 \subitem of {\ptt INFINITE}, 17 \subitem of {\ptt INJ}, 16 \subitem of {\ptt INSERT}, 8 \subitem of {\ptt INTER}, 7 \subitem of {\ptt LINV}, 17 \subitem of {\ptt PSUBSET}, 7 \subitem of {\ptt REST}, 14 \subitem of {\ptt RINV}, 17 \subitem of {\ptt SING}, 14 \subitem of {\ptt SPEC}, 1 \subitem of {\ptt SUBSET}, 7 \subitem of {\ptt SURJ}, 16 \subitem of {\ptt UNION}, 7 \subitem of {\ptt UNIV}, 6 \item {\ptt DELETE\_COMM}, 38 \item {\ptt DELETE\_CONV}, 13, 23 \item {\ptt DELETE\_DEF}, 8, 38 \item {\ptt DELETE\_DELETE}, 38 \item {\ptt DELETE\_EQ\_SING}, 43 \item {\ptt DELETE\_INSERT}, 38 \item {\ptt DELETE\_INTER}, 38 \item {\ptt DELETE\_NON\_ELEMENT}, 38 \item {\ptt DELETE\_SUBSET}, 39 \item {\ptt DIFF\_DEF}, 7, 37 \item {\ptt DIFF\_DIFF}, 37 \item {\ptt DIFF\_EMPTY}, 37 \item {\ptt DIFF\_EQ\_EMPTY}, 37 \item {\ptt DIFF\_INSERT}, 39 \item {\ptt DIFF\_UNIV}, 37 \item {\ptt DISJOINT\_DEF}, 8, 37 \item {\ptt DISJOINT\_DELETE\_SYM}, 37 \item {\ptt DISJOINT\_EMPTY}, 38 \item {\ptt DISJOINT\_EMPTY\_REFL}, 38 \item {\ptt DISJOINT\_INSERT}, 39 \item {\ptt DISJOINT\_SING\_EMPTY}, 43 \item {\ptt DISJOINT\_SYM}, 38 \item {\ptt DISJOINT\_UNION}, 38 \indexspace \item {\ptt EMPTY\_DEF}, 6, 34 \item {\ptt EMPTY\_DELETE}, 39 \item {\ptt EMPTY\_DIFF}, 37 \item {\ptt EMPTY\_NOT\_UNIV}, 34 \item {\ptt EMPTY\_SUBSET}, 7, 34 \item {\ptt EMPTY\_UNION}, 35 \item {\ptt EQ\_UNIV}, 34 \item {\ptt EQUAL\_SING}, 43 \item {\ptt EXTENSION}, 2, 33 \indexspace \item {\ptt FINITE\_CONV}, 18, 24 \item {\ptt FINITE\_DEF}, 17, 44 \item {\ptt FINITE\_DELETE}, 44 \item {\ptt FINITE\_DIFF}, 44 \item {\ptt FINITE\_EMPTY}, 17, 44 \item {\ptt FINITE\_INDUCT}, 44 \item {\ptt FINITE\_INSERT}, 17, 44 \item {\ptt FINITE\_ISO\_NUM}, 19, 44 \item {\ptt FINITE\_PSUBSET\_INFINITE}, 44 \item {\ptt FINITE\_PSUBSET\_UNIV}, 44 \item {\ptt FINITE\_SING}, 43 \item {\ptt FINITE\_UNION}, 45 \indexspace \item {\ptt GSPEC}, 3 \item {\ptt GSPEC\_DEF}, 3, 33 \item {\ptt GSPECIFICATION}, 3, 33 \indexspace \item {\ptt IMAGE\_11\_INFINITE}, 18, 45 \item {\ptt IMAGE\_COMPOSE}, 41 \item {\ptt IMAGE\_CONV}, 15--16, 25 \item {\ptt IMAGE\_DEF}, 15, 41 \item {\ptt IMAGE\_DELETE}, 41 \item {\ptt IMAGE\_EMPTY}, 41 \item {\ptt IMAGE\_EQ\_EMPTY}, 41 \item {\ptt IMAGE\_FINITE}, 45 \item {\ptt IMAGE\_ID}, 41 \item {\ptt IMAGE\_IN}, 41 \item {\ptt IMAGE\_INSERT}, 41 \item {\ptt IMAGE\_INTER}, 41 \item {\ptt IMAGE\_SUBSET}, 41 \item {\ptt IMAGE\_SURJ}, 42 \item {\ptt IMAGE\_UNION}, 42 \item {\ptt IN\_CONV}, 10--11, 28 \item {\ptt IN\_DEF}, 2, 33 \item {\ptt IN\_DELETE}, 9, 39 \item {\ptt IN\_DELETE\_EQ}, 40 \item {\ptt IN\_DIFF}, 8, 37 \item {\ptt IN\_DISJOINT}, 38 \item {\ptt IN\_IMAGE}, 15, 42 \item {\ptt IN\_INFINITE\_NOT\_FINITE}, 45 \item {\ptt IN\_INSERT}, 9, 40 \item {\ptt IN\_INTER}, 8, 36 \item {\ptt IN\_SING}, 43 \item {\ptt IN\_UNION}, 8, 36 \item {\ptt IN\_UNIV}, 6, 34 \item {\ptt INFINITE\_DEF}, 17, 45 \item {\ptt INFINITE\_DIFF\_FINITE}, 45 \item {\ptt INFINITE\_SUBSET}, 45 \item {\ptt INFINITE\_UNIV}, 45 \item {\ptt INJ\_COMPOSE}, 42 \item {\ptt INJ\_DEF}, 16, 42 \item {\ptt INJ\_EMPTY}, 42 \item {\ptt INJ\_ID}, 42 \item {\ptt INSERT\_COMM}, 39 \item {\ptt INSERT\_CONV}, 12--13, 27 \item {\ptt INSERT\_DEF}, 8, 39 \item {\ptt INSERT\_DELETE}, 39 \item {\ptt INSERT\_DIFF}, 39 \item {\ptt INSERT\_INSERT}, 39 \item {\ptt INSERT\_INTER}, 39 \item {\ptt INSERT\_SING\_UNION}, 43 \item {\ptt INSERT\_SUBSET}, 39 \item {\ptt INSERT\_UNION}, 39 \item {\ptt INSERT\_UNION\_EQ}, 39 \item {\ptt INSERT\_UNIV}, 39 \item {\ptt INTER\_ASSOC}, 36 \item {\ptt INTER\_COMM}, 36 \item {\ptt INTER\_DEF}, 7, 36 \item {\ptt INTER\_EMPTY}, 36 \item {\ptt INTER\_FINITE}, 45 \item {\ptt INTER\_IDEMPOT}, 36 \item {\ptt INTER\_OVER\_UNION}, 36 \item {\ptt INTER\_SUBSET}, 36 \item {\ptt INTER\_UNIV}, 36 \indexspace \item {\ptt LESS\_CARD\_DIFF}, 47 \item {\ptt LINV\_DEF}, 17, 42 \item {\ptt load\_sets}, 21 \indexspace \item {\ptt MEMBER\_NOT\_EMPTY}, 34 \indexspace \item naming conventions \subitem for definitions, 2 \subitem for membership conditions, 8 \subitem for theorems about singletons, 14 \subitem for theorems generally, 7 \item {\ptt NOT\_EMPTY\_INSERT}, 40 \item {\ptt NOT\_EMPTY\_SING}, 43 \item {\ptt NOT\_EQUAL\_SETS}, 33 \item {\ptt NOT\_IN\_EMPTY}, 6, 34 \item {\ptt NOT\_IN\_FINITE}, 45 \item {\ptt NOT\_INSERT\_EMPTY}, 40 \item {\ptt NOT\_PSUBSET\_EMPTY}, 7, 34 \item {\ptt NOT\_SING\_EMPTY}, 43 \item {\ptt NOT\_UNIV\_PSUBSET}, 7, 35 \item {\ptt NUM\_SET\_WOP}, 34 \indexspace \item {\ptt print\_set} (flag), 4, 9 \item {\ptt PSUBSET\_DEF}, 7, 35 \item {\ptt PSUBSET\_FINITE}, 45 \item {\ptt PSUBSET\_INSERT\_SUBSET}, 40 \item {\ptt PSUBSET\_IRREFL}, 35 \item {\ptt PSUBSET\_MEMBER}, 35 \item {\ptt PSUBSET\_TRANS}, 35 \item {\ptt PSUBSET\_UNIV}, 35 \indexspace \item {\ptt REST\_DEF}, 14, 40 \item {\ptt REST\_PSUBSET}, 41 \item {\ptt REST\_SING}, 41 \item {\ptt REST\_SUBSET}, 41 \item {\ptt RINV\_DEF}, 17, 42 \indexspace \item {\ptt SET\_CASES}, 40 \item {\ptt SET\_INDUCT\_TAC}, 18--19, 30 \item {\ptt set\_ISO\_DEF}, 1, 33 \item {\ptt SET\_MINIMUM}, 34 \item {\ptt SET\_SPEC\_CONV}, 5--6, 30 \item {\ptt set\_TY\_DEF}, 1, 33 \item {\ptt SING}, 14, 43 \item {\ptt SING\_DEF}, 14, 44 \item {\ptt SING\_DELETE}, 44 \item {\ptt SING\_FINITE}, 44 \item {\ptt SING\_IFF\_CARD1}, 47 \item {\ptt SING\_IFF\_EMPTY\_REST}, 41 \item {\ptt SPEC}, 1 \item {\ptt SPECIFICATION}, 2, 34 \item {\ptt SUBSET\_ANTISYM}, 7, 35 \item {\ptt SUBSET\_DEF}, 7, 35 \item {\ptt SUBSET\_DELETE}, 40 \item {\ptt SUBSET\_EMPTY}, 35 \item {\ptt SUBSET\_FINITE}, 45 \item {\ptt SUBSET\_INSERT}, 40 \item {\ptt SUBSET\_INSERT\_DELETE}, 40 \item {\ptt SUBSET\_INTER\_ABSORPTION}, 36 \item {\ptt SUBSET\_REFL}, 7, 35 \item {\ptt SUBSET\_TRANS}, 7, 35 \item {\ptt SUBSET\_UNION}, 36 \item {\ptt SUBSET\_UNION\_ABSORPTION}, 36 \item {\ptt SUBSET\_UNIV}, 7, 35 \item {\ptt SURJ\_COMPOSE}, 43 \item {\ptt SURJ\_DEF}, 16, 43 \item {\ptt SURJ\_EMPTY}, 43 \item {\ptt SURJ\_ID}, 43 \indexspace \item tactics \subitem {\ptt SET\_INDUCT\_TAC}, 18--19 \indexspace \item {\ptt UNION\_ASSOC}, 36 \item {\ptt UNION\_COMM}, 36 \item {\ptt UNION\_CONV}, 11--12, 31 \item {\ptt UNION\_DEF}, 7, 36 \item {\ptt UNION\_EMPTY}, 37 \item {\ptt UNION\_IDEMPOT}, 37 \item {\ptt UNION\_OVER\_INTER}, 37 \item {\ptt UNION\_UNIV}, 37 \item {\ptt UNIV\_DEF}, 6, 34 \item {\ptt UNIV\_NOT\_EMPTY}, 34 \item {\ptt UNIV\_SUBSET}, 35 \end{theindex} hol88-2.02.19940316/Library/sets/Manual/sets.idx0000640000212700021270000004110505535606171017220 0ustar cammcamm\indexentry{definition!of (*)set@of {\ptt (*)set}|(}{1} \indexentry{set\_TY\_DEF@{\ptt set\_TY\_DEF}}{1} \indexentry{define\_new\_type\_bijections@{\ptt define\_new\_type\_bijections}}{1} \indexentry{SPEC@{\ptt SPEC}}{1} \indexentry{CHF@{\ptt CHF}}{1} \indexentry{set\_ISO\_DEF@{\ptt set\_ISO\_DEF}}{1} \indexentry{definition!of CHF@of {\ptt CHF}}{1} \indexentry{definition!of SPEC@of {\ptt SPEC}}{1} \indexentry{naming conventions!for definitions|(}{2} \indexentry{naming conventions!for definitions|)}{2} \indexentry{definition!of (*)set@of {\ptt (*)set}|)}{2} \indexentry{definition!of IN@of {\ptt IN}}{2} \indexentry{IN\_DEF@{\ptt IN\_DEF}}{2} \indexentry{axiom of extension}{2} \indexentry{EXTENSION@{\ptt EXTENSION}}{2} \indexentry{SPECIFICATION@{\ptt SPECIFICATION}}{2} \indexentry{axiom of specification}{2} \indexentry{GSPEC@{\ptt GSPEC}}{3} \indexentry{definition!of GSPEC@of {\ptt GSPEC}}{3} \indexentry{GSPEC\_DEF@{\ptt GSPEC\_DEF}}{3} \indexentry{axiom of specification!for generalized set specifications}{3} \indexentry{GSPECIFICATION@{\ptt GSPECIFICATION}}{3} \indexentry{define\_set\_abstraction\_syntax@{\ptt define\_set\_abstraction\_syntax}}{3} \indexentry{print\_set@{\ptt print\_set} (flag)}{4} \indexentry{SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|(}{5} \indexentry{conversions!SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|(}{5} \indexentry{axiom of specification!for set abstractions}{5} \indexentry{SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|)}{6} \indexentry{conversions!SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}|)}{6} \indexentry{definition!of EMPTY@of {\ptt EMPTY}}{6} \indexentry{EMPTY\_DEF@{\ptt EMPTY\_DEF}}{6} \indexentry{definition!of UNIV@of {\ptt UNIV}}{6} \indexentry{UNIV\_DEF@{\ptt UNIV\_DEF}}{6} \indexentry{NOT\_IN\_EMPTY@{\ptt NOT\_IN\_EMPTY}}{6} \indexentry{IN\_UNIV@{\ptt IN\_UNIV}}{6} \indexentry{definition!of SUBSET@of {\ptt SUBSET}}{7} \indexentry{SUBSET\_DEF@{\ptt SUBSET\_DEF}}{7} \indexentry{definition!of PSUBSET@of {\ptt PSUBSET}}{7} \indexentry{PSUBSET\_DEF@{\ptt PSUBSET\_DEF}}{7} \indexentry{SUBSET\_TRANS@{\ptt SUBSET\_TRANS}}{7} \indexentry{SUBSET\_REFL@{\ptt SUBSET\_REFL}}{7} \indexentry{SUBSET\_ANTISYM@{\ptt SUBSET\_ANTISYM}}{7} \indexentry{EMPTY\_SUBSET@{\ptt EMPTY\_SUBSET}}{7} \indexentry{SUBSET\_UNIV@{\ptt SUBSET\_UNIV}}{7} \indexentry{NOT\_PSUBSET\_EMPTY@{\ptt NOT\_PSUBSET\_EMPTY}}{7} \indexentry{NOT\_UNIV\_PSUBSET@{\ptt NOT\_UNIV\_PSUBSET}}{7} \indexentry{naming conventions!for theorems generally|(}{7} \indexentry{naming conventions!for theorems generally|)}{7} \indexentry{definition!of UNION@of {\ptt UNION}}{7} \indexentry{UNION\_DEF@{\ptt UNION\_DEF}}{7} \indexentry{definition!of INTER@of {\ptt INTER}}{7} \indexentry{INTER\_DEF@{\ptt INTER\_DEF}}{7} \indexentry{definition!of DIFF@of {\ptt DIFF}}{7} \indexentry{DIFF\_DEF@{\ptt DIFF\_DEF}}{7} \indexentry{naming conventions!for membership conditions|(}{8} \indexentry{naming conventions!for membership conditions|)}{8} \indexentry{IN\_UNION@{\ptt IN\_UNION}}{8} \indexentry{IN\_INTER@{\ptt IN\_INTER}}{8} \indexentry{IN\_DIFF@{\ptt IN\_DIFF}}{8} \indexentry{definition!of DISJOINT@of {\ptt DISJOINT}}{8} \indexentry{DISJOINT\_DEF@{\ptt DISJOINT\_DEF}}{8} \indexentry{definition!of INSERT@of {\ptt INSERT}}{8} \indexentry{INSERT\_DEF@{\ptt INSERT\_DEF}}{8} \indexentry{definition!of DELETE@of {\ptt DELETE}}{8} \indexentry{DELETE\_DEF@{\ptt DELETE\_DEF}}{8} \indexentry{IN\_INSERT@{\ptt IN\_INSERT}}{9} \indexentry{IN\_DELETE@{\ptt IN\_DELETE}}{9} \indexentry{define\_finite\_set\_syntax@{\ptt define\_finite\_set\_syntax}}{9} \indexentry{print\_set@{\ptt print\_set} (flag)}{9} \indexentry{IN\_CONV@{\ptt IN\_CONV}|(}{10} \indexentry{conversions!IN\_CONV@{\ptt IN\_CONV}|(}{10} \indexentry{IN\_CONV@{\ptt IN\_CONV}|)}{11} \indexentry{conversions!IN\_CONV@{\ptt IN\_CONV}|)}{11} \indexentry{UNION\_CONV@{\ptt UNION\_CONV}|(}{11} \indexentry{conversions!UNION\_CONV@{\ptt UNION\_CONV}|(}{11} \indexentry{UNION\_CONV@{\ptt UNION\_CONV}|)}{12} \indexentry{conversions!UNION\_CONV@{\ptt UNION\_CONV}|)}{12} \indexentry{INSERT\_CONV@{\ptt INSERT\_CONV}|(}{12} \indexentry{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|(}{12} \indexentry{INSERT\_CONV@{\ptt INSERT\_CONV}|)}{13} \indexentry{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|)}{13} \indexentry{DELETE\_CONV@{\ptt DELETE\_CONV}|(}{13} \indexentry{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|(}{13} \indexentry{DELETE\_CONV@{\ptt DELETE\_CONV}|)}{13} \indexentry{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|)}{13} \indexentry{definition!of SING@of {\ptt SING}}{14} \indexentry{SING\_DEF@{\ptt SING\_DEF}}{14} \indexentry{SING@{\ptt SING}}{14} \indexentry{SING@{\ptt SING}}{14} \indexentry{naming conventions!for theorems about singletons|(}{14} \indexentry{naming conventions!for theorems about singletons|)}{14} \indexentry{definition!of CHOICE@of {\ptt CHOICE}}{14} \indexentry{CHOICE\_DEF@{\ptt CHOICE\_DEF}}{14} \indexentry{definition!of REST@of {\ptt REST}}{14} \indexentry{REST\_DEF@{\ptt REST\_DEF}}{14} \indexentry{definition!of IMAGE@of {\ptt IMAGE}}{15} \indexentry{IMAGE\_DEF@{\ptt IMAGE\_DEF}}{15} \indexentry{IN\_IMAGE@{\ptt IN\_IMAGE}}{15} \indexentry{IMAGE\_CONV@{\ptt IMAGE\_CONV}|(}{15} \indexentry{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|(}{15} \indexentry{IMAGE\_CONV@{\ptt IMAGE\_CONV}|)}{16} \indexentry{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|)}{16} \indexentry{definition!of INJ@of {\ptt INJ}}{16} \indexentry{INJ\_DEF@{\ptt INJ\_DEF}}{16} \indexentry{definition!of SURJ@of {\ptt SURJ}}{16} \indexentry{SURJ\_DEF@{\ptt SURJ\_DEF}}{16} \indexentry{definition!of BIJ@of {\ptt BIJ}}{17} \indexentry{BIJ\_DEF@{\ptt BIJ\_DEF}}{17} \indexentry{definition!of LINV@of {\ptt LINV}}{17} \indexentry{LINV\_DEF@{\ptt LINV\_DEF}}{17} \indexentry{definition!of RINV@of {\ptt RINV}}{17} \indexentry{RINV\_DEF@{\ptt RINV\_DEF}}{17} \indexentry{definition!of FINITE@of {\ptt FINITE}}{17} \indexentry{FINITE\_DEF@{\ptt FINITE\_DEF}}{17} \indexentry{FINITE\_EMPTY@{\ptt FINITE\_EMPTY}}{17} \indexentry{FINITE\_INSERT@{\ptt FINITE\_INSERT}}{17} \indexentry{definition!of INFINITE@of {\ptt INFINITE}}{17} \indexentry{INFINITE\_DEF@{\ptt INFINITE\_DEF}}{17} \indexentry{IMAGE\_11\_INFINITE@{\ptt IMAGE\_11\_INFINITE}}{18} \indexentry{FINITE\_CONV@{\ptt FINITE\_CONV}|(}{18} \indexentry{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|(}{18} \indexentry{FINITE\_CONV@{\ptt FINITE\_CONV}|)}{18} \indexentry{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|)}{18} \indexentry{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(}{18} \indexentry{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(}{18} \indexentry{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}{19} \indexentry{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}{19} \indexentry{definition!of CARD@of {\ptt CARD}}{19} \indexentry{CARD\_DEF@{\ptt CARD\_DEF}}{19} \indexentry{CARD\_SING@{\ptt CARD\_SING}}{19} \indexentry{FINITE\_ISO\_NUM@{\ptt FINITE\_ISO\_NUM}}{19} \indexentry{load\_sets@{\ptt load\_sets}|(}{21} \indexentry{load\_sets@{\ptt load\_sets}|)}{21} \indexentry{DELETE\_CONV@{\ptt DELETE\_CONV}}{23} \indexentry{FINITE\_CONV@{\ptt FINITE\_CONV}}{24} \indexentry{IMAGE\_CONV@{\ptt IMAGE\_CONV}}{25} \indexentry{INSERT\_CONV@{\ptt INSERT\_CONV}}{27} \indexentry{IN\_CONV@{\ptt IN\_CONV}}{28} \indexentry{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}}{30} \indexentry{SET\_SPEC\_CONV@{\ptt SET\_SPEC\_CONV}}{30} \indexentry{UNION\_CONV@{\ptt UNION\_CONV}}{31} \indexentry{set\_ISO\_DEF@{\ptt set\_ISO\_DEF}}{33} \indexentry{set\_TY\_DEF@{\ptt set\_TY\_DEF}}{33} \indexentry{EXTENSION@{\ptt EXTENSION}}{33} \indexentry{GSPECIFICATION@{\ptt GSPECIFICATION}}{33} \indexentry{GSPEC\_DEF@{\ptt GSPEC\_DEF}}{33} \indexentry{IN\_DEF@{\ptt IN\_DEF}}{33} \indexentry{NOT\_EQUAL\_SETS@{\ptt NOT\_EQUAL\_SETS}}{33} \indexentry{NUM\_SET\_WOP@{\ptt NUM\_SET\_WOP}}{34} \indexentry{SET\_MINIMUM@{\ptt SET\_MINIMUM}}{34} \indexentry{SPECIFICATION@{\ptt SPECIFICATION}}{34} \indexentry{EMPTY\_DEF@{\ptt EMPTY\_DEF}}{34} \indexentry{EMPTY\_NOT\_UNIV@{\ptt EMPTY\_NOT\_UNIV}}{34} \indexentry{EQ\_UNIV@{\ptt EQ\_UNIV}}{34} \indexentry{IN\_UNIV@{\ptt IN\_UNIV}}{34} \indexentry{MEMBER\_NOT\_EMPTY@{\ptt MEMBER\_NOT\_EMPTY}}{34} \indexentry{NOT\_IN\_EMPTY@{\ptt NOT\_IN\_EMPTY}}{34} \indexentry{UNIV\_DEF@{\ptt UNIV\_DEF}}{34} \indexentry{UNIV\_NOT\_EMPTY@{\ptt UNIV\_NOT\_EMPTY}}{34} \indexentry{EMPTY\_SUBSET@{\ptt EMPTY\_SUBSET}}{34} \indexentry{NOT\_PSUBSET\_EMPTY@{\ptt NOT\_PSUBSET\_EMPTY}}{34} \indexentry{NOT\_UNIV\_PSUBSET@{\ptt NOT\_UNIV\_PSUBSET}}{35} \indexentry{PSUBSET\_DEF@{\ptt PSUBSET\_DEF}}{35} \indexentry{PSUBSET\_IRREFL@{\ptt PSUBSET\_IRREFL}}{35} \indexentry{PSUBSET\_MEMBER@{\ptt PSUBSET\_MEMBER}}{35} \indexentry{PSUBSET\_TRANS@{\ptt PSUBSET\_TRANS}}{35} \indexentry{PSUBSET\_UNIV@{\ptt PSUBSET\_UNIV}}{35} \indexentry{SUBSET\_ANTISYM@{\ptt SUBSET\_ANTISYM}}{35} \indexentry{SUBSET\_DEF@{\ptt SUBSET\_DEF}}{35} \indexentry{SUBSET\_EMPTY@{\ptt SUBSET\_EMPTY}}{35} \indexentry{SUBSET\_REFL@{\ptt SUBSET\_REFL}}{35} \indexentry{SUBSET\_TRANS@{\ptt SUBSET\_TRANS}}{35} \indexentry{SUBSET\_UNIV@{\ptt SUBSET\_UNIV}}{35} \indexentry{UNIV\_SUBSET@{\ptt UNIV\_SUBSET}}{35} \indexentry{EMPTY\_UNION@{\ptt EMPTY\_UNION}}{35} \indexentry{INTER\_ASSOC@{\ptt INTER\_ASSOC}}{36} \indexentry{INTER\_COMM@{\ptt INTER\_COMM}}{36} \indexentry{INTER\_DEF@{\ptt INTER\_DEF}}{36} \indexentry{INTER\_EMPTY@{\ptt INTER\_EMPTY}}{36} \indexentry{INTER\_IDEMPOT@{\ptt INTER\_IDEMPOT}}{36} \indexentry{INTER\_OVER\_UNION@{\ptt INTER\_OVER\_UNION}}{36} \indexentry{INTER\_SUBSET@{\ptt INTER\_SUBSET}}{36} \indexentry{INTER\_UNIV@{\ptt INTER\_UNIV}}{36} \indexentry{IN\_INTER@{\ptt IN\_INTER}}{36} \indexentry{IN\_UNION@{\ptt IN\_UNION}}{36} \indexentry{SUBSET\_INTER\_ABSORPTION@{\ptt SUBSET\_INTER\_ABSORPTION}}{36} \indexentry{SUBSET\_UNION@{\ptt SUBSET\_UNION}}{36} \indexentry{SUBSET\_UNION\_ABSORPTION@{\ptt SUBSET\_UNION\_ABSORPTION}}{36} \indexentry{UNION\_ASSOC@{\ptt UNION\_ASSOC}}{36} \indexentry{UNION\_COMM@{\ptt UNION\_COMM}}{36} \indexentry{UNION\_DEF@{\ptt UNION\_DEF}}{36} \indexentry{UNION\_EMPTY@{\ptt UNION\_EMPTY}}{37} \indexentry{UNION\_IDEMPOT@{\ptt UNION\_IDEMPOT}}{37} \indexentry{UNION\_OVER\_INTER@{\ptt UNION\_OVER\_INTER}}{37} \indexentry{UNION\_UNIV@{\ptt UNION\_UNIV}}{37} \indexentry{DIFF\_DEF@{\ptt DIFF\_DEF}}{37} \indexentry{DIFF\_DIFF@{\ptt DIFF\_DIFF}}{37} \indexentry{DIFF\_EMPTY@{\ptt DIFF\_EMPTY}}{37} \indexentry{DIFF\_EQ\_EMPTY@{\ptt DIFF\_EQ\_EMPTY}}{37} \indexentry{DIFF\_UNIV@{\ptt DIFF\_UNIV}}{37} \indexentry{EMPTY\_DIFF@{\ptt EMPTY\_DIFF}}{37} \indexentry{IN\_DIFF@{\ptt IN\_DIFF}}{37} \indexentry{DISJOINT\_DEF@{\ptt DISJOINT\_DEF}}{37} \indexentry{DISJOINT\_DELETE\_SYM@{\ptt DISJOINT\_DELETE\_SYM}}{37} \indexentry{DISJOINT\_EMPTY@{\ptt DISJOINT\_EMPTY}}{38} \indexentry{DISJOINT\_EMPTY\_REFL@{\ptt DISJOINT\_EMPTY\_REFL}}{38} \indexentry{DISJOINT\_SYM@{\ptt DISJOINT\_SYM}}{38} \indexentry{DISJOINT\_UNION@{\ptt DISJOINT\_UNION}}{38} \indexentry{IN\_DISJOINT@{\ptt IN\_DISJOINT}}{38} \indexentry{ABSORPTION@{\ptt ABSORPTION}}{38} \indexentry{COMPONENT@{\ptt COMPONENT}}{38} \indexentry{DECOMPOSITION@{\ptt DECOMPOSITION}}{38} \indexentry{DELETE\_COMM@{\ptt DELETE\_COMM}}{38} \indexentry{DELETE\_DEF@{\ptt DELETE\_DEF}}{38} \indexentry{DELETE\_DELETE@{\ptt DELETE\_DELETE}}{38} \indexentry{DELETE\_INSERT@{\ptt DELETE\_INSERT}}{38} \indexentry{DELETE\_INTER@{\ptt DELETE\_INTER}}{38} \indexentry{DELETE\_NON\_ELEMENT@{\ptt DELETE\_NON\_ELEMENT}}{38} \indexentry{DELETE\_SUBSET@{\ptt DELETE\_SUBSET}}{39} \indexentry{DIFF\_INSERT@{\ptt DIFF\_INSERT}}{39} \indexentry{DISJOINT\_INSERT@{\ptt DISJOINT\_INSERT}}{39} \indexentry{EMPTY\_DELETE@{\ptt EMPTY\_DELETE}}{39} \indexentry{INSERT\_COMM@{\ptt INSERT\_COMM}}{39} \indexentry{INSERT\_DEF@{\ptt INSERT\_DEF}}{39} \indexentry{INSERT\_DELETE@{\ptt INSERT\_DELETE}}{39} \indexentry{INSERT\_DIFF@{\ptt INSERT\_DIFF}}{39} \indexentry{INSERT\_INSERT@{\ptt INSERT\_INSERT}}{39} \indexentry{INSERT\_INTER@{\ptt INSERT\_INTER}}{39} \indexentry{INSERT\_SUBSET@{\ptt INSERT\_SUBSET}}{39} \indexentry{INSERT\_UNION@{\ptt INSERT\_UNION}}{39} \indexentry{INSERT\_UNION\_EQ@{\ptt INSERT\_UNION\_EQ}}{39} \indexentry{INSERT\_UNIV@{\ptt INSERT\_UNIV}}{39} \indexentry{IN\_DELETE@{\ptt IN\_DELETE}}{39} \indexentry{IN\_DELETE\_EQ@{\ptt IN\_DELETE\_EQ}}{40} \indexentry{IN\_INSERT@{\ptt IN\_INSERT}}{40} \indexentry{NOT\_EMPTY\_INSERT@{\ptt NOT\_EMPTY\_INSERT}}{40} \indexentry{NOT\_INSERT\_EMPTY@{\ptt NOT\_INSERT\_EMPTY}}{40} \indexentry{PSUBSET\_INSERT\_SUBSET@{\ptt PSUBSET\_INSERT\_SUBSET}}{40} \indexentry{SET\_CASES@{\ptt SET\_CASES}}{40} \indexentry{SUBSET\_DELETE@{\ptt SUBSET\_DELETE}}{40} \indexentry{SUBSET\_INSERT@{\ptt SUBSET\_INSERT}}{40} \indexentry{SUBSET\_INSERT\_DELETE@{\ptt SUBSET\_INSERT\_DELETE}}{40} \indexentry{CHOICE\_DEF@{\ptt CHOICE\_DEF}}{40} \indexentry{CHOICE\_INSERT\_REST@{\ptt CHOICE\_INSERT\_REST}}{40} \indexentry{CHOICE\_NOT\_IN\_REST@{\ptt CHOICE\_NOT\_IN\_REST}}{40} \indexentry{CHOICE\_SING@{\ptt CHOICE\_SING}}{40} \indexentry{REST\_DEF@{\ptt REST\_DEF}}{40} \indexentry{REST\_PSUBSET@{\ptt REST\_PSUBSET}}{41} \indexentry{REST\_SING@{\ptt REST\_SING}}{41} \indexentry{REST\_SUBSET@{\ptt REST\_SUBSET}}{41} \indexentry{SING\_IFF\_EMPTY\_REST@{\ptt SING\_IFF\_EMPTY\_REST}}{41} \indexentry{IMAGE\_COMPOSE@{\ptt IMAGE\_COMPOSE}}{41} \indexentry{IMAGE\_DEF@{\ptt IMAGE\_DEF}}{41} \indexentry{IMAGE\_DELETE@{\ptt IMAGE\_DELETE}}{41} \indexentry{IMAGE\_EMPTY@{\ptt IMAGE\_EMPTY}}{41} \indexentry{IMAGE\_EQ\_EMPTY@{\ptt IMAGE\_EQ\_EMPTY}}{41} \indexentry{IMAGE\_ID@{\ptt IMAGE\_ID}}{41} \indexentry{IMAGE\_IN@{\ptt IMAGE\_IN}}{41} \indexentry{IMAGE\_INSERT@{\ptt IMAGE\_INSERT}}{41} \indexentry{IMAGE\_INTER@{\ptt IMAGE\_INTER}}{41} \indexentry{IMAGE\_SUBSET@{\ptt IMAGE\_SUBSET}}{41} \indexentry{IMAGE\_UNION@{\ptt IMAGE\_UNION}}{42} \indexentry{IN\_IMAGE@{\ptt IN\_IMAGE}}{42} \indexentry{BIJ\_COMPOSE@{\ptt BIJ\_COMPOSE}}{42} \indexentry{BIJ\_DEF@{\ptt BIJ\_DEF}}{42} \indexentry{BIJ\_EMPTY@{\ptt BIJ\_EMPTY}}{42} \indexentry{BIJ\_ID@{\ptt BIJ\_ID}}{42} \indexentry{IMAGE\_SURJ@{\ptt IMAGE\_SURJ}}{42} \indexentry{INJ\_COMPOSE@{\ptt INJ\_COMPOSE}}{42} \indexentry{INJ\_DEF@{\ptt INJ\_DEF}}{42} \indexentry{INJ\_EMPTY@{\ptt INJ\_EMPTY}}{42} \indexentry{INJ\_ID@{\ptt INJ\_ID}}{42} \indexentry{LINV\_DEF@{\ptt LINV\_DEF}}{42} \indexentry{RINV\_DEF@{\ptt RINV\_DEF}}{42} \indexentry{SURJ\_COMPOSE@{\ptt SURJ\_COMPOSE}}{43} \indexentry{SURJ\_DEF@{\ptt SURJ\_DEF}}{43} \indexentry{SURJ\_EMPTY@{\ptt SURJ\_EMPTY}}{43} \indexentry{SURJ\_ID@{\ptt SURJ\_ID}}{43} \indexentry{DELETE\_EQ\_SING@{\ptt DELETE\_EQ\_SING}}{43} \indexentry{DISJOINT\_SING\_EMPTY@{\ptt DISJOINT\_SING\_EMPTY}}{43} \indexentry{EQUAL\_SING@{\ptt EQUAL\_SING}}{43} \indexentry{FINITE\_SING@{\ptt FINITE\_SING}}{43} \indexentry{INSERT\_SING\_UNION@{\ptt INSERT\_SING\_UNION}}{43} \indexentry{IN\_SING@{\ptt IN\_SING}}{43} \indexentry{NOT\_EMPTY\_SING@{\ptt NOT\_EMPTY\_SING}}{43} \indexentry{NOT\_SING\_EMPTY@{\ptt NOT\_SING\_EMPTY}}{43} \indexentry{SING@{\ptt SING}}{43} \indexentry{SING\_DEF@{\ptt SING\_DEF}}{44} \indexentry{SING\_DELETE@{\ptt SING\_DELETE}}{44} \indexentry{SING\_FINITE@{\ptt SING\_FINITE}}{44} \indexentry{FINITE\_DEF@{\ptt FINITE\_DEF}}{44} \indexentry{FINITE\_DELETE@{\ptt FINITE\_DELETE}}{44} \indexentry{FINITE\_DIFF@{\ptt FINITE\_DIFF}}{44} \indexentry{FINITE\_EMPTY@{\ptt FINITE\_EMPTY}}{44} \indexentry{FINITE\_INDUCT@{\ptt FINITE\_INDUCT}}{44} \indexentry{FINITE\_INSERT@{\ptt FINITE\_INSERT}}{44} \indexentry{FINITE\_ISO\_NUM@{\ptt FINITE\_ISO\_NUM}}{44} \indexentry{FINITE\_PSUBSET\_INFINITE@{\ptt FINITE\_PSUBSET\_INFINITE}}{44} \indexentry{FINITE\_PSUBSET\_UNIV@{\ptt FINITE\_PSUBSET\_UNIV}}{44} \indexentry{FINITE\_UNION@{\ptt FINITE\_UNION}}{45} \indexentry{IMAGE\_11\_INFINITE@{\ptt IMAGE\_11\_INFINITE}}{45} \indexentry{IMAGE\_FINITE@{\ptt IMAGE\_FINITE}}{45} \indexentry{INFINITE\_DEF@{\ptt INFINITE\_DEF}}{45} \indexentry{INFINITE\_DIFF\_FINITE@{\ptt INFINITE\_DIFF\_FINITE}}{45} \indexentry{INFINITE\_SUBSET@{\ptt INFINITE\_SUBSET}}{45} \indexentry{INFINITE\_UNIV@{\ptt INFINITE\_UNIV}}{45} \indexentry{INTER\_FINITE@{\ptt INTER\_FINITE}}{45} \indexentry{IN\_INFINITE\_NOT\_FINITE@{\ptt IN\_INFINITE\_NOT\_FINITE}}{45} \indexentry{NOT\_IN\_FINITE@{\ptt NOT\_IN\_FINITE}}{45} \indexentry{PSUBSET\_FINITE@{\ptt PSUBSET\_FINITE}}{45} \indexentry{SUBSET\_FINITE@{\ptt SUBSET\_FINITE}}{45} \indexentry{CARD\_DEF@{\ptt CARD\_DEF}}{46} \indexentry{CARD\_DELETE@{\ptt CARD\_DELETE}}{46} \indexentry{CARD\_DIFF@{\ptt CARD\_DIFF}}{46} \indexentry{CARD\_EMPTY@{\ptt CARD\_EMPTY}}{46} \indexentry{CARD\_EQ\_0@{\ptt CARD\_EQ\_0}}{46} \indexentry{CARD\_INSERT@{\ptt CARD\_INSERT}}{46} \indexentry{CARD\_INTER\_LESS\_EQ@{\ptt CARD\_INTER\_LESS\_EQ}}{46} \indexentry{CARD\_PSUBSET@{\ptt CARD\_PSUBSET}}{46} \indexentry{CARD\_SING@{\ptt CARD\_SING}}{46} \indexentry{CARD\_SUBSET@{\ptt CARD\_SUBSET}}{46} \indexentry{CARD\_UNION@{\ptt CARD\_UNION}}{47} \indexentry{LESS\_CARD\_DIFF@{\ptt LESS\_CARD\_DIFF}}{47} \indexentry{SING\_IFF\_CARD1@{\ptt SING\_IFF\_CARD1}}{47} hol88-2.02.19940316/Library/sets/Manual/sets.aux0000640000212700021270000000021205535606170017222 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{theorems.aux} \@input{references.aux} \@input{index.aux} hol88-2.02.19940316/Library/sets/Manual/references.tex0000640000212700021270000000027005112531726020367 0ustar cammcamm\begin{thebibliography}{99} \bibitem{description} % OK University of Cambridge Computer Laboratory, {\it The HOL System: DESCRIPTION}, revised edition, 1991. \end{thebibliography} hol88-2.02.19940316/Library/sets/Manual/title.aux0000640000212700021270000000077305535606123017377 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/sets/Manual/theorems-intro.tex0000640000212700021270000000106105105002671021216 0ustar cammcamm\label{theorems} The sections that follow list all theorems in the \ml{sets} library, including definitions. The theorems are grouped into sections according to subject matter. Some theorems could be classified under more than one subject, but each theorem is listed in only one section. The reader may therefore have to consult more than one section when searching for any particular theorem. When the \ml{sets} library is loaded, all the theorems listed in this chapter (including definitions) are set up to autoload when their names are mentioned in \ML. hol88-2.02.19940316/Library/sets/Manual/entries.tex0000640000212700021270000005221305535606042017726 0ustar cammcamm\chapter{ML Functions in the sets Library} \label{entries} \input{entries-intro} \DOC{DELETE\_CONV} \TYPE {\small\verb%DELETE_CONV : conv -> conv%}\egroup \SYNOPSIS Reduce {\small\verb%{x1,...,xn} DELETE x%} by deleting {\small\verb%x%} from {\small\verb%{x1,...,xn}%}. \DESCRIBE The function {\small\verb%DELETE_CONV%} is a parameterized conversion for reducing finite sets of the form {\small\verb%"{t1,...,tn} DELETE t"%}, where {\small\verb%{t1,...,tn}%} is a set of type {\small\verb%(ty)set%} and {\small\verb%t%} is a term of type {\small\verb%ty%}. The first argument to {\small\verb%DELETE_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion {\small\verb%conv%}, the function {\small\verb%DELETE_CONV%} returns a conversion that maps a term of the form {\small\verb%"{t1,...,tn} DELETE t"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- {t1,...,tn} DELETE t = {ti,...,tj} \end{verbatim} } \noindent where {\small\verb%{ti,...,tj}%} is the subset of {\small\verb%{t1,...,tn}%} for which the supplied equality conversion {\small\verb%conv%} proves {\par\samepage\setseps\small \begin{verbatim} |- (ti = t) = F, ..., |- (tj = t) = F \end{verbatim} } \noindent and for all the elements {\small\verb%tk%} in {\small\verb%{t1,...,tn}%} but not in {\small\verb%{ti,...,tj}%}, either {\small\verb%conv%} proves {\small\verb%|- (tk = t) = T%} or {\small\verb%tk%} is alpha-equivalent to {\small\verb%t%}. That is, the reduced set {\small\verb%{ti,...,tj}%} comprises all those elements of the original set that are provably not equal to the deleted element {\small\verb%t%}. \EXAMPLE In the following example, the conversion {\small\verb%num_EQ_CONV%} is supplied as a parameter and used to test equality of the deleted value {\small\verb%2%} with the elements of the set. {\par\samepage\setseps\small \begin{verbatim} #DELETE_CONV num_EQ_CONV "{2,1,SUC 1,3} DELETE 2";; |- {2,1,SUC 1,3} DELETE 2 = {1,3} \end{verbatim} } \FAILURE {\small\verb%DELETE_CONV conv%} fails if applied to a term not of the form {\small\verb%"{t1,...,tn} DELETE t"%}. A call {\small\verb%DELETE_CONV conv "{t1,...,tn} DELETE t"%} fails unless for each element {\small\verb%ti%} of the set {\small\verb%{t1,...,tn}%}, the term {\small\verb%t%} is either alpha-equivalent to {\small\verb%ti%} or {\small\verb%conv "ti = t"%} returns {\small\verb%|- (ti = t) = T%} or {\small\verb%|- (ti = t) = F%}. \SEEALSO INSERT_CONV. \ENDDOC \DOC{FINITE\_CONV} \TYPE {\small\verb%FINITE_CONV : conv%}\egroup \SYNOPSIS Proves finiteness of sets of the form {\small\verb%"{x1,...,xn}"%}. \DESCRIBE The conversion {\small\verb%FINITE_CONV%} expects its term argument to be an assertion of the form {\small\verb%"FINITE {x1,...,xn}"%}. Given such a term, the conversion returns the theorem {\par\samepage\setseps\small \begin{verbatim} |- FINITE {x1,...,xn} = T \end{verbatim} } \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #FINITE_CONV "FINITE {1,2,3}";; |- FINITE{1,2,3} = T #FINITE_CONV "FINITE ({}:num set)";; |- FINITE{} = T \end{verbatim} } \FAILURE Fails if applied to a term not of the form {\small\verb%"FINITE {x1,...,xn}"%}. \ENDDOC \DOC{IMAGE\_CONV} \TYPE {\small\verb%IMAGE_CONV : conv -> conv -> conv%}\egroup \SYNOPSIS Compute the image of a function on a finite set. \DESCRIBE The function {\small\verb%IMAGE_CONV%} is a parameterized conversion for computing the image of a function {\small\verb%f:ty1->ty2%} on a finite set {\small\verb%"{t1,...,tn}"%} of type {\small\verb%(ty1)set%}. The first argument to {\small\verb%IMAGE_CONV%} is expected to be a conversion that computes the result of applying the function {\small\verb%f%} to each element of this set. When applied to a term {\small\verb%"f ti"%}, this conversion should return a theorem of the form {\small\verb%|- (f ti) = ri%}, where {\small\verb%ri%} is the result of applying the function {\small\verb%f%} to the element {\small\verb%ti%}. This conversion is used by {\small\verb%IMAGE_CONV%} to compute a theorem of the form {\par\samepage\setseps\small \begin{verbatim} |- IMAGE f {t1,...,tn} = {r1,...,rn} \end{verbatim} } \noindent The second argument to {\small\verb%IMAGE_CONV%} is used (optionally) to simplify the resulting image set {\small\verb%{r1,...,rn}%} by removing redundant occurrences of values. This conversion expected to decide equality of values of the result type {\small\verb%ty2%}; given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty2%}, the conversion should return either {\small\verb%|- (e1 = e2) = T%} or {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given appropriate conversions {\small\verb%conv1%} and {\small\verb%conv2%}, the function {\small\verb%IMAGE_CONV%} returns a conversion that maps a term of the form {\small\verb%"IMAGE f {t1,...,tn}"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- IMAGE f {t1,...,tn} = {rj,...,rk} \end{verbatim} } \noindent where {\small\verb%conv1%} proves a theorem of the form {\small\verb%|- (f ti) = ri%} for each element {\small\verb%ti%} of the set {\small\verb%{t1,...,tn}%}, and where the set {\small\verb%{rj,...,rk}%} is the smallest subset of {\small\verb%{r1,...,rn}%} such no two elements are alpha-equivalent and {\small\verb%conv2%} does not map {\small\verb%"rl = rm"%} to the theorem {\small\verb%|- (rl = rm) = T%} for any pair of values {\small\verb%rl%} and {\small\verb%rm%} in {\small\verb%{rj,...,rk}%}. That is, {\small\verb%{rj,...,rk}%} is the set obtained by removing multiple occurrences of values from the set {\small\verb%{r1,...,rn}%}, where the equality conversion {\small\verb%conv2%} (or alpha-equivalence) is used to determine which pairs of terms in {\small\verb%{r1,...,rn}%} are equal. \EXAMPLE The following is a very simple example in which {\small\verb%REFL%} is used to construct the result of applying the function {\small\verb%f%} to each element of the set {\small\verb%{1,2,1,4}%}, and {\small\verb%NO_CONV%} is the supplied `equality conversion'. {\par\samepage\setseps\small \begin{verbatim} #IMAGE_CONV REFL NO_CONV "IMAGE (f:num->num) {1,2,1,4}";; |- IMAGE f{1,2,1,4} = {f 2,f 1,f 4} \end{verbatim} } \noindent The result contains only one occurrence of `{\small\verb%f 1%}', even though {\small\verb%NO_CONV%} always fails, since {\small\verb%IMAGE_CONV%} simplifies the resulting set by removing elements that are redundant up to alpha-equivalence. For the next example, we construct a conversion that maps {\small\verb%SUC n%} for any numeral {\small\verb%n%} to the numeral standing for the successor of {\small\verb%n%}. {\par\samepage\setseps\small \begin{verbatim} #let SUC_CONV tm = let n = int_of_string(fst(dest_const(rand tm))) in let sucn = mk_const(string_of_int(n+1), ":num") in SYM (num_CONV sucn);; SUC_CONV = - : conv \end{verbatim} } \noindent The result is a conversion that inverts {\small\verb%num_CONV%}: {\par\samepage\setseps\small \begin{verbatim} #num_CONV "4";; |- 4 = SUC 3 #SUC_CONV "SUC 3";; |- SUC 3 = 4 \end{verbatim} } \noindent The conversion {\small\verb%SUC_CONV%} can then be used to compute the image of the successor function on a finite set: {\par\samepage\setseps\small \begin{verbatim} #IMAGE_CONV SUC_CONV NO_CONV "IMAGE SUC {1,2,1,4}";; |- IMAGE SUC{1,2,1,4} = {3,2,5} \end{verbatim} } \noindent Note that {\small\verb%2%} (= {\small\verb%SUC 1%}) appears only once in the resulting set. Fianlly, here is an example of using {\small\verb%IMAGE_CONV%} to compute the image of a paired addition function on a set of pairs of numbers: {\par\samepage\setseps\small \begin{verbatim} #IMAGE_CONV (PAIRED_BETA_CONV THENC ADD_CONV) num_EQ_CONV "IMAGE (\(n,m).n+m) {(1,2), (3,4), (0,3), (1,3)}";; |- IMAGE(\(n,m). n + m){(1,2),(3,4),(0,3),(1,3)} = {7,3,4} \end{verbatim} } \FAILURE {\small\verb%IMAGE_CONV conv1 conv2%} fails if applied to a term not of the form {\small\verb%"IMAGE f {t1,...,tn}"%}. An application of {\small\verb%IMAGE_CONV conv1 conv2%} to a term {\small\verb%"IMAGE f {t1,...,tn}"%} fails unless for all {\small\verb%ti%} in the set {\small\verb%{t1,...,tn}%}, evaluating {\small\verb%conv1 "f ti"%} returns {\small\verb%|- (f ti) = ri%} for some {\small\verb%ri%}. \ENDDOC \DOC{INSERT\_CONV} \TYPE {\small\verb%INSERT_CONV : conv -> conv%}\egroup \SYNOPSIS Reduce {\small\verb%x INSERT {x1,...,x,...,xn}%} to {\small\verb%{x1,...,x,...,xn}%}. \DESCRIBE The function {\small\verb%INSERT_CONV%} is a parameterized conversion for reducing finite sets of the form {\small\verb%"t INSERT {t1,...,tn}"%}, where {\small\verb%{t1,...,tn}%} is a set of type {\small\verb%(ty)set%} and {\small\verb%t%} is equal to some element {\small\verb%ti%} of this set. The first argument to {\small\verb%INSERT_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion, the function {\small\verb%INSERT_CONV%} returns a conversion that maps a term of the form {\small\verb%"t INSERT {t1,...,tn}"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- t INSERT {t1,...,tn} = {t1,...,tn} \end{verbatim} } \noindent if {\small\verb%t%} is alpha-equivalent to any {\small\verb%ti%} in the set {\small\verb%{t1,...,tn}%}, or if the supplied conversion proves {\small\verb%|- (t = ti) = T%} for any {\small\verb%ti%}. \EXAMPLE In the following example, the conversion {\small\verb%num_EQ_CONV%} is supplied as a parameter and used to test equality of the inserted value {\small\verb%2%} with the remaining elements of the set. {\par\samepage\setseps\small \begin{verbatim} #INSERT_CONV num_EQ_CONV "2 INSERT {1,SUC 1,3}";; |- {2,1,SUC 1,3} = {1,SUC 1,3} \end{verbatim} } \noindent In this example, the supplied conversion {\small\verb%num_EQ_CONV%} is able to prove that {\small\verb%2%} is equal to {\small\verb%SUC 1%} and the set is therefore reduced. Note that {\small\verb%"2 INSERT {1,SUC 1,3}"%} is just {\small\verb%"{2,1,SUC 1,3}"%}. A call to {\small\verb%INSERT_CONV%} fails when the value being inserted is provably not equal to any of the remaining elements: {\par\samepage\setseps\small \begin{verbatim} #INSERT_CONV num_EQ_CONV "1 INSERT {2,3}";; evaluation failed INSERT_CONV \end{verbatim} } \noindent But this failure can, if desired, be caught using {\small\verb%TRY_CONV%}. The behaviour of the supplied conversion is irrelevant when the inserted value is alpha-equivalent to one of the remaining elements: {\par\samepage\setseps\small \begin{verbatim} #INSERT_CONV NO_CONV "(y:*) INSERT {x,y,z}";; |- {y,x,y,z} = {x,y,z} \end{verbatim} } \noindent The conversion {\small\verb%NO_CONV%} always fails, but {\small\verb%INSERT_CONV%} is nontheless able in this case to prove the required result. Note that {\small\verb%DEPTH_CONV(INSERT_CONV conv)%} can be used to remove duplicate elements from a finite set, but the following conversion is faster: {\par\samepage\setseps\small \begin{verbatim} #letrec REDUCE_CONV conv tm = (SUB_CONV (REDUCE_CONV conv) THENC (TRY_CONV (INSERT_CONV conv))) tm;; REDUCE_CONV = - : (conv -> conv) #REDUCE_CONV num_EQ_CONV "{1,2,1,3,2,4,3,5,6}";; |- {1,2,1,3,2,4,3,5,6} = {1,2,4,3,5,6} \end{verbatim} } \FAILURE {\small\verb%INSERT_CONV conv%} fails if applied to a term not of the form {\small\verb%"t INSERT {t1,...,tn}"%}. A call {\small\verb%INSERT_CONV conv "t INSERT {t1,...,tn}"%} fails unless {\small\verb%t%} is alpha-equivalent to some {\small\verb%ti%}, or {\small\verb%conv "t = ti"%} returns {\small\verb%|- (t = ti) = T%} for some {\small\verb%ti%}. \SEEALSO DELETE_CONV. \ENDDOC \DOC{IN\_CONV} \TYPE {\small\verb%IN_CONV : conv -> conv%}\egroup \SYNOPSIS Decision procedure for membership in finite sets. \DESCRIBE The function {\small\verb%IN_CONV%} is a parameterized conversion for proving or disproving membership assertions of the general form: {\par\samepage\setseps\small \begin{verbatim} "t IN {t1,...,tn}" \end{verbatim} } \noindent where {\small\verb%{t1,...,tn}%} is a set of type {\small\verb%(ty)set%} and {\small\verb%t%} is a value of the base type {\small\verb%ty%}. The first argument to {\small\verb%IN_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion, the function {\small\verb%IN_CONV%} returns a conversion that maps a term of the form {\small\verb%"t IN {t1,...,tn}"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- t IN {t1,...,tn} = T \end{verbatim} } \noindent if {\small\verb%t%} is alpha-equivalent to any {\small\verb%ti%}, or if the supplied conversion proves {\small\verb%|- (t = ti) = T%} for any {\small\verb%ti%}. If the supplied conversion proves {\small\verb%|- (t = ti) = F%} for every {\small\verb%ti%}, then the result is the theorem {\par\samepage\setseps\small \begin{verbatim} |- t IN {t1,...,tn} = F \end{verbatim} } \noindent In all other cases, {\small\verb%IN_CONV%} will fail. \EXAMPLE In the following example, the conversion {\small\verb%num_EQ_CONV%} is supplied as a parameter and used to test equality of the candidate element {\small\verb%1%} with the actual elements of the given set. {\par\samepage\setseps\small \begin{verbatim} #IN_CONV num_EQ_CONV "2 IN {0,SUC 1,3}";; |- 2 IN {0,SUC 1,3} = T \end{verbatim} } \noindent The result is {\small\verb%T%} because {\small\verb%num_EQ_CONV%} is able to prove that {\small\verb%2%} is equal to {\small\verb%SUC 1%}. An example of a negative result is: {\par\samepage\setseps\small \begin{verbatim} #IN_CONV num_EQ_CONV "1 IN {0,2,3}";; |- 1 IN {0,2,3} = F \end{verbatim} } \noindent Finally the behaviour of the supplied conversion is irrelevant when the value to be tested for membership is alpha-equivalent to an actual element: {\par\samepage\setseps\small \begin{verbatim} #IN_CONV NO_CONV "1 IN {3,2,1}";; |- 1 IN {3,2,1} = T \end{verbatim} } \noindent The conversion {\small\verb%NO_CONV%} always fails, but {\small\verb%IN_CONV%} is nontheless able in this case to prove the required result. \FAILURE {\small\verb%IN_CONV conv%} fails if applied to a term that is not of the form {\small\verb%"t IN {t1,...,tn}"%}. A call {\small\verb%IN_CONV conv "t IN {t1,...,tn}"%} fails unless the term {\small\verb%t%} is alpha-equivalent to some {\small\verb%ti%}, or {\small\verb%conv "t = ti"%} returns {\small\verb%|- (t = ti) = T%} for some {\small\verb%ti%}, or {\small\verb%conv "t = ti"%} returns {\small\verb%|- (t = ti) = F%} for every {\small\verb%ti%}. \ENDDOC \DOC{SET\_INDUCT\_TAC} \TYPE {\small\verb%SET_INDUCT_TAC : tactic%}\egroup \SYNOPSIS Tactic for induction on finite sets. \DESCRIBE {\small\verb%SET_INDUCT_TAC%} is an induction tacic for proving properties of finite sets. When applied to a goal of the form {\par\samepage\setseps\small \begin{verbatim} !s. FINITE s ==> P[s] \end{verbatim} } \noindent {\small\verb%SET_INDUCT_TAC%} reduces this goal to proving that the property {\small\verb%\s.P[s]%} holds of the empty set and is preserved by insertion of an element into an arbitrary finite set. Since every finite set can be built up from the empty set {\small\verb%"{}"%} by repeated insertion of values, these subgoals imply that the property {\small\verb%\s.P[s]%} holds of all finite sets. The tactic specification of {\small\verb%SET_INDUCT_TAC%} is: {\par\samepage\setseps\small \begin{verbatim} A ?- !s. FINITE s ==> P ========================================================== SET_INDUCT_TAC A |- P[{}/s] A u {FINITE s', P[s'/s], ~e IN s'} ?- P[e INSERT s'/s] \end{verbatim} } \noindent where {\small\verb%e%} is a variable chosen so as not to appear free in the assumptions {\small\verb%A%}, and {\small\verb%s'%} is a primed variant of {\small\verb%s%} that does not appear free in {\small\verb%A%} (usually, {\small\verb%s'%} is just {\small\verb%s%}). \FAILURE {\small\verb%SET_INDUCT_TAC (A,g)%} fails unless {\small\verb%g%} has the form {\small\verb%!s. FINITE s ==> P%}, where the variable {\small\verb%s%} has type {\small\verb%(ty)set%} for some type {\small\verb%ty%}. \ENDDOC \DOC{SET\_SPEC\_CONV} \TYPE {\small\verb%SET_SPEC_CONV : conv%}\egroup \SYNOPSIS Axiom-scheme of specification for set abstractions. \DESCRIBE The conversion {\small\verb%SET_SPEC_CONV%} expects its term argument to be an assertion of the form {\small\verb%"t IN {E | P}"%}. Given such a term, the conversion returns a theorem that defines the condition under which this membership assertion holds. When {\small\verb%E%} is just a variable {\small\verb%v%}, the conversion returns: {\par\samepage\setseps\small \begin{verbatim} |- t IN {v | P} = P[t/v] \end{verbatim} } \noindent and when {\small\verb%E%} is not a variable but some other expression, the theorem returned is: {\par\samepage\setseps\small \begin{verbatim} |- t IN {E | P} = ?x1...xn. (t = E) /\ P \end{verbatim} } \noindent where {\small\verb%x1%}, ..., {\small\verb%xn%} are the variables that occur free both in the expression {\small\verb%E%} and in the proposition {\small\verb%P%}. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #SET_SPEC_CONV "12 IN {n | n > N}";; |- 12 IN {n | n > N} = 12 > N #SET_SPEC_CONV "p IN {(n,m) | n < m}";; |- p IN {(n,m) | n < m} = (?n m. (p = n,m) /\ n < m) \end{verbatim} } \FAILURE Fails if applied to a term that is not of the form {\small\verb%"t IN {E | P}"%}. \ENDDOC \DOC{UNION\_CONV} \TYPE {\small\verb%UNION_CONV : conv -> conv%}\egroup \SYNOPSIS Reduce {\small\verb%{t1,...,tn} UNION s%} to {\small\verb%t1 INSERT (... (tn INSERT s))%}. \DESCRIBE The function {\small\verb%UNION_CONV%} is a parameterized conversion for reducing sets of the form {\small\verb%"{t1,...,tn} UNION s"%}, where {\small\verb%{t1,...,tn}%} and {\small\verb%s%} are sets of type {\small\verb%(ty)set%}. The first argument to {\small\verb%UNION_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion, the function {\small\verb%UNION_CONV%} returns a conversion that maps a term of the form {\small\verb%"{t1,...,tn} UNION s"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- t UNION {t1,...,tn} = ti INSERT ... (tj INSERT s) \end{verbatim} } \noindent where {\small\verb%{ti,...,tj}%} is the set of all terms {\small\verb%t%} that occur as elements of {\small\verb%{t1,...,tn}%} for which the conversion {\small\verb%IN_CONV conv%} fails to prove that {\small\verb%|- (t IN s) = T%} (that is, either by proving {\small\verb%|- (t IN s) = F%} instead, or by failing outright). \EXAMPLE In the following example, {\small\verb%num_EQ_CONV%} is supplied as a parameter to {\small\verb%UNION_CONV%} and used to test for membership of each element of the first finite set {\small\verb%{1,2,3}%} of the union in the second finite set {\small\verb%{SUC 0,3,4}%}. {\par\samepage\setseps\small \begin{verbatim} #UNION_CONV num_EQ_CONV "{1,2,3} UNION {SUC 0,3,4}";; |- {1,2,3} UNION {SUC 0,3,4} = {2,SUC 0,3,4} \end{verbatim} } \noindent The result is {\small\verb%{2,SUC 0,3,4}%}, rather than {\small\verb%{1,2,SUC 0,3,4}%}, because {\small\verb%UNION_CONV%} is able by means of a call to {\par\samepage\setseps\small \begin{verbatim} IN_CONV num_EQ_CONV "1 IN {SUC 0,3,4}" \end{verbatim} } \noindent to prove that {\small\verb%1%} is already an element of the set {\small\verb%{SUC 0,3,4}%}. The conversion supplied to {\small\verb%UNION_CONV%} need not actually prove equality of elements, if simplification of the resulting set is not desired. For example: {\par\samepage\setseps\small \begin{verbatim} #UNION_CONV NO_CONV "{1,2,3} UNION {SUC 0,3,4}";; |- {1,2,3} UNION {SUC 0,3,4} = {1,2,SUC 0,3,4} \end{verbatim} } \noindent In this case, the resulting set is just left unsimplified. Moreover, the second set argument to {\small\verb%UNION%} need not be a finite set: {\par\samepage\setseps\small \begin{verbatim} #UNION_CONV NO_CONV "{1,2,3} UNION s";; |- {1,2,3} UNION s = 1 INSERT (2 INSERT (3 INSERT s)) \end{verbatim} } \noindent And, of course, in this case the conversion argument to {\small\verb%UNION_CONV%} is irrelevant. \FAILURE {\small\verb%UNION_CONV conv%} fails if applied to a term not of the form {\small\verb%"{t1,...,tn} UNION s"%}. \SEEALSO IN_CONV. \ENDDOC hol88-2.02.19940316/Library/sets/Manual/theorems.tex0000640000212700021270000004013005535606040020074 0ustar cammcamm\chapter{Pre-proved Theorems} \input{theorems-intro} \section{The type definition} \THEOREM set\_ISO\_DEF sets |- (!a. SPEC(CHF a) = a) /\ (!r. (\p. T)r = (CHF(SPEC r) = r)) \ENDTHEOREM \THEOREM set\_TY\_DEF sets |- ?rep. TYPE_DEFINITION(\p. T)rep \ENDTHEOREM \section{Membership, equality, and set specifications} \THEOREM EXTENSION sets |- !s t. (s = t) = (!x. x IN s = x IN t) \ENDTHEOREM \THEOREM GSPECIFICATION sets |- !f v. v IN (GSPEC f) = (?x. v,T = f x) \ENDTHEOREM \THEOREM GSPEC\_DEF sets |- !f. GSPEC f = SPEC(\y. ?x. y,T = f x) \ENDTHEOREM \THEOREM IN\_DEF sets |- !x s. x IN s = CHF s x \ENDTHEOREM \THEOREM NOT\_EQUAL\_SETS sets |- !s t. ~(s = t) = (?x. x IN t = ~x IN s) \ENDTHEOREM \THEOREM NUM\_SET\_WOP sets |- !s. (?n. n IN s) = (?n. n IN s /\ (!m. m IN s ==> n <= m)) \ENDTHEOREM \THEOREM SET\_MINIMUM sets |- !s M. (?x. x IN s) = (?x. x IN s /\ (!y. y IN s ==> (M x) <= (M y))) \ENDTHEOREM \THEOREM SPECIFICATION sets |- !P x. x IN (SPEC P) = P x \ENDTHEOREM \section{The empty and universal sets} \THEOREM EMPTY\_DEF sets |- {} = SPEC(\x. F) \ENDTHEOREM \THEOREM EMPTY\_NOT\_UNIV sets |- ~({} = UNIV) \ENDTHEOREM \THEOREM EQ\_UNIV sets |- (!x. x IN s) = (s = UNIV) \ENDTHEOREM \THEOREM IN\_UNIV sets |- !x. x IN UNIV \ENDTHEOREM \THEOREM MEMBER\_NOT\_EMPTY sets |- !s. (?x. x IN s) = ~(s = {}) \ENDTHEOREM \THEOREM NOT\_IN\_EMPTY sets |- !x. ~x IN {} \ENDTHEOREM \THEOREM UNIV\_DEF sets |- UNIV = SPEC(\x. T) \ENDTHEOREM \THEOREM UNIV\_NOT\_EMPTY sets |- ~(UNIV = {}) \ENDTHEOREM \section{Set inclusion} \THEOREM EMPTY\_SUBSET sets |- !s. {} SUBSET s \ENDTHEOREM \THEOREM NOT\_PSUBSET\_EMPTY sets |- !s. ~s PSUBSET {} \ENDTHEOREM \THEOREM NOT\_UNIV\_PSUBSET sets |- !s. ~UNIV PSUBSET s \ENDTHEOREM \THEOREM PSUBSET\_DEF sets |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) \ENDTHEOREM \THEOREM PSUBSET\_IRREFL sets |- !s. ~s PSUBSET s \ENDTHEOREM \THEOREM PSUBSET\_MEMBER sets |- !s t. s PSUBSET t = s SUBSET t /\ (?y. y IN t /\ ~y IN s) \ENDTHEOREM \THEOREM PSUBSET\_TRANS sets |- !s t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u \ENDTHEOREM \THEOREM PSUBSET\_UNIV sets |- !s. s PSUBSET UNIV = (?x. ~x IN s) \ENDTHEOREM \THEOREM SUBSET\_ANTISYM sets |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) \ENDTHEOREM \THEOREM SUBSET\_DEF sets |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) \ENDTHEOREM \THEOREM SUBSET\_EMPTY sets |- !s. s SUBSET {} = (s = {}) \ENDTHEOREM \THEOREM SUBSET\_REFL sets |- !s. s SUBSET s \ENDTHEOREM \THEOREM SUBSET\_TRANS sets |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u \ENDTHEOREM \THEOREM SUBSET\_UNIV sets |- !s. s SUBSET UNIV \ENDTHEOREM \THEOREM UNIV\_SUBSET sets |- !s. UNIV SUBSET s = (s = UNIV) \ENDTHEOREM \section{Intersection and union} \THEOREM EMPTY\_UNION sets |- !s t. (s UNION t = {}) = (s = {}) /\ (t = {}) \ENDTHEOREM \THEOREM INTER\_ASSOC sets |- !s t u. (s INTER t) INTER u = s INTER (t INTER u) \ENDTHEOREM \THEOREM INTER\_COMM sets |- !s t. s INTER t = t INTER s \ENDTHEOREM \THEOREM INTER\_DEF sets |- !s t. s INTER t = {x | x IN s /\ x IN t} \ENDTHEOREM \THEOREM INTER\_EMPTY sets |- (!s. {} INTER s = {}) /\ (!s. s INTER {} = {}) \ENDTHEOREM \THEOREM INTER\_IDEMPOT sets |- !s. s INTER s = s \ENDTHEOREM \THEOREM INTER\_OVER\_UNION sets |- !s t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u) \ENDTHEOREM \THEOREM INTER\_SUBSET sets |- (!s t. (s INTER t) SUBSET s) /\ (!s t. (t INTER s) SUBSET s) \ENDTHEOREM \THEOREM INTER\_UNIV sets |- (!s. UNIV INTER s = s) /\ (!s. s INTER UNIV = s) \ENDTHEOREM \THEOREM IN\_INTER sets |- !s t x. x IN (s INTER t) = x IN s /\ x IN t \ENDTHEOREM \THEOREM IN\_UNION sets |- !s t x. x IN (s UNION t) = x IN s \/ x IN t \ENDTHEOREM \THEOREM SUBSET\_INTER\_ABSORPTION sets |- !s t. s SUBSET t = (s INTER t = s) \ENDTHEOREM \THEOREM SUBSET\_UNION sets |- (!s t. s SUBSET (s UNION t)) /\ (!s t. s SUBSET (t UNION s)) \ENDTHEOREM \THEOREM SUBSET\_UNION\_ABSORPTION sets |- !s t. s SUBSET t = (s UNION t = t) \ENDTHEOREM \THEOREM UNION\_ASSOC sets |- !s t u. (s UNION t) UNION u = s UNION (t UNION u) \ENDTHEOREM \THEOREM UNION\_COMM sets |- !s t. s UNION t = t UNION s \ENDTHEOREM \THEOREM UNION\_DEF sets |- !s t. s UNION t = {x | x IN s \/ x IN t} \ENDTHEOREM \THEOREM UNION\_EMPTY sets |- (!s. {} UNION s = s) /\ (!s. s UNION {} = s) \ENDTHEOREM \THEOREM UNION\_IDEMPOT sets |- !s. s UNION s = s \ENDTHEOREM \THEOREM UNION\_OVER\_INTER sets |- !s t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u) \ENDTHEOREM \THEOREM UNION\_UNIV sets |- (!s. UNIV UNION s = UNIV) /\ (!s. s UNION UNIV = UNIV) \ENDTHEOREM \section{Set difference} \THEOREM DIFF\_DEF sets |- !s t. s DIFF t = {x | x IN s /\ ~x IN t} \ENDTHEOREM \THEOREM DIFF\_DIFF sets |- !s t. (s DIFF t) DIFF t = s DIFF t \ENDTHEOREM \THEOREM DIFF\_EMPTY sets |- !s. s DIFF {} = s \ENDTHEOREM \THEOREM DIFF\_EQ\_EMPTY sets |- !s. s DIFF s = {} \ENDTHEOREM \THEOREM DIFF\_UNIV sets |- !s. s DIFF UNIV = {} \ENDTHEOREM \THEOREM EMPTY\_DIFF sets |- !s. {} DIFF s = {} \ENDTHEOREM \THEOREM IN\_DIFF sets |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t \ENDTHEOREM \section{Disjoint sets} \THEOREM DISJOINT\_DEF sets |- !s t. DISJOINT s t = (s INTER t = {}) \ENDTHEOREM \THEOREM DISJOINT\_DELETE\_SYM sets |- !s t x. DISJOINT(s DELETE x)t = DISJOINT(t DELETE x)s \ENDTHEOREM \THEOREM DISJOINT\_EMPTY sets |- !s. DISJOINT {} s /\ DISJOINT s {} \ENDTHEOREM \THEOREM DISJOINT\_EMPTY\_REFL sets |- !s. (s = {}) = DISJOINT s s \ENDTHEOREM \THEOREM DISJOINT\_SYM sets |- !s t. DISJOINT s t = DISJOINT t s \ENDTHEOREM \THEOREM DISJOINT\_UNION sets |- !s t u. DISJOINT(s UNION t)u = DISJOINT s u /\ DISJOINT t u \ENDTHEOREM \THEOREM IN\_DISJOINT sets |- !s t. DISJOINT s t = ~(?x. x IN s /\ x IN t) \ENDTHEOREM \section{Insertion and deletion of an element} \THEOREM ABSORPTION sets |- !x s. x IN s = (x INSERT s = s) \ENDTHEOREM \THEOREM COMPONENT sets |- !x s. x IN (x INSERT s) \ENDTHEOREM \THEOREM DECOMPOSITION sets |- !s x. x IN s = (?t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM \THEOREM DELETE\_COMM sets |- !x y s. (s DELETE x) DELETE y = (s DELETE y) DELETE x \ENDTHEOREM \THEOREM DELETE\_DEF sets |- !s x. s DELETE x = s DIFF {x} \ENDTHEOREM \THEOREM DELETE\_DELETE sets |- !x s. (s DELETE x) DELETE x = s DELETE x \ENDTHEOREM \THEOREM DELETE\_INSERT sets |- !x y s. (x INSERT s) DELETE y = ((x = y) => s DELETE y | x INSERT (s DELETE y)) \ENDTHEOREM \THEOREM DELETE\_INTER sets |- !s t x. (s DELETE x) INTER t = (s INTER t) DELETE x \ENDTHEOREM \THEOREM DELETE\_NON\_ELEMENT sets |- !x s. ~x IN s = (s DELETE x = s) \ENDTHEOREM \THEOREM DELETE\_SUBSET sets |- !x s. (s DELETE x) SUBSET s \ENDTHEOREM \THEOREM DIFF\_INSERT sets |- !s t x. s DIFF (x INSERT t) = (s DELETE x) DIFF t \ENDTHEOREM \THEOREM DISJOINT\_INSERT sets |- !x s t. DISJOINT(x INSERT s)t = DISJOINT s t /\ ~x IN t \ENDTHEOREM \THEOREM EMPTY\_DELETE sets |- !x. {} DELETE x = {} \ENDTHEOREM \THEOREM INSERT\_COMM sets |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) \ENDTHEOREM \THEOREM INSERT\_DEF sets |- !x s. x INSERT s = {y | (y = x) \/ y IN s} \ENDTHEOREM \THEOREM INSERT\_DELETE sets |- !x s. x IN s ==> (x INSERT (s DELETE x) = s) \ENDTHEOREM \THEOREM INSERT\_DIFF sets |- !s t x. (x INSERT s) DIFF t = (x IN t => s DIFF t | x INSERT (s DIFF t)) \ENDTHEOREM \THEOREM INSERT\_INSERT sets |- !x s. x INSERT (x INSERT s) = x INSERT s \ENDTHEOREM \THEOREM INSERT\_INTER sets |- !x s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t) \ENDTHEOREM \THEOREM INSERT\_SUBSET sets |- !x s t. (x INSERT s) SUBSET t = x IN t /\ s SUBSET t \ENDTHEOREM \THEOREM INSERT\_UNION sets |- !x s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t)) \ENDTHEOREM \THEOREM INSERT\_UNION\_EQ sets |- !x s t. (x INSERT s) UNION t = x INSERT (s UNION t) \ENDTHEOREM \THEOREM INSERT\_UNIV sets |- !x. x INSERT UNIV = UNIV \ENDTHEOREM \THEOREM IN\_DELETE sets |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) \ENDTHEOREM \THEOREM IN\_DELETE\_EQ sets |- !s x x'. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x)) \ENDTHEOREM \THEOREM IN\_INSERT sets |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s \ENDTHEOREM \THEOREM NOT\_EMPTY\_INSERT sets |- !x s. ~({} = x INSERT s) \ENDTHEOREM \THEOREM NOT\_INSERT\_EMPTY sets |- !x s. ~(x INSERT s = {}) \ENDTHEOREM \THEOREM PSUBSET\_INSERT\_SUBSET sets |- !s t. s PSUBSET t = (?x. ~x IN s /\ (x INSERT s) SUBSET t) \ENDTHEOREM \THEOREM SET\_CASES sets |- !s. (s = {}) \/ (?x t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM \THEOREM SUBSET\_DELETE sets |- !x s t. s SUBSET (t DELETE x) = ~x IN s /\ s SUBSET t \ENDTHEOREM \THEOREM SUBSET\_INSERT sets |- !x s. ~x IN s ==> (!t. s SUBSET (x INSERT t) = s SUBSET t) \ENDTHEOREM \THEOREM SUBSET\_INSERT\_DELETE sets |- !x s t. s SUBSET (x INSERT t) = (s DELETE x) SUBSET t \ENDTHEOREM \section{The {\tt CHOICE} and {\tt REST} functions} \THEOREM CHOICE\_DEF sets |- !s. ~(s = {}) ==> (CHOICE s) IN s \ENDTHEOREM \THEOREM CHOICE\_INSERT\_REST sets |- !s. ~(s = {}) ==> ((CHOICE s) INSERT (REST s) = s) \ENDTHEOREM \THEOREM CHOICE\_NOT\_IN\_REST sets |- !s. ~(CHOICE s) IN (REST s) \ENDTHEOREM \THEOREM CHOICE\_SING sets |- !x. CHOICE{x} = x \ENDTHEOREM \THEOREM REST\_DEF sets |- !s. REST s = s DELETE (CHOICE s) \ENDTHEOREM \THEOREM REST\_PSUBSET sets |- !s. ~(s = {}) ==> (REST s) PSUBSET s \ENDTHEOREM \THEOREM REST\_SING sets |- !x. REST{x} = {} \ENDTHEOREM \THEOREM REST\_SUBSET sets |- !s. (REST s) SUBSET s \ENDTHEOREM \THEOREM SING\_IFF\_EMPTY\_REST sets |- !s. SING s = ~(s = {}) /\ (REST s = {}) \ENDTHEOREM \section{Image of a function on a set} \THEOREM IMAGE\_COMPOSE sets |- !f g s. IMAGE(f o g)s = IMAGE f(IMAGE g s) \ENDTHEOREM \THEOREM IMAGE\_DEF sets |- !f s. IMAGE f s = {f x | x IN s} \ENDTHEOREM \THEOREM IMAGE\_DELETE sets |- !f x s. ~x IN s ==> (IMAGE f(s DELETE x) = IMAGE f s) \ENDTHEOREM \THEOREM IMAGE\_EMPTY sets |- !f. IMAGE f{} = {} \ENDTHEOREM \THEOREM IMAGE\_EQ\_EMPTY sets |- !s f. (IMAGE f s = {}) = (s = {}) \ENDTHEOREM \THEOREM IMAGE\_ID sets |- !s. IMAGE(\x. x)s = s \ENDTHEOREM \THEOREM IMAGE\_IN sets |- !x s. x IN s ==> (!f. (f x) IN (IMAGE f s)) \ENDTHEOREM \THEOREM IMAGE\_INSERT sets |- !f x s. IMAGE f(x INSERT s) = (f x) INSERT (IMAGE f s) \ENDTHEOREM \THEOREM IMAGE\_INTER sets |- !f s t. (IMAGE f(s INTER t)) SUBSET ((IMAGE f s) INTER (IMAGE f t)) \ENDTHEOREM \THEOREM IMAGE\_SUBSET sets |- !s t. s SUBSET t ==> (!f. (IMAGE f s) SUBSET (IMAGE f t)) \ENDTHEOREM \THEOREM IMAGE\_UNION sets |- !f s t. IMAGE f(s UNION t) = (IMAGE f s) UNION (IMAGE f t) \ENDTHEOREM \THEOREM IN\_IMAGE sets |- !y s f. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) \ENDTHEOREM \section{Mappings between sets} \THEOREM BIJ\_COMPOSE sets |- !f g s t u. BIJ f s t /\ BIJ g t u ==> BIJ(g o f)s u \ENDTHEOREM \THEOREM BIJ\_DEF sets |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t \ENDTHEOREM \THEOREM BIJ\_EMPTY sets |- !f. (!s. BIJ f{}s = (s = {})) /\ (!s. BIJ f s{} = (s = {})) \ENDTHEOREM \THEOREM BIJ\_ID sets |- !s. BIJ(\x. x)s s \ENDTHEOREM \THEOREM IMAGE\_SURJ sets |- !f s t. SURJ f s t = (IMAGE f s = t) \ENDTHEOREM \THEOREM INJ\_COMPOSE sets |- !f g s t u. INJ f s t /\ INJ g t u ==> INJ(g o f)s u \ENDTHEOREM \THEOREM INJ\_DEF sets |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) \ENDTHEOREM \THEOREM INJ\_EMPTY sets |- !f. (!s. INJ f{}s) /\ (!s. INJ f s{} = (s = {})) \ENDTHEOREM \THEOREM INJ\_ID sets |- !s. INJ(\x. x)s s \ENDTHEOREM \THEOREM LINV\_DEF sets |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) \ENDTHEOREM \THEOREM RINV\_DEF sets |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) \ENDTHEOREM \THEOREM SURJ\_COMPOSE sets |- !f g s t u. SURJ f s t /\ SURJ g t u ==> SURJ(g o f)s u \ENDTHEOREM \THEOREM SURJ\_DEF sets |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) \ENDTHEOREM \THEOREM SURJ\_EMPTY sets |- !f. (!s. SURJ f{}s = (s = {})) /\ (!s. SURJ f s{} = (s = {})) \ENDTHEOREM \THEOREM SURJ\_ID sets |- !s. SURJ(\x. x)s s \ENDTHEOREM \section{Singleton sets} \THEOREM DELETE\_EQ\_SING sets |- !s x. x IN s ==> ((s DELETE x = {}) = (s = {x})) \ENDTHEOREM \THEOREM DISJOINT\_SING\_EMPTY sets |- !x. DISJOINT{x}{} \ENDTHEOREM \THEOREM EQUAL\_SING sets |- !x y. ({x} = {y}) = (x = y) \ENDTHEOREM \THEOREM FINITE\_SING sets |- !x. FINITE{x} \ENDTHEOREM \THEOREM INSERT\_SING\_UNION sets |- !s x. x INSERT s = {x} UNION s \ENDTHEOREM \THEOREM IN\_SING sets |- !x y. x IN {y} = (x = y) \ENDTHEOREM \THEOREM NOT\_EMPTY\_SING sets |- !x. ~({} = {x}) \ENDTHEOREM \THEOREM NOT\_SING\_EMPTY sets |- !x. ~({x} = {}) \ENDTHEOREM \THEOREM SING sets |- !x. SING{x} \ENDTHEOREM \THEOREM SING\_DEF sets |- !s. SING s = (?x. s = {x}) \ENDTHEOREM \THEOREM SING\_DELETE sets |- !x. {x} DELETE x = {} \ENDTHEOREM \THEOREM SING\_FINITE sets |- !s. SING s ==> FINITE s \ENDTHEOREM \section{Finite and infinite sets} \THEOREM FINITE\_DEF sets |- !s. FINITE s = (!P. P{} /\ (!s'. P s' ==> (!e. P(e INSERT s'))) ==> P s) \ENDTHEOREM \THEOREM FINITE\_DELETE sets |- !x s. FINITE(s DELETE x) = FINITE s \ENDTHEOREM \THEOREM FINITE\_DIFF sets |- !s. FINITE s ==> (!t. FINITE(s DIFF t)) \ENDTHEOREM \THEOREM FINITE\_EMPTY sets |- FINITE{} \ENDTHEOREM \THEOREM FINITE\_INDUCT sets |- !P. P{} /\ (!s. FINITE s /\ P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> (!s. FINITE s ==> P s) \ENDTHEOREM \THEOREM FINITE\_INSERT sets |- !x s. FINITE(x INSERT s) = FINITE s \ENDTHEOREM \THEOREM FINITE\_ISO\_NUM sets |- !s. FINITE s ==> (?f. (!n m. n < (CARD s) /\ m < (CARD s) ==> (f n = f m) ==> (n = m)) /\ (s = {f n | n < (CARD s)})) \ENDTHEOREM \THEOREM FINITE\_PSUBSET\_INFINITE sets |- !s. INFINITE s = (!t. FINITE t ==> t SUBSET s ==> t PSUBSET s) \ENDTHEOREM \THEOREM FINITE\_PSUBSET\_UNIV sets |- INFINITE UNIV = (!s. FINITE s ==> s PSUBSET UNIV) \ENDTHEOREM \THEOREM FINITE\_UNION sets |- !s t. FINITE(s UNION t) = FINITE s /\ FINITE t \ENDTHEOREM \THEOREM IMAGE\_11\_INFINITE sets |- !f. (!x y. (f x = f y) ==> (x = y)) ==> (!s. INFINITE s ==> INFINITE(IMAGE f s)) \ENDTHEOREM \THEOREM IMAGE\_FINITE sets |- !s. FINITE s ==> (!f. FINITE(IMAGE f s)) \ENDTHEOREM \THEOREM INFINITE\_DEF sets |- !s. INFINITE s = ~FINITE s \ENDTHEOREM \THEOREM INFINITE\_DIFF\_FINITE sets |- !s t. INFINITE s /\ FINITE t ==> ~(s DIFF t = {}) \ENDTHEOREM \THEOREM INFINITE\_SUBSET sets |- !s. INFINITE s ==> (!t. s SUBSET t ==> INFINITE t) \ENDTHEOREM \THEOREM INFINITE\_UNIV sets |- INFINITE (UNIV:(*)set) = (?f:*->*. (!x y. (f x = f y) ==> (x = y)) /\ (?y. !x. ~(f x = y))) \ENDTHEOREM \THEOREM INTER\_FINITE sets |- !s. FINITE s ==> (!t. FINITE(s INTER t)) \ENDTHEOREM \THEOREM IN\_INFINITE\_NOT\_FINITE sets |- !s t. INFINITE s /\ FINITE t ==> (?x. x IN s /\ ~x IN t) \ENDTHEOREM \THEOREM NOT\_IN\_FINITE sets |- INFINITE UNIV = (!s. FINITE s ==> (?x. ~x IN s)) \ENDTHEOREM \THEOREM PSUBSET\_FINITE sets |- !s. FINITE s ==> (!t. t PSUBSET s ==> FINITE t) \ENDTHEOREM \THEOREM SUBSET\_FINITE sets |- !s. FINITE s ==> (!t. t SUBSET s ==> FINITE t) \ENDTHEOREM \section{Cardinality of sets} \THEOREM CARD\_DEF sets |- (CARD{} = 0) /\ (!s. FINITE s ==> (!x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)))) \ENDTHEOREM \THEOREM CARD\_DELETE sets |- !s. FINITE s ==> (!x. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s)) \ENDTHEOREM \THEOREM CARD\_DIFF sets |- !t. FINITE t ==> (!s. FINITE s ==> (CARD(s DIFF t) = (CARD s) - (CARD(s INTER t)))) \ENDTHEOREM \THEOREM CARD\_EMPTY sets |- CARD{} = 0 \ENDTHEOREM \THEOREM CARD\_EQ\_0 sets |- !s. FINITE s ==> ((CARD s = 0) = (s = {})) \ENDTHEOREM \THEOREM CARD\_INSERT sets |- !s. FINITE s ==> (!x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s))) \ENDTHEOREM \THEOREM CARD\_INTER\_LESS\_EQ sets |- !s. FINITE s ==> (!t. (CARD(s INTER t)) <= (CARD s)) \ENDTHEOREM \THEOREM CARD\_PSUBSET sets |- !s. FINITE s ==> (!t. t PSUBSET s ==> (CARD t) < (CARD s)) \ENDTHEOREM \THEOREM CARD\_SING sets |- !x. CARD{x} = 1 \ENDTHEOREM \THEOREM CARD\_SUBSET sets |- !s. FINITE s ==> (!t. t SUBSET s ==> (CARD t) <= (CARD s)) \ENDTHEOREM \THEOREM CARD\_UNION sets |- !s. FINITE s ==> (!t. FINITE t ==> ((CARD(s UNION t)) + (CARD(s INTER t)) = (CARD s) + (CARD t))) \ENDTHEOREM \THEOREM LESS\_CARD\_DIFF sets |- !t. FINITE t ==> (!s. FINITE s ==> (CARD t) < (CARD s) ==> 0 < (CARD(s DIFF t))) \ENDTHEOREM \THEOREM SING\_IFF\_CARD1 sets |- !s. SING s = (CARD s = 1) /\ FINITE s \ENDTHEOREM hol88-2.02.19940316/Library/sets/Manual/sets.dvi0000640000212700021270000037510405535606171017227 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1024‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘jßóHò"VáG cmbx10ëHThe– ‰‹HOL“sets“LibraryŽŸI­Û’ÃÔÊó7ò"Vff cmbx10âT.–…F.“MelhamŽ ‡&‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’ÎΠOctob`er‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’˜Nþž£hó+X«Q cmr12ÖcŽŽŽ’”ëmó-!",š cmsy10Ø ŽŽŽŽ’¤ÖÖT.–ê¨F.“Melham“1991ŽŽŽŒ‹Í ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸdÅëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFºÆÛ1Ž‘ŸôThe–€sets“Library’L¯=1ŽŽ¤cI‘ŸôÖ1.1Ž‘,¦JThe–ê¨t¬rypSŽe“de nition‘­‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ß ý‹Ð!‘ü‘ßÖ3.5Ž‘˜5In¬rtersection–ê¨and“union‘!‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ35ŽŽ¤‘ü‘ß3.6Ž‘˜5Set‘ê¨di erence‘éz‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ37ŽŽ¡‘ü‘ß3.7Ž‘˜5Disjoin¬rt‘ê¨sets‘*‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ37ŽŽ¡‘ü‘ß3.8Ž‘˜5Insertion–ê¨and“deletion“of“an“elemen¬rt‘+‰‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ38ŽŽ¡‘ü‘ß3.9Ž‘˜5The–ê¨ÜCHOICE“Öand“ÜREST“Öfunctions‘†‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ40ŽŽ¡‘ü‘ß3.10Ž‘˜5Image–ê¨of“a“function“on“a“set‘=U‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ41ŽŽ¡‘ü‘ß3.11Ž‘˜5Mappings›ê¨bSŽet•¬rw“een˜sets‘ÁE‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ42ŽŽ¡‘ü‘ß3.12Ž‘˜5Singleton‘ê¨sets‘&H‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ43ŽŽ¡‘ü‘ß3.13Ž‘˜5Finite–ê¨and“in nite“sets‘ð‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ44ŽŽ¡‘ü‘ß3.14Ž‘˜5Cardinalit¬ry–ê¨of“sets‘ \‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ46ŽŽ¤¿ø‘êñëÛReferences’z’e49ŽŽ¡‘êñëIndex’˜n|50ŽŽŽŽŒ‹ Š ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸGëHThe– ‰‹sets“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThe–Š=ó"Kñ`y ó3 cmr10ÍHOL“ó(ßêØÖ.‘ V‘ÿValues“of“this“t¬rypSŽe“are“not“true“sets,‘bHbut“just“unordered“collections“ofŽ¡v‘ÿXäalues–ÿof“the“base“tš¬rypSŽe“Ó*Ž‘¾¹Ö.‘êXThe“t˜ypSŽe“Ó(*)setŽ‘(|Öis,›..in“fact,˜just“an“ob‘§ject-language“abbreviationŽ¡for–£óthe“tš¬rypSŽe“Ó*->boolŽ‘+á™Ö,‘²v‘ÿXäalues“of“whic˜h“are“predicates“on“Ó*Ž‘ cÖ.‘!NThe“elemen˜ts“of“a“set“ÓS:(*)setŽŽ¡Öare–ê¨just“those“v‘ÿXäalues“of“tš¬rypSŽe“Ó*Ž‘ ”úÖfor“whic˜h“the“correspSŽonding“predicate“is“true.Ž¡‘ aThe–ê¨tš¬rypSŽe“Ó(*)setŽ‘*SLÖis“de ned“formally“in“the“library“b˜y“the“t˜ypSŽe“de nition:Ž¤>(ŸŸý‘‘>þÓset_TY_DEF‘>þ|-–¿ª?rep:(*)set“->“(*“->“bool).“TYPE_DEFINITION(\p.“T)repŽŽŽŽŽŽŽ¡ÖThis–RÀde nitional“axiom“asserts“the“existence“of“a“bijection“ÓrepŽ‘ä~ÖbSŽet•¬rw“een–RÀsets“with“elemen¬rtsŽ¤of–ÈFtš¬rypSŽe“Ó*Ž‘ P6Öand“the“set“of“all“predicates“on“Ó*Ž‘ ‡ðÖ.‘-jIn“the“library“theory“ÓsetsŽ‘ÆîÖ,‘Ï'a“pair“of“constan˜tŽ¡functions–3jis“in¬rtroSŽduced“using“the“built-in“function“Ódefine_new_type_bijectionsŽ’›ÞÖto“denoteŽ¡this–ê¨bijection“and“its“in•¬rv“erse:Ž¤>(ŸªŸÿi‘>þÓCHF–¿ª:“(*)set“->“(*“->“bool)‘)¦Öand‘>þÓSPEC“:“(*“->“bool)“->“(*)setŽŽŽŽŽŽŽ¡ÖThe–ê¨de ning“propSŽertš¬ry“of“these“constan˜ts“is“the“constan˜t“spSŽeci cation“Óset_ISO_DEFŽ‘C&öÖ:Ž¡ŸŸý‘‘>þÓ|-–¿ª(!a.“SPEC(CHF“a)“=“a)“/\“(!r.“(\p.“T)r“=“(CHF(SPEC“r)“=“r))ŽŽŽŽŽŽŽ¡Öwhicš¬rh–ÿÚstates“that“ÓCHFŽ‘>²Öand“ÓSPECŽ‘þ\Öare“the“in˜v˜erses“of“one“another.‘xwThese“t˜w˜o“functions“canŽŸbšSŽe–òšused“to“mo•¬rv“e–òšfreely“b˜et•¬rw“een–òšsets“and“the“predicates“to“whic¬rh“they“corresp˜ond;‘v“theŽŽŸ$ý’óŸÛ1ŽŽŒ‹,· ÌU ýFÓŸú™š‘êñëÛ2’’¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖfunction‘íwÓCHFŽ‘ìÖmaps–íwa“set“to“its“c¬rharacteristic“predicate,‘î+and“ÓSPECŽ‘Ù–Ömaps“a“predicate“to“theŽ¤‘êñëset–ê¨of“v‘ÿXäalues“for“whic¬rh“it“holds.Ž© ð‘öSzThe–¥ôtheorems“Óset_TY_DEFŽ‘BÈŒÖand“Óset_ISO_DEFŽ‘Hˆ6Öshoš¬rwn“abSŽo˜v˜e“are“named“according“to“theŽ¡‘êñëgeneral› Øcon•¬rv“en“tion˜that˜all˜de nitions˜in˜the˜ÓsetsŽ‘XÖlibrary˜are˜giv“en˜names˜ending˜in˜`Ó_DEFÖ'.ŽŸ(R‘êñëç1.2Ž‘5oMem‘ÿr°b‘Oership–Ÿ¼and“the“axioms“of“set“theoryŽŸöX‘êñëÖA‘™ÿv‘ÿXäalue‘šÓxŽ‘ óÒÖis–šde ned“to“bSŽe“an“elemenš¬rt“of“a“set“exactly“when“the“c˜haracteristic“predicate“ofŽ¡‘êñëthe–Ì”set“is“true“of“ÓxŽ‘ Œ>Ö.‘.ÙThe“bijection“ÓCHFŽ‘Ø&Öjust“maps“sets“to“their“c¬rharacteristic“predicates,‘Ò˜soŽ¡‘êñëthis–ê¨memš¬rbSŽership“relation“for“sets“is“straigh˜tforw˜ard“to“de ne“as“follo˜ws:ŽŸOŸPáŸþõQ‘0éÓIN_DEF‘>þ|-–¿ª!x“s.“x“IN“s“=“CHF“s“xŽŽŽŽŽŽŽŸE‘êñëÖThe–-in x“function“constanš¬rt“ÓINŽ‘Ù`Öde ned“here“is“essen˜tially“just“an“abbreviation“for“ÓCHFŽ‘lÖ.‘ùªTheŽ¡‘êñëfunctions‘î ÓINŽ‘[fÖand‘î ÓSPECŽ‘ÚºÖ(inš¬rtro•SŽduced‘î ab“o˜v˜e)–î constitute“the“basic“language“for“the“theory“ofŽ¡‘êñësets–"´in“the“ÓsetsŽ‘!DÖlibrary;‘¾ºall“opSŽerators“and“predicates“on“sets“are“ultimately“de ned“inŽ¡‘êñëterms–ê¨of“these“t•¬rw“o‘ê¨functions.Ž¦‘öSzThe– 7 rst“signi can¬rt“theorem“in“the“ÓsetsŽ‘?Ölibrary“states“what“is“usually“called“the“ó.›»ˆ@ cmti12ÙaxiomŽ¡‘êñëof‘ÙÑextension‘…›Öfor–Ÿësets.‘X©This“is“not,›Í~Ötheory‘ÿV,˜but“rather“aŽ¡‘êñëtheorem:ŽŸOŸ@UŸÿi‘0éÓEXTENSION‘>þ|-–¿ª!s“t.“(s“=“t)“=“(!x.“x“IN“s“=“x“IN“t)ŽŽŽŽŽŽŽŸE‘êñëEXTENSIONŽ‘":×Östates–‹òthat“t•¬rw“o–‹òsets“are“equal“exactly“when“they“ha•¬rv“e–‹òthe“same“elemen¬rts.‘NThisŽ¡‘êñëfollo¬rws–Þdirectly“from“the“de nition“of“ÓINŽ‘¡Öand“the“fact“that“the“function“ÓCHFŽ‘`ºÖhas“a“leftŽ¡‘êñëin•¬rv“erse–ê¨and“is“therefore“injectiv¬re.Ž¦‘öSzThe–¶second“main“theorem“in“the“library“concerns“the“function“ÓSPECŽ‘^Ö.‘ïåThis“function“mapsŽ¡‘êñëan–v¦arbitrary“predicate“ÓP:(*->bool)Ž‘H)šÖon“v›ÿXäalues“of“t¬rypSŽe“Ó*Ž‘¬öÖto“the“set“of“all“v˜alues“Óx:*Ž‘,JÖsuc¬rhŽ¡‘êñëthat‘ŸÓP‘¿ªxŽ‘t<Öis–Ÿtrue.‘óˆThe“ÓSPECŽ‘3æÖfunction“can“therefore“bSŽe“used“to“construct“sets“from“predicatesŽ¡‘êñëthat–KãdescribšSŽe“or“`sp˜ecify'“their“elemen¬rts.‘\‘A‘KÊv‘ÿXäalue“is“in“the“constructed“set“exactly“whenŽ¡‘êñëthe–ê¨predicate“is“true“of“that“v‘ÿXäalue:ŽŸOŸ@UŸÿi‘0éÓSPECIFICATION‘>þ|-–¿ª!P“x.“x“IN“(SPEC“P)“=“P“xŽŽŽŽŽŽŽŸE‘êñëÖThis–æotheorem“correspSŽonds“to“what“is“usually“called“the“Ùaxiom–/Sof“sp–ÿffe“ci c“ation‘ÌÖfor‘æosets.‘7xItŽ¡‘êñëfolloš¬rws–ê¨directly“from“the“de nition“of“ÓINŽ‘T¤Öand“the“fact“that“ÓCHFŽ‘NÖis“the“left“in˜v˜erse“of“ÓSPECŽ‘éPÖ.Ž¦‘öSzOnce–Pùthe“theorems“ÓEXTENSIONŽ‘>^ìÖand“ÓSPECIFICATIONŽ‘U]”Öha•¬rv“e–PùbSŽeen“pro•¬rv“ed,‘ªŽthey›Pùpro“vide˜aŽ¡‘êñëcomplete–ž#basis“for“all“further“reasoning“abSŽout“sets.‘SQGivš¬ren“these“t˜w˜o“theorems,‘Ëusers“ofŽ¡‘êñëthe–9œlibrary“should“nevš¬rer“ha˜v˜e“to“appSŽeal“to“the“de nition“of“ÓINŽ‘òŒÖor“mak˜e“use“of“the“theoremsŽ¡‘êñëin–x$the“previous“section“abšSŽout“the“formal“de nition“of“the“t¬ryp˜e“Ó(*)setŽ‘%ö Ö.‘´The“library“theoryŽ¡‘êñëÓsetsŽ‘Û;Öitself–ê¨is“devš¬relopSŽed“en˜tirely“on“the“basis“of“these“t˜w˜o“`axioms'“of“set“theory‘ÿV.ŽŽŽŒ‹8§ ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €Generalized–€set“sp`eci cations’óØq3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç1.3Ž‘@ åGeneralized–Ÿ¼set“sp‘Oeci cationsŽŸâ#‘ÇaÖIn–úbaddition“to“the“basic“function“ÓSPECŽ‘ù Ö,‘*pwhicš¬rh“allo˜ws“one“to“construct“a“set“from“a“predicateŽ¤‘Çathat–«RspSŽeci es“its“elemenš¬rts,‘Û|the“ÓsetsŽ‘ ULÖlibrary“also“pro˜vides“w˜a˜y“of“constructing“sets“fromŽ¡‘Çamore–ãügeneral“forms“of“set“spšSŽeci cations.‘6§Roughly“sp˜eaking,‘åRthere“are“t•¬rw“o‘ãücomp˜onen“ts‘ãütoŽ¡‘Çaa–ÍTgeneralized“set“spSŽeci cation:‘þ8an“expression“ÓE[x]Ž‘ ™PÖand“a“predicate“ÓP[x]Ž‘ËüÖ.‘àäF‘ÿVor“anš¬ry“suc˜hŽ¡‘Çaexpression–ƒnand“predicate,›˜there“is“a“correspSŽonding“set“Ó{E[x]–¿ª|“P[x]}Ö,˜the–ƒnset“of“all“v‘ÿXäaluesŽ¡‘ÇaÓE[x]–ê¨Öfor“whic¬rh“ÓP[x]“Öholds.Ž¡‘(ðThe‘ê¨ÓsetsŽ‘ÓøÖlibrary–ê¨suppšSŽorts“generalized“set“sp˜eci cations“bš¬ry“means“of“the“constan˜t:Ž¤ן@UŸÿi‘*_ÓGSPEC–¿ª:“(**“->“(*“#“bool))“->“(*)setŽŽŽŽŽŽŽ¡‘ÇaÖThe–@ñfunction“ÓGSPECŽ‘'@4Ötak¬res“a“function“Óf–¿ª:‘ T**“->“(*“#“bool)Ž’ƒ:ÔÖand“constructs“the“set“ofŽ¤‘Çaall–½Ÿv‘ÿXäalues“ÓFST(f‘¿ªx)Ž›7xŽÖfor“whic¬rh“ÓSND(f‘¿ªx)Ž˜Öholds,‘ò]for“some“v‘ÿXäalue“ÓxŽ‘:èÖof“t¬rypSŽe“Ó**Ž‘<óÖ.‘±ÆThe“formalŽ¡‘Çade nition–ê¨of“the“constan¬rt“ÓGSPECŽ‘$“¢Öis:Ž¤ןŸý‘‘*_ÓGSPEC_DEF‘>þ|-–¿ª!f.“GSPEC“f“=“SPEC(\y.“?x.“(y,T)“=“f“x)ŽŽŽŽŽŽŽ¡‘ÇaÖThe–Ÿ\folloš¬rwing“analogue“to“the“axiom“of“spSŽeci cation“for“ÓSPECŽ‘ =`Öfollo˜ws“immediately“fromŽ©‘Çathis‘ê¨de nition:Ž¡ŸŽ3Ÿþz¬‘*_ÓGSPECIFICATION‘>þ|-–¿ª!f“v.“v“IN“(GSPEC“f)“=“(?x.“v,T“=“f“x)ŽŽŽŽŽŽŽ¡‘ÇaÖThis–à|states“that“a“v‘ÿXäalue“ÓvŽ‘ €¢Öis“an“elemenš¬rt“of“the“set“spSŽeci ed“b˜y“ÓfŽ› €¢Öexactly“when“ÓvŽ˜Öis“one“ofŽ¦‘Çathe–x.v‘ÿXäalues“of“ÓFST(f‘¿ªx)Ž›6í¬Öfor“whic¬rh“ÓSND(f‘¿ªx)Ž˜Öis“true.‘áqT‘ÿVo“see“ho¬rw“this“suppSŽorts“the“notionŽ¦‘Çaof–ï¬generalized“set“spšSŽeci cation“describ˜ed“ab˜o•¬rv“e,‘0ílet‘ï¬ÓfŽ‘ŸÖin–ï¬this“de nition“b˜e“the“functionŽ¦‘ÇaÓ\x.E[x],P[x]Ö.‘8àWith–ê¨a“little“simpli cation,“wš¬re“w˜ould“then“ha˜v˜e:Ž¡ŸŽ3Ÿþz¬‘*_Ó|-–¿ª!v.“v“IN“(GSPEC“\x.E[x],P[x])“=“?x.“(v“=“E[x])“/\“P[x]ŽŽŽŽŽŽŽ¡‘ÇaÖThat–d is,‘‚ca“v‘ÿXäalue“ÓvŽ›‡¾Öis“in“the“set“constructed“b¬ry“ÓGSPECŽ‘%†fÖexactly“when“for“some“ÓxŽ˜Öfor“whic¬rhŽ¦‘ÇaÓP[x]Ž‘)Æ Ö,‘õÂthe–óŠv›ÿXäalue“ÓvŽ‘ ¦¾Öis“equal“to“ÓE[x]Ž‘ò2Ö.‘S…The“constructed“set“therefore“con¬rtains“all“v˜alues“ÓE[x]ŽŽ¦‘ÇaÖfor–ê¨whic¬rh“ÓP[x]Ž‘ÓøÖholds.ŽŸ" $‘Çaâ1.3.1Ž‘E`âPšŠ=arser–…and“prett˜y-prin˜ter“suppuÂortŽŸÀ‘ÇaÖT‘ÿVo–tfacilitate“the“use“of“sets“constructed“b¬ry“generalized“set“spSŽeci cation,‘'the“ÓsetsŽ‘!ÖlibraryŽ¦‘Çaproš¬rvides–³Lparser“and“prett˜y-prin˜ter“suppSŽort“for“set“abstractions“of“the“form“Ó"{ó#  b> ó3 cmmi10ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"Ö.Ž¦‘ÇaThe–[Èbuilt-in“ÍML“Öfunction“Ódefine_set_abstraction_syntaxŽ’­mÒÖ(see“the“man¬rual“[1Ž‘ßü]“for“details)Ž¦‘Çais–¤used“to“in¬rtroSŽduce“this“notationŽ‘6€when“the“library“is“loaded.‘ ýÔThe“call“made“to“thisŽ¦‘Çafunction–ê¨extends“the“ÍHOL“Öparser“so“that“a“quotation“of“the“form“Ó"{ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"“Öparses“to:Ž¡Ÿ±ïŸþ34‘*_ÓGSPEC‘¿ª(\(×xŸÌÌó |{Ycmr8¸1ŽŽ‘ mVÓ,Î:–Ó1:“:Ž‘ ÆcÓ,×xŸÌÌó×2cmmi8¹nŽŽ‘ U¢Ó).(ÎE‘¡’Ó,ÎP‘…VÓ))ŽŽŽŽŽŽŽ¡‘ÇaÖwhere–g‹×xŸÌ̸1Ž‘ÀÖ,‘ÆÃ×:–ÿþ:“:ŽŽ‘‘aÖ,‘ÆÃ×xŸÌ̹nŽ‘ ÛÖare“the“v‘ÿXäariables“that“ošSŽccur“free“in“b˜oth“the“expression“×E‘¢Öand“theŽ¦‘ÇapropSŽosition–È"×P‘ièÖ(i.e.“the“set“Øf×xŸÌ̸1Ž‘À×;–ÿþ:“:“:Ž‘Êœ;‘ÿþxŸÌ̹nŽ‘¨PØg“Öis“the“in¬rtersection“of“the“set“of“free“v‘ÿXäariables“of“×EŽŽŽŒ‹F~ ÌU ýFÓŸú™š‘êñëÛ4’’¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖand–Äthe“set“of“free“v›ÿXäariables“of“×P‘¡ÆÖ).‘+þIf“there“are“Ùno‘€Öv˜ariables“free“in“bSŽoth“×E‘xÖand“×P‘¡ÆÖ,‘˼then“aŽ¤‘êñëparser–&¼error“is“generated.‘íWhen“the“Óprint_setŽ‘< rÖ ag“is“ÓtrueŽ‘%dÖ,‘5Áthe“quotation“prett•¬ry-prin“terŽ¡‘êñëin•¬rv“erts–ê¨this“transformation.Ž¡‘öSzA‘simple–Kexample“of“this“set“abstraction“notation“is“shoš¬rwn“in“the“follo˜wing“ÍHOL“Ösession,Ž¡‘êñëin–qwhic¬rh“it“is“assumed“that“the“ÓsetsŽ‘àÖÖlibrary“has“already“bSŽeen“loaded.‘Ì.(See“section“1.15Ž¡‘êñëfor–ê¨a“description“of“ho¬rw“ÓsetsŽ‘ÓøÖis“loaded.)ŽŸF˜ì‘êñëŸÇÄ׉ffÇ IŸf¶ÌÍŸYœ„jvRffŸŸà¼’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±Ÿýóp®0J cmsl10È1ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªgtr“=“new_definition“(`gtr`,“"gtr“N“=“{n“|“n“>“N}");;Ž¤ ‘ÌÍgtr–¿ª=“|-“!N.“gtr“N“=“{n“|“n“>“N}Ž©‘ÌÍ#set_flag‘¿ª(`print_set`,false);;Ž¡‘ÌÍtrue–¿ª:“boolŽ¦‘ÌÍ#"{n–¿ª|“n“>“N}";;Ž¡‘ÌÍ"GSPEC(\n.–¿ª(n,n“>“N))"“:“termŽŽ’Æq°„jvRffŽŽŸÀ‰ffÇ IŽŽŽŸEî@‘êñëÖThe–Tsterm“Ó{n–¿ª|“n“>“N}–TsÖin“the“de nition“of“ÓgtrŽ‘çäÖdenotes“the“set“of“all“natural“n•¬rum“bSŽersŽ¡‘êñëgreater–ÿ‚than“ÓNŽ‘ ¿,Ö.‘wnIt“is“impSŽortan¬rt“to“note“that“the“v›ÿXäariable“ÓNŽ‘ ¾®Öis“a“free“v˜ariable“in“this“term,Ž¡‘êñësince–ášit“oSŽccurs“on“only“one“side“of“the“bar“`Ó|Ö'.‘5ÛThe“set“abstraction“Ó{n–¿ª|“n“>“N}‘ášÖthereforeŽ¡‘êñëparses–ê¨to“the“generalized“set“spSŽeci cationŽ¤÷]ŸŽ3Ÿþz¬‘0éÓGSPEC(\n.–¿ª(n,n“>“N))ŽŽŽŽŽŽŽ¡‘êñëÖThis–#Éis“what“givš¬res“this“set“abstraction“the“(presumably“in˜tended)“in˜terpretation“`the“setŽ©‘êñëof–ê¨all“ÓnŽ‘ ”úÖgreater“than“ÓNŽ‘ ªRÖ'.‘8àBy“con¬rtrast,“the“termŽ¡ŸŽ3Ÿþz¬‘0éÓGSPEC(\(n,N).–¿ª(n,n“>“N))ŽŽŽŽŽŽŽ¡‘êñëÖdenotes–szthe“set“of“all“n•¬rum“bšSŽers‘szÓnŽ‘¦žÖgreater–szthan“some“n•¬rum“b˜er‘szÓNŽ‘ 3$Ö|i.e.,‘•¯the–szset“ØfÓ1Ž‘¿ª×;‘ÿþÓ2Ž–¿¨×;‘ÿþÓ3Ž“×;–ÿþ:“:“:Ž‘ÊžØgÖ.Ž¦‘êñëThis–ð°is“Ùnot‘ôÖthe“default“inš¬rterpretation“of“the“parser,‘22whic˜h“constructs“a“generalized“setŽ¦‘êñëspSŽeci cation–èîthat“binds“the“v‘ÿXäariable“ÓnŽ‘‘†Öonly‘ÿV.‘3±Note“that“only“default“in¬rterpretations“areŽ¦‘êñëprett•¬ry-prin“ted–ê¨using“the“set“abstraction“notation:Ž¤Eî@‘êñëŸÇÄ׉ffÇ IŸf¶ÌÍŸYœ„jvRffŸŸà¼’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#set_flag(`print_set`,true);;Ž¤ ‘ÌÍfalse–¿ª:“boolŽ©‘ÌÍ#"GSPEC–¿ª(\n.“(n,n>N))";;Ž¡‘ÌÍ"{n–¿ª|“n“>“N}"“:“termŽ¦‘ÌÍ#"GSPEC–¿ª(\(n,N).“(n,n>N))";;Ž¡‘ÌÍ"GSPEC(\(n,N).–¿ª(n,n“>“N))"“:“termŽŽ’Æq°„jvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖThat–ê¨is,“a“term“of“the“form:Ž¤÷]Ÿ±ïŸþ34‘0éÓGSPEC‘¿ª(\(×xŸÌ̸1ŽŽ‘ mVÓ,Î:–Ó1:“:Ž‘ ÆcÓ,×xŸÌ̹nŽŽ‘ U¢Ó).(ÎE‘¡’Ó,ÎP‘…VÓ))ŽŽŽŽŽŽŽ¡‘êñëÖprin¬rts–ê¨as“Ó"{ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"“Öonly“if“the“v‘ÿXäariables“×xŸÌ̸1Ž‘ÀÖ,“×:–ÿþ:“:ŽŽ‘µFÖ,“×xŸÌ̹nŽ‘ ’øÖošSŽccur“free“in“b˜oth“×E‘ž¿Öand“×P‘¡ÆÖ.ŽŽŽŒ‹Tß ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €Generalized–€set“sp`eci cations’óØq5Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘(ðÖIn–;`general,‘^nthe“expression“×E‘ïwÖin“a“set“abstraction“Ó"{ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"“Öneed“not“bSŽe“just“a“v‘ÿXäariable.Ž¤‘ÇaConsider,–ê¨for“example,“the“follo¬rwing“ÍHOL“Ösession:ŽŸI”T‘ÇaŸÇÄ׉ffÇ IŸf¶ÌÍŸYœ„jvRffŸŸà¼’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªS“=“"{(n,m)“|“n“<“m}";;Ž¤ ‘ÌÍS–¿ª=“"{(n,m)“|“n“<“m}"“:“termŽ©‘ÌÍ#set_flag(`print_set`,false);;Ž¡‘ÌÍtrue–¿ª:“boolŽ¦‘ÌÍ#"{(n,m)–¿ª|“n“<“m}";;Ž¡‘ÌÍ"GSPEC(\(n,m).–¿ª((n,m),n“<“m))"“:“termŽŽ’Æq°„jvRffŽŽŸÀ‰ffÇ IŽŽŽŸI€¦‘ÇaÖHere,‘‡Êa–oset“abstraction“is“used“to“construct“the“set“of“all“pairs“of“n•¬rum“bSŽers‘oÓ(n,m)Ž‘#œxÖfor‘owhic“hŽ¡‘ÇaÓnŽ‘ Öis–}less“than“ÓmŽ‘ <«Ö.‘SNote“that“bSŽoth“v‘ÿXäariables“ÓnŽ› ¹¬Öand“ÓmŽ˜Öare“bSŽound“in“the“underlying“generalizedŽ¡‘Çaset‘ê¨spSŽeci cation.ŽŸ#D‘Çaâ1.3.2Ž‘E`âTheorem-proŠ=ving‘…suppuÂortŽŸè‘ÇaÖThe‘â—ÓsetsŽ‘ÃÖÖlibrary–â—pro¬rvides“prošSŽof“supp˜ort“for“the“set“abstraction“notation“in“the“form“of“aŽ¡‘Çacon•¬rv“ersion–<òcalled“ÓSET_SPEC_CONVŽ‘Nø”Ö.‘/¿This“con•¬rv“ersion›<òimplemen“ts˜the˜axiom˜of˜spSŽeci cationŽ¡‘Çafor–ê¨set“abstractions.‘8àWhen“×v‘XáÖis“a“v›ÿXäariable,“ev˜aluating:Ž¤qŸŽ3Ÿþz¬‘*_ÓSET_SPEC_CONV–¿ª"ÎtŽ‘ ³ïÓIN“{ÎvŽ‘ sÓ|“ÎPŽ‘L±Ó}";;ŽŽŽŽŽŽŽ©‰Ã‘ÇaÖreturns–ê¨the“theorem:Ž¡ŸwÍŸýC4‘*_Ó|-‘¿ªÎtŽ‘s™ÓIN–¿ª{ÎvŽ‘ sÓ|“ÎPŽ‘L±Ó}“=“ÎP‘…VÍ[Ît=vd“Í]ŽŽŽŽŽŽŽŽ¦‘ÇaÖThis–³çstates“that“×t“Öis“an“elemenš¬rt“of“the“set“of“all“×v‘" Ösuc˜h“that“×P‘U­Öexactly“when“×P‘¡ÆÖ[×t=vn9Ö]“holds.Ž¤‘ÇaNote–Ñ“that,›Ö—in“general,˜the“term“×t“Öneed“not“bSŽe“a“v‘ÿXäariable.‘0„The“follo¬rwing“session“illustratesŽ¡‘Çathis–ê¨use“of“ÓSET_SPEC_CONVŽ‘RòÖfor“mem¬rbSŽership“in“a“particular“set“abstraction:ŽŸ"Fv‘ÇaŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#SET_SPEC_CONV–¿ª"12“IN“{n“|“n“>“N}";;ŽŸ ‘ÌÍ|-–¿ª12“IN“{n“|“n“>“N}“=“12“>“NŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ"2Ç‘(ðÖThe›£¸con•¬rv“ersion˜ÓSET_SPEC_CONVŽ‘TÖbSŽeha“v“es˜di eren“tly˜when˜applied˜to˜terms˜of˜the˜formŽ¡‘ÇaÓ"Ît–¿ªÓIN“{ÎE‘a<Ó|“ÎP‘…VÓ}"–î‚Öwhere“ÎE‘Öis“not“a“v‘ÿXäariable.‘DoApplying“the“con•¬rv“ersion–î‚to“a“term“of“thisŽ¡‘Çakind–ê¨yields“the“theorem:ŽŸqŸÆŸþ[†‘*_Ó|-‘¿ªÎtŽ‘s™ÓIN–¿ª{ÎEŽ›v‹Ó|“ÎPŽ‘L±Ó}“=“?ÎxŸ¤z¸1Ž‘“5Î:–Ó1:“:Ž‘Ó/xŸ¤z¹nŽŽ‘*ÿµÓ.“(ÎtŽ‘ ³ïÓ=“ÎEŽ˜Ó)“/\“ÎPŽŽŽŽŽŽŽŽ¦‘ÇaÖwhere–l×xŸÌ̸1Ž‘ÀÖ,‘Œr×:–ÿþ:“:ŽŽ‘WÖ,‘Œr×xŸÌ̹nŽ‘ gÖare“the“v‘ÿXäariables“that“ošSŽccur“free“in“b˜oth“×E‘ .Öand“×P‘¡ÆÖ.‘½,The“expression“×EŽ¡‘ÇaÖcannot–Õãin“general“bSŽe“eliminated“in“this“case,‘Ú as“it“can“b¬ry“the“substitution“×P‘¡ÆÖ[×t=vn9Ö]“when“×EŽ¡‘ÇaÖis–ê¨just“a“v‘ÿXäariable“×vn9Ö.ŽŽŽŒ‹`• ÌU ýFÓŸú™š‘êñëÛ6’’¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖThe–"folloš¬rwing“session“illustrates“the“form“of“the“theorem“pro˜v˜ed“b˜y“ÓSET_SPEC_CONVŽ‘RÿØÖforŽ¤‘êñëthe–ê¨second“t¬rypšSŽe“of“input“term“discussed“ab˜o•¬rv“e:ŽŸC Ë‘êñëŸÈµ‰ffÇ IŸe€ùÌÍŸYœ„iÚ•ffŸ |y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªth1“=“SET_SPEC_CONV“"p“IN“{(n,m)“|“n“<“m}";;Ž¤ ‘ÌÍth1–¿ª=“|-“p“IN“{(n,m)“|“n“<“m}“=“(?n“m.“(p“=“n,m)“/\“n“<“m)Ž©‘ÌÍ#let–¿ªth2“=“SET_SPEC_CONV“"(a,b)“IN“{(n,m)“|“n“<“m}";;Ž¡‘ÌÍth2–¿ª=“|-“(a,b)“IN“{(n,m)“|“n“<“m}“=“(?n“m.“(a,b“=“n,m)“/\“n“<“m)Ž¦‘ÌÍ#let–¿ªth3“=“SET_SPEC_CONV“"a“IN“{n“+“m“|“n“<“m}";;Ž¡‘ÌÍth3–¿ª=“|-“a“IN“{n“+“m“|“n“<“m}“=“(?n“m.“(a“=“n“+“m)“/\“n“<“m)ŽŽ’Æq°„iÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸC Ê‘êñëÖThe–årigh¬rt-hand“sides“of“Óth1Ž›tÈÖand“Óth2Ž˜Öcould,›&ôin“principle,˜bSŽe“further“simpli ed.‘É—The“v‘ÿXäalueŽ¡‘êñëof–ˆÜthe“expression“`Ó(n,m)Ž‘¾RÖ'“is“an“injectivš¬re“function“of“the“v‘ÿXäalues“of“ÓnŽ‘ÑbÖand“ÓmŽ‘ H†Ö,‘ðhand“so“b˜yŽ¡‘êñëeliminating–ê¨the“existenš¬rtial“quan˜ti ers“these“t˜w˜o“theorems“could“bSŽe“simpli ed“to:ŽŸ#¡êŸŽ3Ÿäz¬‘0éÓth1‘þ¨|-–¿ªp“IN“{(n,m)“|“n“<“m}“=“(FST“p“<“SND“p)ŽŸ‘0éth2‘þ¨|-–¿ª(a,b)“IN“{(n,m)“|“n“<“m}“=“(a“<“b)ŽŽŽŽŽŽŽŸ#¡é‘êñëÖBut–5in“general“the“v‘ÿXäalue“of“ÎE‘°ÇÖin“a“set“abstraction“Ó"{ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"“Öwill“not“bSŽe“an“injectiv¬reŽ¡‘êñëfunction–Tof“its“free“v‘ÿXäariables,‘npas“for“example“is“the“case“in“theorem“Óth3Ž‘“Ö.‘u'The“con•¬rv“ersionŽ¡‘êñëÓSET_SPEC_CONVŽ‘9ÔÖtherefore–àGattempts“no“further“simpli cation“of“its“result“than“is“describSŽedŽ¡‘êñëabSŽo•¬rv“e–ê¨for“the“general“case.ŽŸ'[õ‘êñëç1.4Ž‘5oThe–Ÿ¼empt›ÿr°y“and“univ˜ersal“setsŽŸâ#‘êñëÖThe–B•folloš¬rwing“t˜w˜o“set-v‘ÿXäalued“constan˜ts“are“de ned“in“the“ÓsetsŽ‘!ƒÒÖlibrary:‘è¹ÓEMPTY:(*)setŽ‘Lä±Ö,Ž¡‘êñëwhicš¬rh–3gdenotes“the“empt˜y“set;‘WÇand“ÓUNIV:(*)setŽ‘CoµÖ,‘E—whic˜h“denotes“the“univ˜erse,‘E—or“set“of“allŽ¡‘êñëv‘ÿXäalues–ê¨of“tš¬rypSŽe“Ó*Ž‘ ªRÖ.‘8àThese“constan˜ts“are“de ned“formally“as“follo˜ws:Ž¤ä—ŸÐáŸñõQ‘üq?ÓEMPTY_DEF‘ T|-–¿ªEMPTY“=“SPEC(\x.“F)ŽŸ ‘üq?UNIV_DEF‘>þ|-–¿ªUNIV‘ T=“SPEC(\x.“T)ŽŽŽŽŽŽŽ¡‘êñëÖNote–Nthat“bšSŽecause“of“the“restriction“on“free“v‘ÿXäariables“discussed“ab˜o•¬rv“e,‘mkthe–Nset“abstractionsŽ¤‘êñëÓ"{x–¿ª|“T}"–ãÖand“Ó"{x–¿ª|“F}"–ãÖcannot“bSŽe“used“in“these“de nitions;‘_Rthe“more“primitiv¬re“formŽ¡‘êñëof–1¸set“construction“proš¬rvided“b˜y“ÓSPECŽ‘bÖm˜ust“bSŽe“used“instead.‘But“users“of“the“library“willŽ¡‘êñënevš¬rer–[Èneed“to“appSŽeal“to“these“de nitions,‘xsince“the“follo˜wing“theorems“abSŽout“ÓEMPTYŽ‘%uâÖandŽ¡‘êñëÓUNIVŽ‘Û;Öare–ê¨also“made“a¬rv‘ÿXäailable“in“the“theory“ÓsetsŽ‘éPÖ:Ž¤ä—ŸÐáŸñõQ‘0éÓNOT_IN_EMPTY‘ T|-–¿ª!x.“~x“IN“EMPTYŽŸ ‘0éIN_UNIV‘(=¦|-–¿ª!x.“x“IN“UNIVŽŽŽŽŽŽŽ¡‘êñëÖThat–@is,‘•nnothing“is“an“elemenš¬rt“of“ÓEMPTYŽ‘'>xÖand“ev˜erything“is“an“elemen˜t“of“ÓUNIVŽ‘>»Ö.‘ 9!TheseŽ¤‘êñëpropSŽerties–IÒfollo¬rw“directly“from“the“de nitions“and“the“theorem“ÓSPECIFICATIONŽ‘PtÖ.‘ V]OtherŽ¡‘êñëpre-pro•¬rv“ed–ÉDtheorems“abSŽout“the“emptš¬ry“and“univ˜ersal“sets“are“also“a˜v‘ÿXäailable“in“the“library;Ž¡‘êñësee–ê¨c¬rhapter“3“for“a“complete“list.ŽŽŽŒ‹kü ÌU ýFÓŸú™š‘ÇaÛ1.5.‘ €Set‘€inclusion’UÂe7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç1.5Ž‘@ åSet‘Ÿ¼inclusionŽ©é„‘ÇaÖThe–dýin x“functions“ÓSUBSETŽ‘+GöÖand“ÓPSUBSETŽ‘1 Ödenote“the“binary“relations“of“set“inclusion“andŽ¤‘ÇapropšSŽer–ê¨set“inclusion,“resp˜ectivš¬rely‘ÿV.‘8àThese“are“de ned“formally“in“the“ob˜vious“w˜a˜y:ŽŸ"œÖŸÐáŸñõQ‘$FµÓSUBSET_DEF‘>þ|-–¿ª!s“t.“s“SUBSET“t“=“(!x.“x“IN“s“==>“x“IN“t)ŽŸ ‘$FµPSUBSET_DEF‘ T|-–¿ª!s“t.“s“PSUBSET“t“=“s“SUBSET“t“/\“~(s“=“t)ŽŽŽŽŽŽŽŸ"™6‘ÇaÖThat– ƒis,‘ºÓsŽ‘ ÞçÖis“a“subset“of“ÓtŽ‘ Ö°Öif“evš¬rery“elemen˜t“of“ÓsŽ‘ Ö°Öis“also“an“elemen˜t“of“ÓtŽ‘ Ë-Ö;‘ðand“ÓsŽ‘ Ö°Öis“a“propSŽerŽ¡‘Çasubset–ê¨of“ÓtŽ› ”úÖif“it“is“a“subset“of“ÓtŽ˜Öbut“not“equal“to“ÓtŽ‘ ªRÖ.ŽŸ¡‘(ðV‘ÿVarious›™¾pre-pro•¬rv“ed˜theorems˜ab•SŽout˜the˜subset˜and˜prop“er˜subset˜relations˜are˜suppliedŽ¡‘Çabš¬ry– Žthe“ÓsetsŽ‘ÄÖlibrary–ÿV.‘›’F“or– Žexample,‘Çthe“fact“that“ÓSUBSETŽ‘*•Öis“a“partial“order“is“stated“b˜y“theŽ¡‘Çathree–ê¨built-in“theorems“shoš¬rwn“bSŽelo˜w.ŽŸ&Ç‚ŸPáŸäõQ‘$FµÓSUBSET_REFL‘¾R|-–¿ª!s.“s“SUBSET“sŽ¤ ‘$FµSUBSET_TRANS‘þ¨|-–¿ª!s“t“u.“s“SUBSET“t“/\“t“SUBSET“u“==>“s“SUBSET“uŽ¡‘$FµSUBSET_ANTISYM‘ T|-–¿ª!s“t.“s“SUBSET“t“/\“t“SUBSET“s“==>“(s“=“t)ŽŽŽŽŽŽŽŸ)6‘ÇaÖAlso–©npro¬rvided“are“built-in“theorems“abšSŽout“the“relationship“b˜et•¬rw“een–©nset“inclusion“andŽ¡‘Çaother–£constanš¬rts“or“opSŽerations“on“sets.‘'ÐF‘ÿVor“example,‘¸áthere“are“the“follo˜wing“facts“abSŽoutŽ¡‘Çaset–ê¨inclusion“and“the“emptš¬ry“and“univ˜ersal“sets:ŽŸ/œÖŸÐáŸ×õQ‘$FµÓEMPTY_SUBSET‘(=¦|-–¿ª!s.“{}“SUBSET“sŽ¤ ‘$FµSUBSET_UNIV‘-ýP|-–¿ª!s.“s“SUBSET“UNIVŽ¡‘$FµNOT_PSUBSET_EMPTY‘ T|-–¿ª!s.“~s“PSUBSET“{}Ž¡‘$FµNOT_UNIV_PSUBSET‘>þ|-–¿ª!s.“~UNIV“PSUBSET“sŽŽŽŽŽŽŽŸ/™6‘ÇaÖAs–fthese“examples“illustrate,‘Äèthe“names“of“theorems“in“the“ÓsetsŽ‘!ÊÆÖlibrary“are“generallyŽ¡‘Çaconstructed–³from“the“names“of“the“constanš¬rts“they“con˜tain.‘½F‘ÿVurthermore,‘!µthe“ordering“ofŽ¡‘Çaelemenš¬rts–ê¨in“the“name“of“a“theorem“attempts“to“re ect“the“con˜ten˜t“of“the“theorem“itself.ŽŸ(+µ‘Çaç1.6Ž‘@ åUnion,–Ÿ¼in‘ÿr°tersection,“and“set“di erenceŽ¦‘ÇaÖThe–{ºbinary“opSŽerations“of“union,‘Ÿþin¬rtersection“and“set“di erence“are“all“de ned“using“theŽ¡‘Çaset–ê¨abstraction“notation“in¬rtrošSŽduced“ab˜o•¬rv“e–ê¨in“section“1.3.1.‘8àThe“formal“de nitions“are:ŽŸ&Ç‚ŸPáŸäõQ‘$FµÓUNION_DEF‘þ¨|-–¿ª!s“t.“s“UNION“t“=“{x“|“x“IN“s“\/“x“IN“t}Ž¤ ‘$FµINTER_DEF‘þ¨|-–¿ª!s“t.“s“INTER“t“=“{x“|“x“IN“s“/\“x“IN“t}Ž¡‘$FµDIFF_DEF‘¾R|-–¿ª!s“t.“s“DIFF“t“=“{x“|“x“IN“s“/\“~x“IN“t}ŽŽŽŽŽŽŽŸ)6‘ÇaÖThese–Cbde nitions“illustrate“the“practical“utilitš¬ry“of“the“sc˜heme“for“v‘ÿXäariable“binding“in“setŽ¡‘Çaabstractions–1ˆdiscussed“abSŽo•¬rv“e–1ˆin“section“1.3.1.‘ An“abstraction“Ó"{ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"“Öbinds“only“theŽ¡‘Çav‘ÿXäariables–g that“ošSŽccur“in“b˜oth“ÎE‘Öand“ÎP‘…VÖ,‘†$and“the“v‘ÿXäariables“ÓsŽ›ÀÖand“ÓtŽ˜Öin“the“set“abstractionsŽ¡‘Çasho•¬rwn›ê¨abSŽo“v“e˜ma“y˜therefore˜bSŽe˜made˜parameters˜to˜the˜sets˜constructed˜b“y˜them.ŽŽŽŒ‹y ÌU ýFÓŸú™š‘êñëÛ8’’¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖUsing‘&ÆÓSET_EQ_CONVŽ‘BcÖ,‘Móit–&Æis“trivial“to“derivš¬re“the“follo˜wing“mem˜bSŽership“conditions“for“ÓUNIONŽ‘åÖ,Ž¤‘êñëÓINTERŽ‘ àäÖand‘0§ÓDIFFŽ‘!_öÖfrom–0§the“de nitions“givš¬ren“abSŽo˜v˜e.‘ ÜAs“a“general“rule,‘‚&theorems“statingŽ¡‘êñëmemš¬rbSŽership–5>conditions“of“the“kind“illustrated“b˜y“these“examples“are“giv˜en“names“of“theŽ¡‘êñëform–Ð!ÓIN_ó$!",š ó3 cmsy10Ïhó%ý': ó3 cmti10Ðc‘ÿp¹onstantŽ‘(ÆXÏi“Öending“in“the“name“of“the“opSŽeration“used“to“construct“the“set“inŽ¡‘êñëquestion.ŽŸ.¢£ŸPáŸäõQ‘0éÓIN_UNION‘ T|-–¿ª!s“t“x.“x“IN“(s“UNION“t)“=“x“IN“s“\/“x“IN“tŽ¤ ‘0éIN_INTER‘ T|-–¿ª!s“t“x.“x“IN“(s“INTER“t)“=“x“IN“s“/\“x“IN“tŽ¡‘0éIN_DIFF‘>þ|-–¿ª!s“t“x.“x“IN“(s“DIFF“t)“=“x“IN“s“/\“~x“IN“tŽŽŽŽŽŽŽŸ-îI‘êñëÖThese–Ëøtheorems,‘Òwhicš¬rh“are“sa˜v˜ed“in“the“library“under“the“names“indicated“abSŽo˜v˜e,‘Òma˜y“inŽ¡‘êñëpractice–ÒbšSŽe“used“as“the“de ning“prop˜erties“of“union,‘×ain¬rtersection“and“set“di erence;‘Ú˜usersŽ¡‘êñëshould–ï$almost“nevš¬rer“ha˜v˜e“to“appšSŽeal“directly“to“the“de nitions“of“these“op˜erations.‘FSOtherŽ¡‘êñëbuilt-in–ê¨theorems“abšSŽout“ÓUNIONŽ‘ ¨úÖ,“ÓINTERŽ‘$“¢Öand“ÓDIFFŽ‘ÓøÖma¬ry“b˜e“found“in“c¬rhapter“3.Ž©,mƒ‘êñëç1.7Ž‘5oDisjoin‘ÿr°t‘Ÿ¼setsŽŸPÙ‘êñëÖTwš¬ro–òcsets“are“Ùdisjoint‘§Öif“they“ha˜v˜e“no“elemen˜ts“in“common.‘PThis“concept“is“formalized“inŽ¡‘êñëthe‘ê¨ÓsetsŽ‘ÓøÖlibrary–ê¨bš¬ry“the“constan˜t“ÓDISJOINTŽ‘1çøÖ,“the“de nition“of“whic˜h“is:ŽŸ"¢ÒŸPáŸþõQ‘0éÓDISJOINT_DEF‘ T|-–¿ª!s“t.“DISJOINT“s“t“=“(s“INTER“t“=“{})ŽŽŽŽŽŽŽŸ!îx‘êñëÖA•¬rt›ÛÖpresen“t,‘there˜are˜relativ“ely˜few˜pre-pro“v“ed˜theorems˜abSŽout˜the˜ÓDISJOINTŽ‘3´üÖrelation˜in˜theŽ¡‘êñëlibrary‘ÿV.‘6ñBut–äÜsee“cš¬rhapter“3“for“the“few“theorems“abSŽout“ÓDISJOINTŽ‘5ÇÖthat“are“in“fact“a˜v‘ÿXäailableŽ¡‘êñëin–ê¨the“ÓsetsŽ‘ÓøÖlibrary‘ÿV.Ž¦‘êñëç1.8Ž‘5oInsertion–Ÿ¼and“deletion“of“an“elemen‘ÿr°tŽŸPÙ‘êñëÖT‘ÿVo–ˆ?aid“in“the“construction“of“particular“sets“of“v‘ÿXäalues“(espSŽecially“ nite“sets)“the“libraryŽ¡‘êñëconš¬rtains– øde nitions“of“t˜w˜o“constan˜ts“ÓINSERTŽ‘*‘ìÖand“ÓDELETEŽ‘&‡ôÖ.‘–ÐThese“denote“the“opSŽerations“ofŽ¡‘êñëaugmenš¬rting–4Na“set“with“a“giv˜en“v‘ÿXäalue“and“remo˜ving“a“v‘ÿXäalue“from“a“set,‘F¸respSŽectiv˜ely‘ÿV.‘ÒTheŽ¡‘êñëformal–ê¨de nitions“of“these“opSŽerations“are:ŽŸ("£ŸÐáŸñõQ‘0éÓINSERT_DEF‘ T|-–¿ª!x“s.“x“INSERT“s“=“{y“|“(y“=“x)“\/“y“IN“s}ŽŸ ‘0éDELETE_DEF‘ T|-–¿ª!s“x.“s“DELETE“x“=“s“DIFF“(INSERT“x“EMPTY)ŽŽŽŽŽŽŽŸ'nI‘êñëÖThe–öuelemenš¬rts“of“the“set“denoted“b˜y“Óx–¿ªINSERT“s–öuÖare“all“the“elemen˜ts“of“the“set“ÓsŽ‘ ¬”ÖtogetherŽ¡‘êñëwith–œÑthe“v‘ÿXäalue“ÓxŽ‘ \{Ö,‘É\whicš¬rh“ma˜y“or“ma˜y“not“bSŽe“an“elemen˜t“of“ÓsŽ‘ùLÖitself.‘O\The“set“denoted“b˜yŽ¡‘êñëÓs–¿ªDELETE“x–ê¨Öconš¬rtains“all“the“elemen˜ts“of“ÓsŽ‘ ”úÖexcept“the“v‘ÿXäalue“ÓxŽ‘ ªRÖ.ŽŽŽŒ‹ …0 ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Insertion–€and“deletion“of“an“elemen t’Ê‹J9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘(ðÖThe–íGmem¬rbSŽership“conditions“for“sets“constructed“using“ÓINSERTŽ›*XŠÖand“ÓDELETEŽ˜Öare“givš¬ren“b˜yŽ¤‘Çathe–ê¨folloš¬rwing“pre-pro˜v˜ed“theorems:ŽŸ*TŸƒŸð‘‘*_ÓIN_INSERT‘ T|-–¿ª!x“y“s.“x“IN“(y“INSERT“s)“=“(x“=“y)“\/“x“IN“sŽŸ ‘*_IN_DELETE‘ T|-–¿ª!s“x“y.“x“IN“(s“DELETE“y)“=“x“IN“s“/\“~(x“=“y)ŽŽŽŽŽŽŽŸ)o¾‘ÇaÖIn–Î!addition,‘ the“library“conš¬rtains“a“substan˜tial“collection“of“theorems“abSŽout“the“relationshipŽ¡‘ÇabšSŽet•¬rw“een–ýRthe“op˜erations“ÓINSERTŽ›,x Öand“ÓDELETEŽ˜Öand“other“relations“and“opSŽerations“on“sets.Ž¡‘ÇaChapter–ê¨3“giv¬res“a“complete“list“of“these“theorems.ŽŸ(JB‘Çaâ1.8.1Ž‘E`âPšŠ=arser–…and“prett˜y-prin˜ter“suppuÂortŽŸ‘ÇaÖThe‘kÓsetsŽ‘ÔÖÖlibrary–kproš¬rvides“spSŽecial“parser“and“prett˜y-prin˜ter“suppSŽort“for“ nite“sets“that“areŽ¡‘Çaconstructed–w…bš¬ry“en˜umeration“of“their“elemen˜ts.‘This“notation“is“in˜troSŽduced“b˜y“a“call“madeŽ¡‘Çawhen––Þthe“library“is“loaded“to“the“built-in“ÍML“Öfunction“Ódefine_finite_set_syntaxŽ’‘%¬Ö(see“[1Ž‘ßü]Ž¡‘Çafor–ª¾details“of“this“function).‘y"This“has“the“e ect“of“extending“the“ÍHOL“Öparser“so“that“aŽ¡‘Çaquotation–Ú¶of“the“form“Ó"{ÎtŸ¤z¸1Ž–ÀÓ,ÎtŸ¤z¸2Ž“Ó,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"–Ú¶Öparses“to“the“folloš¬rwing“set“built“up“from“ÓEMPTYŽ‘$s¾Öb˜yŽ¡‘ÇarepSŽeatedly–ê¨using“the“function“ÓINSERTŽ‘&h¤Ö:ŽŸ$"Ÿ±ïŸþ34‘*_ÓINSERT‘¿ª×tŸÌ̸1ŽŽ–}ŽÓ(INSERT‘¿ª×tŸÌ̸2ŽŽ“Î:–Ó1:“:ŽŽ‘(ÖÌÓ(INSERT‘¿ª×tŸÌ̹nŽŽ‘eÚÓEMPTY)Î:–Ó1:“:ŽŽ‘™”Ó)ŽŽŽŽŽŽŽŸ#=Í‘ÇaÖNote–†Ythat“the“quotation“Ó"{}"“Öjust“parses“to“the“constan¬rt“ÓEMPTYŽ‘ D«Ö.‘pWhen“the“Óprint_setŽ‘:É¬Ö agŽ¡‘Çais‘ê¨ÓtrueŽ‘éPÖ,–ê¨the“ÍHOL“Öprett•¬ry-prin“ter–ê¨for“terms“in•¬rv“erts–ê¨this“transformation.ŽŸäB‘(ðUsers–ñ should“note“that“care“mš¬rust“bSŽe“tak˜en“with“regard“to“the“precedence“of“comma“inŽ¡‘Çaa–ê¨conš¬rtext“Ó"{Î:–Ó1:“:ŽŽ‘™”Ó}"Ö,“as“the“follo˜wing“session“illustrates:ŽŸc˜ò‘ÇaŸ´D׉ffÇ I ¶ÌÍŸYœ„‘vRff ÿx༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#set_flag(`print_set`,false);;Ž¤ ‘ÌÍtrue–¿ª:“boolŽ©‘ÌÍ#"{1,2,3,4}";;Ž¡‘ÌÍ"1–¿ªINSERT“(2“INSERT“(3“INSERT“(4“INSERT“EMPTY)))"“:“termŽ¦‘ÌÍ#"{(1,2),(3,4)}";;Ž¡‘ÌÍ"(1,2)–¿ªINSERT“((3,4)“INSERT“EMPTY)"“:“termŽ¦‘ÌÍ#"{((1,2),(3,4))}";;Ž¡‘ÌÍ"((1,2),3,4)–¿ªINSERT“EMPTY"“:“termŽŽ’Æq°„‘vRffŽŽŸÀ‰ffÇ IŽŽŽŸb´°‘ÇaÖDi erenš¬rt–®grouping“b˜y“means“of“enclosing“paren˜theses“has“giv˜en“sets“with“four“elemen˜tsŽ¡‘Ça(eacš¬rh–|ôa“n˜um˜bSŽer),‘’åt˜w˜o“elemen˜ts“(eac˜h“of“whic˜h“is“a“pair),‘’åand“one“elemen˜t“(a“pair“of“pairs)Ž¡‘ÇarespSŽectiv¬rely‘ÿV.ŽŽŽŒ‹ Û ÌU ýFÓŸú™š‘êñëÛ10’ Ò¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâ1.8.2Ž‘‹lCon•Š=v“ersions–…for“enŠ=umerated“ nite“setsŽ©À‘êñëÖThe‘ÊKÓsetsŽ‘“>Ölibrary–ÊKproš¬rvides“a“collection“of“optimized“con˜v˜ersions“for“computing“the“resultsŽ¤‘êñëof–‹opšSŽerations“and“predicates“on“ nite“sets“sp˜eci ed“bš¬ry“en˜umeration“of“their“elemen˜ts.‘,AllŽ¡‘êñëthese›èõcon•¬rv“ersions,‘éLthe˜curren“t˜implemen“tations˜of˜whic“h˜are˜somewhat˜expSŽerimen“tal,‘éLareŽ¡‘êñëdesigned–YÄto“wš¬rork“only“for“ nite“sets“of“the“form“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"Ö.‘†3The“sections“that“follo˜wŽ¡‘êñëdescribSŽe–Rmost“of“these“con•¬rv“ersions;‘á§the–Rremainder“are“discussed“in“later“sections“of“thisŽ¡‘êñëman¬rual.ŽŸüæ‘êñëÛ1.8.2.1Ž‘±ëMem b`ershipŽ¦‘êñëÖThe–Àmost“basic“con•¬rv“ersion–Àfor“ nite“sets“is“a“decision“prošSŽcedure“for“mem¬rb˜ership“calledŽ¡‘êñëÓIN_CONVŽ‘/‘Ö.‘ð5In–¨general,‘“convŽŽŽŽŽŽŽ¡‘êñëÖmš¬rust–Á&therefore“bSŽe“supplied“with“a“con˜v˜ersion“that“implemen˜ts“a“decision“proSŽcedure“forŽ¤‘êñëequalitš¬ry–âŠof“set“elemen˜ts.‘6+It“is“assumed“that“this“con˜v˜ersion“will“map“equations“Ó"ÎeŸ¤z¸1Ž‘ ®Ó=‘¿ªÎeŸ¤z¸2Ž‘ÀÓ"Ž¡‘êñëÖbSŽet•¬rw“een›jÎelemen“ts˜of˜a˜base˜t“ypSŽe˜ÓtyŽ‘TðÖto˜the˜theorem˜Ó|-–¿ª(ÎeŸ¤z¸1Ž‘ ®Ó=“ÎeŸ¤z¸2Ž‘ÀÓ)“=“T‘j­Öor˜to˜the˜theoremŽ¡‘êñëÓ|-–¿ª(ÎeŸ¤z¸1Ž‘ ®Ó=“ÎeŸ¤z¸2Ž‘ÀÓ)“=“FÖ,–ê¨as“appropriate.Ž¡‘öSzIf‘.SÓconvŽ‘[NÖis–.San“equalitš¬ry“con˜v˜ersion“of“the“kind“describšSŽed“ab˜o•¬rv“e,‘Sþthen–.Sthe“function“returnedŽ¡‘êñëbš¬ry‘©ëÓIN_CONV‘¿ªconvŽ‘NOÎÖis–©ëa“con˜v˜ersion“that“decides“mem˜bSŽership“in“ nite“sets“of“v‘ÿXäalues“of“theŽ¡‘êñëbase–ê¨t¬rypSŽe“ÓtyŽ‘iüÖ.‘8àIn“particular,“a“call:Ž¤Æ럱ïŸþ34‘0éÓIN‘°—‰ffsŽ‘#™CONV–¿ªconv“"×tŽ‘ ýàÓIN“{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}"ŽŽŽŽŽŽŽ¡‘êñëÖreturns–ê¨the“theoremŽ¡Ÿ±ïŸþ34‘0éÓ|-‘¿ª×tŽ‘½ŠÓIN–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“=“TŽŽŽŽŽŽŽ¡‘êñëÖif–¶1the“term“×t“Öis“alpha-equiv‘ÿXäalenš¬rt“to“some“term“×tŸÌ̹iŽ‘ Öor“if“the“supplied“con˜v˜ersion“ÓconvŽ‘k Öpro˜v˜esŽ¤‘êñëÜ|-–,Í(×t“Ü=“×tŸÌ̹iŽ‘dÚÜ)“=“T‘*2Öfor–*„some“×i“Öwhere“1–uÂØ“×i“Ø“×nÖ.‘øtIf,‘z{on–*„the“other“hand“ÓconvŽ‘!S°Öpro•¬rv“es‘*„theŽ¡‘êñëtheorem›ê¨Ü|-–,Í(×t“Ü=“×tŸÌ̹iŽ‘dÚÜ)“=“F˜Öfor˜all˜×i˜Öwhere˜1–URØ“×i“Ø“×nÖ,˜then˜the˜result˜is˜the˜theoremŽ¤Æ럱ïŸþ34‘0éÓ|-‘¿ª×tŽ‘½ŠÓIN–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“=“FŽŽŽŽŽŽŽ¡‘êñëÖIn–ê¨all“other“cases,“the“call“to“ÓIN_CONVŽ‘0öÖshoš¬rwn“abSŽo˜v˜e“will“fail.Ž©‘öSzThe–ê¨folloš¬rwing“session“sho˜ws“ho˜w“ÓIN_CONVŽ‘0öÖcan“bSŽe“used“in“practice.Ž¤/=ΑêñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#IN_CONV–¿ªnum_EQ_CONV“"1“IN“{2,1,3}";;Ž¤ ‘ÌÍ|-–¿ª1“IN“{2,1,3}“=“TŽŸ‘ÌÍ#IN_CONV–¿ªnum_EQ_CONV“"4“IN“{2,1,3}";;Ž¡‘ÌÍ|-–¿ª4“IN“{2,1,3}“=“FŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖThe–øbuilt-in“con•¬rv“ersion‘øÓnum_EQ_CONVŽ‘E,|Öis–øused“here“to“decide“equalitš¬ry“of“the“natural“n˜um˜bSŽersŽ¦‘êñëin•¬rv“olv“ed–ê¨in“the“mem¬rbšSŽership“assertions“b˜eing“pro•¬rv“ed.ŽŽŽŒ‹ ›Î ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Insertion–€and“deletion“of“an“elemen t’ÃËJ11Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘(ðÖAn–ê¨example“in“whicš¬rh“ÓIN_CONVŽ‘0öÖfails“is“the“follo˜wing:ŽŸ6Þ’‘ÇaŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#IN_CONV–¿ªnum_EQ_CONV“"x“IN“{1,2,3}";;Ž¤ ‘ÌÍevaluation‘¿ªfailed‘¾RIN_CONVŽŸ‘ÌÍ#num_EQ_CONV–¿ª"x“=“1";;Ž¡‘ÌÍevaluation‘¿ªfailed‘¾Rnum_EQ_CONVŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽŸ6±œ‘ÇaÖF‘ÿVailure–É1ošSŽccurs“in“this“case“b˜ecause“the“term“ÓxŽ‘R Öis“a“v‘ÿXäariable,‘Ôand“Ónum_EQ_CONVŽ‘HΰÖthereforeŽ¤‘Çacannot–DÄdetermine“if“it“is“equal“to“anš¬ry“of“the“set“elemen˜ts“Ó1Ž› nÖ,‘[KÓ2Ž‘_¹Öor“Ó3Ž˜Ö.‘G5Note,›[Kho•¬rw“ev“er,˜thatŽ¡‘Çathe– supplied“con•¬rv“ersion– is“not“required“to“pro•¬rv“e› an“ything˜if˜the˜v‘ÿXäalue˜bSŽeing˜tested˜forŽ¡‘Çamem¬rb•SŽership›ê¨happ“ens˜to˜b“e˜syn•¬rtactically˜iden“tical˜to˜an˜elemen“t˜of˜the˜giv“en˜set:ŽŸ#^’‘ÇaŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#IN_CONV–¿ªNO_CONV“"x“IN“{1,x,3}";;ŽŸ ‘ÌÍ|-–¿ªx“IN“{1,x,3}“=“TŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽŸ#1œ‘ÇaÖIn–7Òthis“case,›[—the“supplied“con•¬rv“ersion,˜namely‘7ÒÓNO_CONVŽ‘+uxÖ,˜alw“a“ys–7Òfails;‘sobut“the“call“to“ÓIN_CONVŽŽ¡‘ÇaÖnonetheless–ê¨succeeds“and“returns“the“appropriate“result.ŽŸ!ßí‘ÇaÛ1.8.2.2Ž‘F‡aUnionŽŸk‘ÇaÖThe‘ê¨ÓsetsŽ‘ÓøÖlibrary–ê¨conš¬rtains“a“con˜v˜ersionŽ©g¯ŸÜŸþõQ‘*_ÓUNION_CONV–¿ª:“conv“->“convŽŽŽŽŽŽŽŸ:¹‘ÇaÖthat–éÚcan“bSŽe“used“to“compute“the“union“of“t•¬rw“o–éÚ nite“sets.‘ãFThe“ rst“argumen¬rt“to“ÓUNION_CONVŽŽ¡‘ÇaÖ(i.e.–vthe“con•¬rv“ersion›vargumen“t)˜is˜exp•SŽected˜to˜b“e˜an˜equalit•¬ry˜con“v“ersion˜of˜the˜same˜kindŽ¡‘Çarequired– ×as“an“argumenš¬rt“b˜y“ÓIN_CONVŽ‘2TÖ(see“section“1.8.2.1).‘ÛlAs“will“bšSŽe“seen“b˜elo¬rw,‘nbthisŽ¡‘Çacon•¬rv“ersion–nis“used“b¬ry“ÓUNION_CONVŽ‘C·€Öto“simplify“the“set“that“it“computes“as“the“result“ofŽ¡‘Çataking–ê¨the“union“of“t•¬rw“o–ê¨ nite“sets.ŽŸ,ö‘(ðGivš¬ren–V`an“equalit˜y“con˜v˜ersion“ÓconvŽ‘UÖ,‘qNthe“function“ÓUNION_CONVŽ‘B)dÖreturns“a“con˜v˜ersion“thatŽ¡‘Çacomputes–y½the“union“of“a“ nite“set“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öand“another“set“ÎsÖ.‘æThe“second“set“Îs“ÖinŽ¡‘Çafact–68need“not“bSŽe“ nite.‘‘Ignoring,›Ifor“the“momen¬rt,˜the“pSŽossible“simpli cation“done“usingŽ¡‘Çathe–ê¨supplied“con•¬rv“ersion‘ê¨ÓconvŽ‘éPÖ,–ê¨a“call:Ž¦Ÿ±ïŸþ34‘*_ÓUNION‘°—‰ffsŽ‘#™CONV–¿ªconv“"{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“×sŽ‘ H‹Ó"ŽŽŽŽŽŽŽ¤:¹‘ÇaÖjust–ê¨returns“the“theoremŽ¦Ÿ±ïŸþ34‘*_Ó|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“×sŽ‘5Ó=“×tŸÌ̸1ŽŽ‘}ŽÓINSERT“(×:–ÿþ:“:ŽŽ‘ŠJÓ(×tŸÌ̹nŽŽ‘¦0ÓINSERT“×sŽ‘ H‹Ó)×:–ÿþ:“:ŽŽ‘ Ê Ó)ŽŽŽŽŽŽŽ¡‘ÇaÖThat–Ÿxis,‘̬ÓUNION_CONVŽ‘BèÈÖcomputes“the“required“union“as“a“repSŽeated“insertion“of“v‘ÿXäalues“in¬rtoŽŸ‘Çathe–²_set“ÎsÖ.‘When“Îs“Öis“a“ nite“set“of“the“form“Ó"{ÎuŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎuŸ¤z¹mŽ‘ÄÓ}"Ö,‘äMthe“resulting“theorem“willŽŽŽŒ‹ ©† ÌU ýFÓŸú™š‘êñëÛ12’ Ò¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖha•¬rv“e–ê¨the“form“shoš¬rwn“bSŽelo˜w.Ž¤LüŸ±ïŸþ34‘0éÓ|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ›™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“{×uŸÌ̸1ŽŽ‘ oÿÓ,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹mŽŽ›´¿Ó}“=“{×tŸÌ̸1ŽŽ‘þ:Ó,×:–ÿþ:“:ŽŽ– Ê Ó,×tŸÌ̹nŽŽ‘ æ†Ó,×uŸÌ̸1ŽŽ‘ oÿÓ,×:–ÿþ:“:ŽŽ“Ó,×uŸÌ̹mŽŽ˜Ó}ŽŽŽŽŽŽŽ¡‘êñëÖWhen–…computing“theorems“of“this“form“(i.e.“when“the“second“set“of“the“union“is“a“ nite“setŽ¤‘êñëÓ"{ÎuŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎuŸ¤z¹mŽ‘ÄÓ}"Ö)–ƒÎthe“function“ÓUNION_CONVŽ‘B„@Öattempts“to“remo•¬rv“e›ƒÎredundan“t˜elemen“ts˜in˜theŽ¡‘êñëresulting–øšset“using“the“supplied“equalitš¬ry“con˜v˜ersion“ÓconvŽ‘÷BÖ.‘b¶In“particular,‘üif“ÓconvŽ‘ïÜÖis“able“toŽ¡‘êñëpro•¬rv“e–úýthat“some“elemenš¬rt“ÎtŸ¤z¹iŽ‘_×Öof“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öis“equal“to“an˜y“elemen˜t“ÎuŸ¤z¹jŽ‘aÖof“Ó"{ÎuŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎuŸ¤z¹mŽ‘ÄÓ}"Ö,Ž¡‘êñëthat–ªis“if“the“con•¬rv“ersion‘ªÓconvŽ‘9üÖmaps–ªthe“term“Ó"ÎtŸ¤z¹iŽ‘ $„Ó=›¿ªÎuŸ¤z¹jŽ‘f Ó"“Öto“the“theorem“Ó|-˜(ÎtŸ¤z¹iŽ‘ $„Ó=˜ÎuŸ¤z¹jŽ‘f Ó)˜=˜TÖ,Ž¡‘êñëthen–ê¨the“resulting“theorem“will“bSŽeŽ¤LüŸy Ÿü¤û‘0éÓ|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”×tŸÌ̹iŽŽ‘<¤Ó,Î:–Ó1:“:ŽŽ›™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“{×uŸÌ̸1ŽŽ‘ oÿÓ,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹jŽŽ‘ Ó,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹mŽŽ‘´¿Ó}“=“{×tŸÌ̸1ŽŽ‘þ:Ó,×:–ÿþ:“:ŽŽ‘ Ê Ó,×tŸÌ̹nŽŽ‘ æ†Ó,×uŸÌ̸1ŽŽ‘ oÿÓ,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹jŽŽ‘ Ó,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹mŽŽ‘´¿Ó}ŽŽŽŽŽŽŽ¡‘êñëÖThat–mis,‘³the“redundanš¬rt“term“×tŸÌ̹iŽŽ‘}>Öwill“bSŽe“remo˜v˜ed“from“the“initial“sequence“of“elemen˜ts“inŽ¤‘êñëthe–éVresulting“ nite“set.‘4ëThe“function“ÓUNION_CONVŽ‘COPÖalso“c•¬rhec“ks–éVfor“and“eliminates“alpha-Ž¡‘êñëequiv‘ÿXäalen•¬rt‘ê¨elemen“ts.Ž¡‘öSzSome–ê¨examples“of“ÓUNION_CONVŽ‘AQôÖin“use“are“shoš¬rwn“in“the“follo˜wing“ÍHOL“Ösession:Ž¤3Ãß‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ4ŽŽŽŽŸÿ@T‘ÌÍÓ#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“{4,5,6}";;Ž¤ ‘ÌÍ|-–¿ª{1,2,3}“UNION“{4,5,6}“=“{1,2,3,4,5,6}ŽŸ‘ÌÍ#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“{3,2,SUC“0}";;Ž¡‘ÌÍ|-–¿ª{1,2,3}“UNION“{3,2,SUC“0}“=“{1,3,2,SUC“0}ŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖThe–supplied“equalitš¬ry“con˜v˜ersion“in“these“examples“is“ÓNO_CONVŽ‘,\¹Ö,‘,.and“only“the“elemen˜ts“ofŽ¤‘êñëthe–J rst“set“Ó{1,2,3}“Öthat“are“redundanš¬rt“b˜y“virtue“of“bSŽeing“alpha-equiv‘ÿXäalen˜t“to“elemen˜tsŽ¡‘êñëof–™&the“second“set“are“eliminated“from“the“resulting“set.‘µAn“example“in“whicš¬rh“the“equalit˜yŽ¡‘êñëcon•¬rv“ersion–ê¨is“actually“used“is:Ž¤ Cß‘êñëŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ5ŽŽŽŽŸÿ@T‘ÌÍÓ#UNION_CONV–¿ªnum_EQ_CONV“"{1,2,3}“UNION“{3,2,SUC“0}";;ŽŸ ‘ÌÍ|-–¿ª{1,2,3}“UNION“{3,2,SUC“0}“=“{3,2,SUC“0}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖIn–2>this“case,‘D$Ónum_EQ_CONVŽ‘G²°Öis“used“to“pro•¬rv“e–2>that“Ó1“Öis“equal“to“ÓSUC‘¿ª0Ö,‘D$so“that“the“resultingŽ©‘êñëunion–ê¨is“the“set“Ó"{3,2,SUC›¿ª0}"Ö,“rather“than“Ó"{1,3,2,SUC˜0}Í"Ö.ŽŸ ’{‘êñëÛ1.8.2.3Ž‘±ëInsertionŽŸÀ‘êñëÖThe›ê¨con•¬rv“ersion˜ÓINSERT_CONVŽ‘GžÖpSŽerforms˜the˜follo“wing˜reduction˜on˜ nite˜sets:Ž¤LüŸDŸþ34‘‘reduce‘ UÓ"×tŽ‘ ýàÓINSERT‘¿ª{×tŸÌ̸1ŽŽ›þ:Ó,Î:–Ó1:“:ŽŽ–™”Ó,×tŸÌ̹iŽŽ‘£Ó,Î:–Ó1:“:ŽŽ“Ó,×tŸÌ̹nŽŽ‘ æ†Ó}"‘iýÖtoŽ‘%[Ó"{×tŸÌ̸1ŽŽ˜Ó,Î:–Ó1:“:ŽŽ“Ó,×tŸÌ̹iŽŽ‘£Ó,Î:–Ó1:“:ŽŽ“Ó,×tŸÌ̹nŽŽ‘ æ†Ó}"ŽŽŽŽŽŽŽ¡‘êñëÖif–o´a“supplied“equalitš¬ry“con˜v˜ersion“can“pro˜v˜e“Ó|-–¿ª(Ît“Ó=“ÎtŸ¤z¹iŽ‘dÚÓ)“=“TÖ.–o´Since“the“en˜umerated“setŽ¦‘êñënotation–pîÓ"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öis“just“a“parser-suppSŽorted“abbreviation“(see“section“1.8.1),‘ÒthisŽ¦‘êñëis– equiv‘ÿXäalen¬rt“to“reducing“the“set“Ó"{ÎtÓ,ÎtŸ¤z¸1Ž›ÀÓ,Î:–Ó1:“:ŽŽ–™”Ó,ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ“Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"– Öto“Ó"{ÎtŸ¤z¸1Ž˜Ó,Î:–Ó1:“:ŽŽ–™”Ó,ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ“Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"– Öwhen“theŽ¦‘êñëterms–ê¨Ît“Öand“ÎtŸ¤z¹iŽ‘O‚Öare“pro¬rv‘ÿXäably“equal.ŽŽŽŒ‹ ¶ ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Insertion–€and“deletion“of“an“elemen t’ÃËJ13Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘(ðÖMore–/?spSŽeci cally‘ÿV,›@eif“for“some“ÎtŸ¤z¹iŽ‘”Öin“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ö,˜the“terms“Ît“Öand“ÎtŸ¤z¹iŽ‘”Öare“alpha-equiv‘ÿXäalen¬rt,Ž©‘Çaof–ê¨if“the“con•¬rv“ersion‘ê¨ÓconvŽ‘ÓøÖmaps›ê¨Ó"Ît–¿ªÓ=“ÎtŸ¤z¹iŽ‘dÚÓ"˜Öto˜the˜theorem˜Ó|-“(Ît“Ó=“ÎtŸ¤z¹iŽ‘dÚÓ)“=“TÖ,˜then˜the˜call:Ž¤ÑÏŸ±ïŸþ34‘*_ÓINSERT‘°—‰ffsŽ‘#™CONV–¿ªconv“"×tŽ‘ ýàÓINSERT“{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}";;ŽŽŽŽŽŽŽ¡‘ÇaÖwill–ê¨return“the“theorem:Ž¡Ÿ±ïŸþ34‘*_Ó|-‘¿ª×tŽ‘½ŠÓINSERT–¿ª{×tŸÌ̸1ŽŽ›þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“=“{×tŸÌ̸1ŽŽ˜Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}ŽŽŽŽŽŽŽ¡‘(ðÖHere–ê¨is“an“example“of“ÓINSERT_CONVŽ‘GžÖin“use:Ž¤Ȳ‘ÇaŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#INSERT_CONV–¿ªnum_EQ_CONV“"(SUC“2)“INSERT“{0,1,2,3}";;ŽŸ ‘ÌÍ|-–¿ª{SUC“2,0,1,2,3}“=“{0,1,2,3}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘(ðÖWhen–Ò™applied“repšSŽeatedly‘ÿV,‘×iÓINSERT_CONVŽ‘FæPÖcan“b˜e“used“to“reduce“ nite“sets“b¬ry“eliminatingŽ¦‘Çaas–iÞmanš¬ry“redundan˜t“oSŽccurrences“of“elemen˜ts“as“pSŽossible.‘¶An“easy“to“program,‘‰«but“slo˜w-Ž¦‘Çarunning,›ê¨w•¬ra“y˜of˜doing˜this˜is˜to˜use˜ÓDEPTH_CONVŽ‘=gLÖ:Ž¡‘ÇaŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#DEPTH_CONV–¿ª(INSERT_CONV“num_EQ_CONV)“"{1,3,x,SUC“1,SUC(SUC“1),2,1,3,x}";;ŽŸ ‘ÌÍ|-–¿ª{1,3,x,SUC“1,SUC(SUC“1),2,1,3,x}“=“{2,1,3,x}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖF‘ÿVor–`a“faster“alternativš¬re“to“this“methoSŽd,‘àsee“the“reference“en˜try“for“ÓINSERT_CONVŽ‘DwÖin“c˜hapter“2.ŽŸ ‚’‘ÇaÛ1.8.2.4Ž‘F‡aDeletionŽŸÀ‘ÇaÖThe›2con•¬rv“ersion˜ÓDELETE_CONVŽ‘E |Öreduces˜terms˜of˜the˜form˜Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}–¿ªDELETE“ÎtÓ"˜Öb¬ry˜deletingŽ¦‘Çaall–æúelemenš¬rts“pro˜v‘ÿXäably“equal“to“Ît“Öfrom“the“set“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ö.‘7¦Lik˜e“ÓIN_CONVŽ‘0 šÖand“ÓINSERT_CONVŽ‘C#HÖ,Ž¦‘Çathe–Ÿfunction“ÓDELETE_CONVŽ‘HzPÖtakš¬res“a“con˜v˜ersion“for“deciding“equalit˜y“of“set“elemen˜ts“as“anŽ¦‘Çaargumen•¬rt.‘8àIf‘ê¨ÓconvŽ‘ÓøÖis›ê¨suc“h˜a˜con“v“ersion,˜the˜call:Ž¤ÑÏŸ±ïŸþ34‘*_ÓDELETE‘°—‰ffsŽ‘#™CONV–¿ªconv“"{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“DELETE“×tŽ‘ ýàÓ";;ŽŽŽŽŽŽŽ¡‘ÇaÖwill–ê¨return“the“theorem:Ž¡Ÿy Ÿü¤û‘*_Ó|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ›™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“DELETE“×tŽ‘½ŠÓ=“{×tŸÌ̹iŽŽ‘£Ó,Î:–Ó1:“:ŽŽ˜Ó,×tŸÌ̹jŽŽ‘¤@Ó}ŽŽŽŽŽŽŽ¡‘ÇaÖwhere–ÑWthe“resulting“set“Ó{ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ›™”Ó,ÎtŸ¤z¹jŽ‘f Ó}“Öis“the“set“of“all“v‘ÿXäalues“ÎtŸÈ®¹kŽ‘ôéÖin“the“original“set“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ˜Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ž¦‘ÇaÖfor– fwhicš¬rh“ÓconvŽ‘!tÖpro˜v˜es“Ü|-–,Í(×tŸÌ̹kŽ‘ P_Ü=“×tÜ)“=“FÖ,– fand“where“for“all“ÎtŸÈ®¹kŽ‘ -øÖin“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}“Öbut“not“inŽ¦‘ÇaÓ{ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹jŽ‘f Ó}Ö,‘XÕeither–BÌÎtŸÈ®¹kŽ‘ f^Öis“alpha-equiv‘ÿXäalenš¬rt“to“Ît“Öor“ÓconvŽ‘„@Öpro˜v˜es“Ü|-–,Í(×tŸÌ̹kŽ‘ P_Ü=“×tÜ)“=“TÖ.–BÌNote“thatŽ¦‘Çathe›Œcon•¬rv“ersion˜ÓconvŽ‘"æÖm“ust˜pro“v“e˜either˜equalit“y˜or˜inequalit“y˜for˜ev“ery˜elemen“t˜of˜theŽ¦‘Çaoriginal–ê¨set“that“is“not“simply“alpha-equiv›ÿXäalen¬rt“to“the“deleted“v˜alue.Ž¦‘(ðThe–ê¨folloš¬rwing“session“sho˜ws“ÓDELETE_CONVŽ‘GžÖin“use:ŽŸȲ‘ÇaŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#DELETE_CONV–¿ªnum_EQ_CONV“"{0,1,2,3}“DELETE“(SUC“1)";;ŽŸ ‘ÌÍ|-–¿ª{0,1,2,3}“DELETE“(SUC“1)“=“{0,1,3}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽŽŽŒ‹Æ{ ÌU ýFÓŸú™š‘êñëÛ14’ Ò¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.9Ž‘5oSingleton‘Ÿ¼setsŽŸ…‘êñëÖA‘qÔÙsingleton‘WèÖset–r8is“a“set“that“conš¬rtains“precisely“one“elemen˜t.‘ Ï‘In“the“ÓsetsŽ‘!ãÖlibrary‘ÿV,‘ÔtheŽ¤‘êñëpropšSŽert¬ry–ê¨of“b˜eing“a“singleton“set“is“expressed“b¬ry“the“de nition:Ž©Ò ŸPáŸþõQ‘0éÓSING_DEF‘>þ|-–¿ª!s.“SING“s“=“(?x.“s“=“{x})ŽŽŽŽŽŽŽŸ·Ê‘êñëÖThe–ÊZlibrary“conš¬rtains“sev˜eral“built-in“theorems“abSŽout“singleton“sets.‘.These“are“sometimesŽ¡‘êñëexpressed–ê¨in“terms“of“the“predicate“ÓSINGŽ‘éPÖ,“as“for“example“in“the“theoremŽ¦Ÿ@UŸÿi‘0éÓSING‘>þ|-–¿ª!x.“SING{x}ŽŽŽŽŽŽŽŸ·Ê‘êñëÖBut–ÈxpropšSŽerties“of“singleton“sets“are“more“usually“form¬rulated“as“theorems“ab˜out“sets“ofŽ¡‘êñëthe–ê¨form“`Ó{x}Ö'.‘8àF‘ÿVor“example,“the“built-in“theorems“abSŽout“singleton“sets“include:ŽŸ*ƒüŸŸã‘‘0éÓNOT_SING_EMPTY‘ T|-–¿ª!x.“~({x}“=“{})Ž¤ ‘0éIN_SING‘3¼ú|-–¿ª!x“y.“x“IN“{y}“=“(x“=“y)Ž¡‘0éEQUAL_SING‘"}ü|-–¿ª!x“y.“({x}“=“{y})“=“(x“=“y)ŽŽŽŽŽŽŽŸ*i»‘êñëÖA‘îŸgeneral›î con•¬rv“en“tion˜is˜that˜theorems˜abSŽout˜singleton˜sets˜are˜giv“en˜names˜that˜con“tainŽ¡‘êñëthe–¬¤elemenš¬rt“`ÓSINGŽ‘þ¨Ö',‘¹ regardless“of“whether“or“not“they“actually“con˜tain“the“predicate“ÓSINGŽ‘«LÖ.ŽŸ(·?‘êñëç1.10Ž‘"% The–Ÿ¼óIßêþ|-–¿ª!s.“~(s“=“{})“==>“(CHOICE“s)“IN“sŽŽŽŽŽŽŽŸ·Ê‘êñëÖThis–m{theorem“alone“is“the“de ning“propSŽertš¬ry“for“the“constan˜t“ÓCHOICEŽ‘%ëwÖ,‘†„whic˜h“is“therefore“anŽ¡‘êñëonly– partially“spSŽeci ed“function“from“sets“to“v‘ÿXäalues.‘‚Note,› 'in“particular,˜that“there“is“noŽ¡‘êñëinformation–Õìgivš¬ren“b˜y“this“de nition“abSŽout“the“result“of“applying“ÓCHOICEŽ‘*)ÔÖto“an“empt˜y“set.ŽŸA‘öSzThe–´library“also“conš¬rtains“a“function“ÓRESTŽ‘²¯Ö,‘&^whic˜h“is“de ned“in“terms“of“the“ÓCHOICEŽŽ¡‘êñëÖfunction–ê¨as“follo¬rwsŽ¦ŸPáŸþõQ‘0éÓREST_DEF‘>þ|-–¿ª!s.“REST“s“=“s“DELETE“(CHOICE“s)ŽŽŽŽŽŽŽŸ·Ê‘êñëÖF‘ÿVor–B…anš¬ry“non-empt˜y“set“ÓsŽ‘ /Ö,‘d&the“set“ÓREST‘¿ªsŽ‘)Öcomprises“all“those“elemen˜ts“of“ÓsŽ‘ D´Öexcept“the“v‘ÿXäalueŽ¡‘êñëselected–ê¨from“ÓsŽ‘ ”úÖb¬ry“ÓCHOICEŽ‘&h¤Ö.ŽŸA‘öSzThe–TGlibrary“con¬rtains“v‘ÿXäarious“built-in“theorems“abSŽout“the“functions“ÓCHOICEŽ‘)&ŠÖand“ÓRESTŽ‘RïÖ;‘†hforŽ¡‘êñëa–ê¨full“list“of“these“theorems,“see“c¬rhapter“3.ŽŽŽŒ‹ÕŒ ÌU ýFÓŸú™š‘ÇaÛ1.11.‘ €Image–€of“a“function“on“a“set’íbe15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç1.11Ž‘IúImage–Ÿ¼of“a“function“on“a“setŽŸó¼‘ÇaÖThe–ºtÙimage‘ $Öof“a“function“Óf:*->**“Öon“a“set“Ós:(*)set“Öis“the“set“of“v‘ÿXäalues“Óf(x)“Öfor“all“ÓxŽ‘ 4’Öin“ÓsŽ‘ zÖ.Ž¤‘ÇaIn–²€the“ÓsetsŽ‘c¨Ölibrary‘ÿV,‘½»the“image“of“a“function“on“a“set“is“de ned“in“terms“of“the“ob¬rvious“setŽ¡‘Çaabstraction:Ž©!4wŸPáŸþõQ‘*_ÓIMAGE_DEF‘>þ|-–¿ª!f“s.“IMAGE“f“s“=“{f“x“|“x“IN“s}ŽŽŽŽŽŽŽŸ ­é‘ÇaÖUsing‘þÓSET_SPEC_CONVŽ‘N¹´Ö,‘ìis–þis“trivial“to“pro•¬rv“e–þfrom“this“de nition“the“folloš¬rwing“mem˜bSŽershipŽ¡‘Çacondition–ê¨for“sets“constructed“using“ÓIMAGEŽ‘ ¨úÖ:Ž¦ŸŸý‘‘*_ÓIN_IMAGE‘>þ|-–¿ª!y“s“f.“y“IN“(IMAGE“f“s)“=“(?x.“(y“=“f“x)“/\“x“IN“s)ŽŽŽŽŽŽŽŸ ­é‘ÇaÖThe‘9>ÓsetsŽ‘q$Ölibrary–9>conš¬rtains“v‘ÿXäarious“theorems“abSŽout“ÓIMAGEŽ‘%0ÎÖin“addition“to“this“mem˜bSŽershipŽ¡‘Çatheorem.‘’These–cinclude,›OÑfor“example,˜theorems“abSŽout“the“image“of“a“function“on“setsŽ¡‘Çaconstructed–´5bš¬ry“the“opSŽerations“of“union“and“in˜tersection.‘&ºF‘ÿVor“a“full“list“of“theorems“abSŽoutŽ¡‘ÇaÓIMAGEŽ‘/…³Ö,–ê¨see“c¬rhapter“3.ŽŸ&r‘Çaâ1.11.1Ž‘M¨ŒTheorem-proŠ=ving‘…suppuÂortŽŸÑ™‘ÇaÖThe‘d¦ÓsetsŽ‘ÇôÖlibrary–d¦conš¬rtains“a“con˜v˜ersion“for“computing“the“image“of“a“function“Óf“Öon“a“ niteŽ¡‘Çaset–ê¨Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ö.‘8àThe“functionŽ¦ŸÜŸþõQ‘*_ÓIMAGE_CONV–¿ª:“conv“->“conv“->“convŽŽŽŽŽŽŽŸ ­é‘ÇaÖis–*•parameterized“bš¬ry“t˜w˜o“con˜v˜ersions.‘ø¦The“ rst“con˜v˜ersion“is“expSŽected“to“compute“theŽ¡‘Çaresult–ñ±of“applying“the“function“Óf“Öto“eacš¬rh“elemen˜t“ÎtŸ¤z¸1Ž‘ÀÖ,‘3t×:–ÿþ:“:ŽŽ‘þÖ,‘3tÎtŸ¤z¹nŽ‘¨PÖ.‘MüThe“second“parameter“isŽ¡‘Çaan––¿equalitš¬ry“con˜v˜ersion“whic˜h“is“used“to“simplify“the“resulting“image“set“b˜y“remo˜vingŽ¡‘Çaredundanš¬rt–ê¨oSŽccurrences“of“its“elemen˜ts.ŽŸ†‘(ðThe–ÄËfolloš¬rwing“session“sho˜ws“a“simple“example“of“the“use“of“ÓIMAGE_CONVŽ‘A:Öon“terms“of“theŽ¡‘Çaform›^Ó"IMAGE–¿ª(\x.x+2)“{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"Ö.‘ W‘ÿVe˜ rst˜de ne˜a˜con•¬rv“ersion˜that˜ev‘ÿXäaluates˜the˜resultŽ¡‘Çaof–ê¨applying“the“function“Ó(\x.x+2)“Öto“a“term“ÎtÖ.ŽŸ9]|‘ÇaŸÛ’µ‰ffÇ IŸ>€ùÌÍŸYœ„BÚ•ffŸÇ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªAP_CONV“=“BETA_CONV“THENC“(TRY_CONV“ADD_CONV);;Ž¤ ‘ÌÍAP_CONV–¿ª=“-“:“convŽŸ‘ÌÍ#AP_CONV–¿ª"(\n.n+2)“7";;Ž¡‘ÌÍ|-–¿ª(\n.“n“+“2)7“=“9ŽŽ’Æq°„BÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ8Öí‘ÇaÖThis›‹con•¬rv“ersion,–ž/together˜with˜the˜function˜ÓIMAGE_CONVŽ‘=µÖ,“giv•¬res˜a˜con“v“ersion˜for˜computingŽ¡‘Çathe–ê¨image“of“Ó(\x.x+2)“Öon“a“ nite“set“of“n¬rumerical“v‘ÿXäalues.ŽŽŽŒ‹àK ÌU ýFÓŸú™š‘êñëÛ16’ Ò¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý¤ñ°‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#IMAGE_CONV–¿ªAP_CONV“NO_CONV“"IMAGE“(\x.x+2)“{1,2,3,4}";;Ž¤ ‘ÌÍ|-–¿ªIMAGE(\x.“x“+“2){1,2,3,4}“=“{3,4,5,6}ŽŸ‘ÌÍ#IMAGE_CONV–¿ªAP_CONV“NO_CONV“"IMAGE“(\x.x+2)“{n,1,n}";;Ž¡‘ÌÍ|-–¿ªIMAGE(\x.“x“+“2){n,1,n}“=“{3,n“+“2}ŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ©6—w‘êñëÖIn–EWthis“case,‘fgthe“second“parameter“supplied“to“ÓIMAGE_CONVŽ‘@RÖis“the“con•¬rv“ersion‘EWÓNO_CONVŽ‘+‚ýÖ.‘ÅThisŽ¤‘êñëmeans– ÿthat“no“reduction“of“the“resulting“image“set“is“done,‘QÕbSŽey¬rond“the“elimination“ofŽ¡‘êñëelemenš¬rts–:that“are“pro˜v‘ÿXäably“redundan˜t“b˜y“virtue“of“bSŽeing“alpha-equiv‘ÿXäalen˜t“to“some“otherŽ¡‘êñëelemenš¬rt–ê¨(as“in“the“second“example“abSŽo˜v˜e).ŽŸ):‘öSzThe–ê¨follo¬rwing“session“illustrates“the“use“of“the“second“parameter“to“ÓIMAGE_CONVŽ‘=gLÖ.ŽŸ6À°‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#IMAGE_CONV–¿ªBETA_CONV“NO_CONV“"IMAGE“(\x.“SUC“x)“{1,SUC“0,2,0}";;Ž¤ ‘ÌÍ|-–¿ªIMAGE(\x.“SUC“x){1,SUC“0,2,0}“=“{SUC“1,SUC(SUC“0),SUC“2,SUC“0}ŽŸ‘ÌÍ#IMAGE_CONV–¿ªBETA_CONV“num_EQ_CONV“"IMAGE“(\x.“SUC“x)“{1,SUC“0,2,0}";;Ž¡‘ÌÍ|-–¿ªIMAGE(\x.“SUC“x){1,SUC“0,2,0}“=“{SUC(SUC“0),SUC“2,SUC“0}ŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¦‘êñëÖIn–ªbthe“ rst“ev‘ÿXäaluation,‘·=just“applying“ÓBETA_CONVŽ‘;¾Öto“the“application“of“Ó(\x.–¿ªSUC“x)–ªbÖto“eac¬rhŽ¡‘êñëelemenš¬rt–whas“resulted“in“an“image“set“con˜taining“bSŽoth“ÓSUC›¿ª1“Öand“ÓSUC(SUC˜0)Ö.‘ñzIn“the“secondŽ¡‘êñëexample,‘Ónum_EQ_CONVŽ‘HR¾Öis–yaused“to“pro•¬rv“e–yathese“v‘ÿXäalues“equal,‘and“therefore“to“simplify“theŽ¡‘êñëresulting–?èset“b¬ry“eliminating“one“of“them“from“it.‘8ŸF‘ÿVor“more“detail“abSŽout“ÓIMAGE_CONVŽ‘=¼ŒÖ,‘U7seeŽ¡‘êñëthe–ê¨reference“enš¬rtry“for“this“con˜v˜ersion“in“c˜hapter“2.ŽŸ)‘êñëç1.12Ž‘"% Mappings›Ÿ¼b‘Oet–ÿr°w“een˜setsŽŸ5ö‘êñëÖThe‘Ú9ÓsetsŽ‘³Ölibrary–Ú9conš¬rtains“a“few“basic“de nitions“and“theorems“ha˜ving“to“do“with“mappingsŽ¡‘êñëbSŽet•¬rw“een–å£sets.‘áÞA‘å`function“Óf:*->**Ž‘.ìÖis“an“Ùinje‘ÿffctive‘ËSÖ(one-to-one)“mapping“from“a“set“Ós:(*)setŽŽ¡‘êñëÖto–ê¨a“set“Ót:(**)setŽ‘;’JÖif“it“takš¬res“distinct“elemen˜ts“of“ÓsŽ‘ ”úÖto“distinct“elemen˜t“of“ÓtŽ‘ ªRÖ:ŽŸ65ŸŽ4ŸÉ‘‘0éÓINJ_DEF‘¿ª=Ž¤ ‘0é|-–¿ª!f“s“t.Ž¡‘/‘INJ–¿ªf“s“t“=Ž¡‘/‘(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘/‘(!x–¿ªy.“x“IN“s“/\“y“IN“s“==>“(f“x“=“f“y)“==>“(x“=“y))ŽŽŽŽŽŽŽŸ8d‘êñëÖLikš¬rewise,‘1a–—function“Óf:*->**Ž‘.BÔÖis“a“Ùsurje‘ÿffctive‘èGÖ(on˜to)“mapping“from“ÓsŽ› ÄØÖto“ÓtŽ˜Öif“for“evš¬rery“elemen˜tŽ¡‘êñëÓxŽ‘ôœ=Öof‘ê¨ÓtŽ› ”úÖthere–ê¨is“some“elemen¬rt“ÓyŽ˜Öof“ÓsŽ˜Öfor“whic¬rh“Óf–¿ªy“=“xÖ:ŽŸ7 ŸŽ4ŸÉ‘‘0éÓSURJ_DEF‘¿ª=Ž¤ ‘0é|-–¿ª!f“s“t.Ž¡‘/‘SURJ–¿ªf“s“t“=Ž¡‘/‘(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘/‘(!x.–¿ªx“IN“t“==>“(?y.“y“IN“s“/\“(f“y“=“x)))ŽŽŽŽŽŽŽŽŽŒ‹ë> ÌU ýFÓŸú™š‘ÇaÛ1.13.‘ €Finite–€and“in nite“sets’ù17Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖFinally‘ÿV,‘ÚÀa–ÖÇfunction“Óf:*->**Ž‘/ë4Öis“a“Ùbije‘ÿffction‘¼wÖfrom“ÓsŽ› m8Öto“ÓtŽ˜Öif“it“is“bSŽoth“injectivš¬re“and“surjectiv˜e:Ž¤uŽŸPáŸþõQ‘*_ÓBIJ_DEF–¿ª=“|-“!f“s“t.“BIJ“f“s“t“=“INJ“f“s“t“/\“SURJ“f“s“tŽŽŽŽŽŽŽ¡‘(ðÖThere–ÅŠare“a“few“pre-pro•¬rv“ed–ÅŠtheorems“abSŽout“the“predicates“ÓINJŽ‘ˆÖ,‘Ì÷ÓSURJŽ‘ËŸÖ,‘Ì÷and“ÓBIJŽ‘ÊÖa¬rv‘ÿXäailableŽ¤‘Çain–ê¨the“library;“see“c¬rhapter“3“for“a“full“list“of“these“theorems.Ž¡‘(ðThe–F–library“also“conš¬rtains“constan˜t“spSŽeci cations“for“t˜w˜o“functions“ÓLINVŽ‘‹ÔÖand“ÓRINVŽ‘E>Ö,‘ggwhic˜hŽ¡‘Çayield–Ê*left“and“righš¬rt“in˜v˜erses“to“injectiv˜e“and“surjectiv˜e“mappings“respSŽectiv˜ely‘ÿV.‘ ×eTheseŽ¡‘Çafunctions–ê¨are“de ned“b¬ry:Ž¤ õ_ŸÐáŸñõQ‘*_ÓLINV_DEF–¿ª=“|-“!f“s“t.“INJ“f“s“t“==>“(!x.“x“IN“s“==>“(LINV“f“s(f“x)“=“x))ŽŸ ‘*_RINV_DEF–¿ª=“|-“!f“s“t.“SURJ“f“s“t“==>“(!x.“x“IN“t“==>“(f(RINV“f“s“x)“=“x))ŽŽŽŽŽŽŽ¡‘ÇaÖThere–7&are,›[ at“presen¬rt,˜no“additional“built-in“theorems“abSŽout“these“t•¬rw“o‘7&functions.‘ý F‘ÿVurther-Ž¤‘Çamore,‘ãthe–å²de nitions“of“ÓLINVŽ›Ê Öand“ÓRINVŽ˜Öshoš¬rwn“abSŽo˜v˜e“should“bSŽe“regarded“as“only“pro˜visional;Ž¡‘Çathey–ê¨maš¬ry“bSŽe“c˜hanged“in“future“v˜ersions.ŽŸ'âc‘Çaç1.13Ž‘IúFinite–Ÿ¼and“in nite“setsŽŸâ#‘ÇaÖThe‘7ŠÓsetsŽ‘m¼Ölibrary–7Šincludes“the“de nition“of“a“predicate“called“ÓFINITEŽ‘%µ†Ö,‘[]whic¬rh“is“true“of“ niteŽ¡‘Çasets–ê¨and“false“of“in nite“ones.‘8àThe“de nition“of“this“constanš¬rt“is“sho˜wn“bSŽelo˜w.ŽŸ+³ŸKˆŸØi‘*_ÓFINITE_DEFŽ¤ ‘5…³|-‘¿ª!s.Ž¡‘L„[FINITE–¿ªs“=Ž¡‘L„[(!P.–¿ªP{}“/\“(!s'.“P“s'“==>“(!e.“P(e“INSERT“s')))“==>“P“s)ŽŽŽŽŽŽŽŸ-p‘ÇaÖThat–êis,‘)óa“set“ÓsŽ‘“ØÖis“ nite“precisely“when“it“is“in“the“smallest“class“of“sets“that“con¬rtainsŽ¡‘Çathe–üemptš¬ry“set“and“is“closed“under“the“ÓINSERTŽ‘*vÖopSŽeration.‘mThis“inductiv˜e“de nition“mak˜esŽ¡‘ÇaÓFINITEŽ‘:}ÚÖtrue–8}of“just“those“sets“that“can“bSŽe“constructed“from“the“emptš¬ry“set“b˜y“a“ niteŽ¡‘Çasequence–ê¨of“applications“of“the“ÓINSERTŽ‘*SLÖopSŽeration.Ž¡‘(ðThe‘ƒÓsetsŽ‘ ²Ölibrary–ƒconš¬rtains“v‘ÿXäarious“built-in“theorems“that“follo˜w“from“the“de nition“ofŽ¡‘ÇaÓFINITEŽ‘90Ögiv•¬ren›ê¨abSŽo“v“e.‘8àAmong˜these˜are˜the˜t“w“o˜fundamen“tal˜theorems˜sho“wn˜bSŽelo“w:Ž¤ õ_ŸÐáŸñõQ‘*_ÓFINITE_EMPTY‘>þ|-‘¿ªFINITE{}ŽŸ ‘*_FINITE_INSERT‘ T|-–¿ª!x“s.“FINITE(x“INSERT“s)“=“FINITE“sŽŽŽŽŽŽŽ¡‘ÇaÖThese–µ›state“that“the“empt¬ry“set“is“indeed“ nite“and“insertion“constructs“ nite“sets“onlyŽ¤‘Çafrom–ê¨other“ nite“sets.‘8àSee“c¬rhapter“3“for“other“built-in“theorems“abSŽout“ nite“sets.Ž¡‘(ðThe›yÕabSŽo•¬rv“e˜de nition˜of˜ÓFINITEŽ‘-q¦Öformalizes˜the˜notion˜of˜a˜ nite˜set˜in˜logic,‘Ý and˜itŽ¡‘Çatherefore–å½also“determines“the“form“of“de nition“for“the“complemen¬rtary“notion“of“an“in niteŽ¡‘Çaset.‘8àIn–ê¨the“ÓsetsŽ‘ÓøÖlibrary‘ÿV,“the“predicate“ÓINFINITEŽ‘5Ò Öis“de ned“as“follo¬rws:ŽŸuŽŸPáŸþõQ‘*_ÓINFINITE_DEF‘>þ|-–¿ª!s.“INFINITE“s“=“~FINITE“sŽŽŽŽŽŽŽŽŽŒ‹÷, ÌU ýFÓŸú™š‘êñëÛ18’ Ò¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖThere–!Ãare“a“few“consequences“of“this“de nition“stored“in“the“ÓsetsŽ‘B.Ölibrary‘ÿV.‘Þ1The“follo¬rwingŽ¤‘êñëtheorem,–OÃfor›;‹example,“states˜that˜the˜image˜of˜an˜injectiv¬re˜function˜on˜an˜in nite˜set˜isŽ¡‘êñëin nite:ŽŸ"uAŸ ˈŸåi‘0éÓIMAGE_11_INFINITEŽ¤ ‘oç|-–¿ª!f.“(!x“y.“(f“x“=“f“y)“==>“(x“=“y))“==>Ž¡‘;­(!s.–¿ªINFINITE“s“==>“INFINITE(IMAGE“f“s))ŽŽŽŽŽŽŽŸ$Ê”‘êñëÖOther–ê¨built-in“theorems“abšSŽout“ÓINFINITEŽ‘5Ò Öcan“b˜e“found“in“c¬rhapter“3.ŽŸ"PÀ‘êñëâ1.13.1Ž‘%ÓTheorem-proŠ=ving‘…suppuÂortŽŸÀ‘êñëÖThere–>6are“t•¬rw“o–>6ÍML“Öfunctions“in“the“ÓsetsŽ‘!{Ölibrary“for“reasoning“abšSŽout“prop˜ositions“thatŽ¡‘êñëin•¬rv“olv“e–the“ niteness“predicate“ÓFINITEŽ‘'šÖ.‘Í?The“ rst“of“these“is“a“con•¬rv“ersion‘ÓFINITE_CONVŽŽ¡‘êñëÖwhicš¬rh–ê¨automatically“pro˜v˜es“that“sets“of“the“form“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öare“ nite.‘8àEv‘ÿXäaluatingŽ¤PŸ±ïŸþ34‘0éÓFINITE‘°—‰ffsŽ‘#™CONV–¿ª"FINITE“{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}";;ŽŽŽŽŽŽŽ¡‘êñëÖyields–ê¨the“theorem“Ó|-–¿ªFINITE“{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}“=“TÖ.Ž¤‘öSzThe–Vgsecond“ÍML“Öfunction“for“reasoning“abSŽout“the“predicate“ÓFINITEŽ‘)*ÊÖis“an“induction“tacticŽ¡‘êñëcalled‘vúÓSET_INDUCT_TACŽ‘TòFÖ.‘ÝÖWhen–vúapplied“to“a“goal“of“the“form“Ó"Í!ÎsÓ.–¿ªFINITE“Îs“Ó==>“ÎP‘…VÓ"Ö,‘šthisŽ¡‘êñëtactic–&•reduces“it“to“proš¬rving“that“the“propSŽert˜y“of“sets“expressed“b˜y“Ó\ÎsÓ.ÎP‘«ëÖholds“of“the“empt˜yŽ¡‘êñëset–Vwand“is“preservš¬red“b˜y“the“insertion“of“an“elemen˜t“in˜to“an“arbitrary“ nite“set.‘zSince“ev˜eryŽ¡‘êñë nite–îöset“can“bSŽe“built“up“from“the“emptš¬ry“set“b˜y“repSŽeated“insertion“of“v‘ÿXäalues,‘!Mthese“subgoalsŽ¡‘êñëimply–ê¨that“this“propSŽert¬ry“holds“of“all“ nite“sets.Ž¡‘öSzThe–?Bfolloš¬rwing“session“illustrates“the“use“of“the“tactic“ÓSET_INDUCT_TACŽ‘XùÐÖfor“pro˜ving“thatŽ¡‘êñëthe–y-in¬rtersection“of“an“arbitrary“set“ÓtŽ›²Öwith“a“ nite“set“ÓsŽ˜Öis“ nite.‘ äoW‘ÿVe“ rst“set“up“anŽ¡‘êñëappropriate‘ê¨goal:ŽŸ*ù!‘êñëŸâµ‰ffÇ IŸ1€ùÌÍŸYœ„5Ú•ffŸÔ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#g–¿ª"!s:(*)set.“FINITE“s“==>“!t.“FINITE(s“INTER“t)";;ŽŸ ‘ÌÍ"!s.–¿ªFINITE“s“==>“(!t.“FINITE(s“INTER“t))"ŽŸ‘ÌÍ()–¿ª:“voidŽŽ’Æq°„5Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ*ù ‘êñëÖExpanding–ê¨with“ÓSET_INDUCT_TACŽ‘XPœÖyields:ŽŸXy!‘êñ럴’µ‰ffÇ I Œ€ùÌÍŸYœ„Ú•ff ÿy|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#expand‘¿ªSET_INDUCT_TAC;;Ž¤ ‘ÌÍOK..Ž¡‘ÌÍ2‘¿ªsubgoalsŽ¡‘ÌÍ"!t.–¿ªFINITE((e“INSERT“s)“INTER“t)"Ž¡‘Ëu[–¿ª"FINITE“s"“]Ž¡‘Ëu[–¿ª"!t.“FINITE(s“INTER“t)"“]Ž¡‘Ëu[–¿ª"~e“IN“s"“]Ž¤‘ÌÍ"!t.–¿ªFINITE({}“INTER“t)"Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŽŽŒ‹‹ ÌU ýFÓŸú™š‘ÇaÛ1.14.‘ €Cardinalit y–€of“ nite“sets’B¿19Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖThe–ïresulting“subgoals“are“easy“to“pro•¬rv“e,‘­Ggiv“en–ïthe“t•¬rw“o–ïbasic“theorems“ÓFINITE_EMPTYŽ‘L7ÖÖandŽ¤‘ÇaÓFINITE_INSERTŽ‘aãîÖshoš¬rwn–`ëin“the“previous“section.‘›ªNote“that“it“ma˜y“bSŽe“assumed“in“the“stepŽ¡‘Çacase–ê¨that“the“v‘ÿXäalue“ÓeŽ› ”úÖbSŽeing“inserted“in¬rto“the“set“ÓsŽ˜Öis“not“already“an“elemen¬rt“of“ÓsŽ‘ ªRÖ.Ž©(PŠ‘Çaç1.14Ž‘IúCardinalit‘ÿr°y–Ÿ¼of“ nite“setsŽŸõ¨‘ÇaÖThe›¾ Ùc–ÿffar“dinality‘Ì"Öof˜a˜ nite˜set˜is˜the˜n•¬rum“bSŽer˜of˜elemen“ts˜it˜con“tains.‘ÔÝIn˜the˜ÓsetsŽ‘{èÖlibrary‘ÿV,‘ú¢thisŽ¡‘Çais–ŸËformalized“bš¬ry“a“constan˜t“ÓCARDŽ‘>>Öde ned“b˜y“means“of“the“follo˜wing“constan˜t“spSŽeci cation:ŽŸ5ÇFŸˈŸËi‘$FµÓCARD_DEFŽ¤ ‘/Æ |-–¿ª(CARD{}“=“0)“/\Ž¡‘A(!s.Ž¡‘L„[FINITE–¿ªs“==>Ž¡‘L„[(!x.–¿ªCARD(x“INSERT“s)“=“(x“IN“s“=>“CARD“s“|“SUC(CARD“s))))ŽŽŽŽŽŽŽŸ5½¬‘ÇaÖThis–\theorem“is“the“sole“de ning“propSŽert¬ry“of“ÓCARDŽ‘€Ö.‘üýBecause“the“equation“in“the“secondŽ¡‘Çaclause–`³holds“only“under“the“assumption“that“ÓsŽ‘Öis“ nite,‘¾5this“form“of“de nition“allo¬rwsŽ¡‘Çanothing–ê¨signi can¬rt“to“bšSŽe“deduced“ab˜out“the“cardinalit¬ry“`ÓCARD‘¿ªsŽ‘"}üÖ'“of“an“Ùin nite‘ÐXÖset“ÓsŽ‘ ªRÖ.ŽŸ š‘(ðThe–»dbuilt-in“theorems“abSŽout“cardinalit¬ry“are“all“restricted“to“ nite“sets“only‘ÿV,‘/“eitherŽ¡‘Çaimplicitly–ê¨as“in“the“theorem:ŽŸLÍŸPáŸþõQ‘*_ÓCARD_SING‘ T|-–¿ª!x.“CARD{x}“=“1ŽŽŽŽŽŽŽŸC4‘ÇaÖor–ê¨explicitly‘ÿV,“as“in:ŽŸBÇFŸ'ˈŸ±i‘*_ÓFINITE_ISO_NUMŽ¤ ‘5…³|-‘¿ª!s:(*)set.Ž¡‘L„[FINITE–¿ªs“==>Ž¡‘L„[(?f:num->*.Ž¡‘X¯(!n‘¿ªm.Ž¡‘cƒn–¿ª<“(CARD“s)“/\“m“<“(CARD“s)“==>“(f“n“=“f“m)“==>“(n“=“m))“/\Ž¡‘X¯(s–¿ª=“{f“n“|“n“<“(CARD“s)}))ŽŽŽŽŽŽŽŸB½¬‘ÇaÖThis–&second“theorem“states“that“the“elemenš¬rts“of“a“ nite“set“can“alw˜a˜ys“bSŽe“put“in˜to“aŽ¡‘Çaone-to-one–:écorrespšSŽondence“with“the“natural“n•¬rum“b˜ers–:éless“than“the“set's“cardinalit¬ry|i.e.Ž¡‘Çathe–öEelemenš¬rts“of“a“ nite“set“ÓsŽ‘¬4Öcan“bSŽe“n˜um˜bSŽered“Ó0Ž‘ µïÖ,‘9,Ó1Ž‘ øÖÖ,‘9,×:–ÿþ:“:ŽŽ‘ÊÖ,‘9,Ó(CARD‘¿ªs)-1Ö.‘[·Other“theoremsŽ¡‘Çain•¬rv“olving–ê¨the“cardinalitš¬ry“function“ÓCARDŽ‘ÓøÖcan“bSŽe“found“in“c˜hapter“3.Ž¦‘Çaç1.15Ž‘IúUsing–Ÿ¼the“libraryŽŸõ¨‘ÇaÖThe‘Œ-ÓsetsŽ‘Ölibrary–Œ-is“loaded“in¬rto“a“user's“ÍHOL“Ösession“using“the“function“Óload_libraryŽ‘LRÖ(seeŽ¡‘Çathe–±jÍHOL“Öman¬rual“for“a“general“description“of“library“loading).‘%ËThe“ rst“action“in“the“loadŽ¡‘Çasequence–‹is“to“upSŽdate“the“inš¬rternal“ÍHOL“Ösearc˜h“paths.‘ÿA‘Šípathname“to“the“library“is“addedŽŽŽŒ‹ ÌU ýFÓŸú™š‘êñëÛ20’ Ò¿Chapter–€1.‘ €The“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖto–}the“searcš¬rh“path“so“that“theorems“ma˜y“bSŽe“autoloaded“from“the“library“theory“ÓsetsŽ‘{©Ö;‘¡ŽandŽ¤‘êñëthe–öVÍHOL“Öhelp“searc¬rh“path“is“upSŽdated“with“a“pathname“to“online“help“ les“for“the“ÍMLŽ¡‘êñëÖfunctions–ê¨in“the“library‘ÿV.Ž¡‘öSzAfter–Í‹the“searcš¬rh“paths“are“upSŽdated,‘Dthe“actions“tak˜en“b˜y“the“load“sequence“for“ÓsetsŽŽ¡‘êñëÖdepšSŽend–;’on“the“curren¬rt“state“of“the“ÍHOL“Ösession.‘þƒIf“the“system“is“in“draft“mo˜de,‘^—the“libraryŽ¡‘êñëtheory‘üäÓsetsŽ‘øpÖis–üäadded“as“a“new“parenš¬rt“to“the“curren˜t“theory‘ÿV.‘o•If“the“system“is“not“in“draftŽ¡‘êñëmoSŽde,‘jYbut–JFthe“curren¬rt“theory“is“an“ancestor“of“the“ÓsetsŽ‘“4Ötheory“in“the“library“(e.g.“the“userŽ¡‘êñëis–pmin“a“fresh“ÍHOL“Ösession)“then“ÓsetsŽ‘ß‚Öis“made“the“curren¬rt“theory‘ÿV.‘Ê.In“bSŽoth“cases,‘‘Þthe“ÍMLŽ¡‘êñëÖfunctions–|Cproš¬rvided“b˜y“the“library“are“loaded“in˜to“ÍHOL‘q~Öand“all“the“theorems“in“the“libraryŽ¡‘êñë(including–˜zde nitions)“are“set“up“to“bSŽe“autoloaded“on“demand.‘BVThe“parser“and“prett¬ry-Ž¡‘êñëprin¬rter–ífor“the“notation“describšSŽed“ab˜o•¬rv“e–íin“sections“1.3.1“and“1.8.1“are“then“activ‘ÿXäated,Ž¡‘êñëand–~[the“ÍML“Öfunctions“proš¬rvided“b˜y“the“library“for“reasoning“abSŽout“sets“are“loaded.‘óøTheŽ¡‘êñëÓsetsŽ‘Û;Ölibrary–ê¨is“then“fully“loaded“in¬rto“the“user's“ÍHOL“Ösession.ŽŸ!õ©‘êñëâ1.15.1Ž‘%ÓExample‘…sessionŽŸÀ‘êñëÖThe–a8folloš¬rwing“session“sho˜ws“ho˜w“the“ÓsetsŽ‘!ÁÖlibrary“ma˜y“bSŽe“loaded“using“Óload_libraryŽ‘J]0Ö.Ž¡‘êñëSupp•SŽose,›6b“eginning–ÿçin“a“fresh“ÍHOL“Ösession,˜the“user“wishes“to“create“a“theory“ÓfooŽ‘>ÌÖwhoseŽ¡‘êñëparenš¬rts–ê¨include“the“theory“ÓsetsŽ‘ÓøÖin“the“library‘ÿV.‘8àThis“ma˜y“bSŽe“done“as“follo˜ws:Ž¤>žŽ‘êñëŸË¬ ‰ffÇ IŸ^NNÌÍŸYœ„b§êffŸ§¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#new_theory‘¿ª`foo`;;Ž¤ ‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#load_library‘¿ª`sets`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¡‘ÌÍLibrary–¿ªsets“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„b§êffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖLoading–®‡the“library“while“drafting“the“theory“ÓfooŽ‘œ Ömakš¬res“the“library“theory“ÓsetsŽ‘ [¶Öin˜to“aŽ¤‘êñëparenš¬rt–_ of“ÓfooŽ‘ž Ö.‘ –The“same“e ect“could“ha˜v˜e“bSŽeen“ac˜hiev˜ed“(in“a“fresh“session)“b˜y“ rstŽ¡‘êñëloading–ê¨the“library“and“then“creating“ÓfooŽ‘)¦Ö:Ž¤>žŽ‘êñëŸË¬ ‰ffÇ IŸ^NNÌÍŸYœ„b§êffŸ§¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`sets`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ªsets“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#new_theory‘¿ª`foo`;;Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„b§êffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖThe–Odtheory“ÓsetsŽ‘pÖis“ rst“made“the“curren¬rt“theory“of“the“new“session.‘It“then“automaticallyŽ¤‘êñëbSŽecomes–ê¨a“parenš¬rt“of“ÓfooŽ‘NÖwhen“this“theory“is“created“b˜y“Ónew_theoryŽ‘=gLÖ.Ž¡‘öSzNo¬rw,‘ÌïsuppšSŽose–Åthat“ÓfooŽ‘ÊÖhas“b˜een“created“as“sho¬rwn“ab˜o•¬rv“e,‘Ìïand–Åthe“user“do˜es“some“w¬rorkŽ¡‘êñëin–§this“theory‘ÿV,‘´quits“ÍHOLÖ,“and“in“a“later“session“wishes“to“load“the“theory“ÓfooŽ‘æÖ.‘"UThis“m¬rustŽ¡‘êñëbSŽe–ê¨done“b¬ry“Ù rst‘ìÖloading“the“ÓsetsŽ‘ÓøÖlibrary“and“Ùthen‘ÐXÖloading“the“theory“ÓfooŽ‘)¦Ö.ŽŽŽŒ‹… ÌU ýFÓŸú™š‘ÇaÛ1.15.‘ €Using–€the“library’.+F21Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý» |‘ÇaŸÅ, ‰ffÇ IŸkNNÌÍŸYœ„o§êffŸš¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`sets`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ªsets“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#load_theory‘¿ª`foo`;;Ž¡‘ÌÍTheory–¿ªfoo“loadedŽ¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„o§êffŽŽŸÀ‰ffÇ IŽŽŽŸK¯‘ÇaÖThis–§Œsequence“of“actions“ensures“that“the“system“can“ nd“the“paren¬rt“theory“ÓsetsŽ‘MÀÖwhen“itŽ¤‘Çacomes–ê¨to“load“ÓfooŽ‘)¦Ö,“since“loading“the“library“upSŽdates“the“searc¬rh“path.ŽŸ"Ê«‘Çaâ1.15.2Ž‘M¨ŒThe–…óJßê|ŽŽŽ ”/ߎŒ‹2ž ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|ŸGëHML– ‰‹F‘ýunctions“in“the“sets“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–úcš¬rhapter“pro˜vides“doSŽcumen˜tation“on“all“the“ÍML“Öfunctions“that“are“made“a˜v‘ÿXäailable“inŽ¤ÍHOL–´PÖwhen“the“ÓsetsŽ‘gHÖlibrary“is“loaded.‘&ÃThis“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“online“via“theŽ¡ÓhelpŽ‘éPÖfacilit¬ry‘ÿV.ŽŸ&3Ÿ¹IŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍóKßê“convŽ© âSynopsisŽ¡ÖReduce›ê¨Ó{x1,...,xn}–¿ªDELETE“x˜Öb¬ry˜deleting˜Óx˜Öfrom˜Ó{x1,...,xn}Ö.Ž¦âDescriptionŽ¡ÖThe–äÔfunction“ÓDELETE_CONV‘ä‘Öis“a“parameterized“con•¬rv“ersion–äÔfor“reducing“ nite“sets“of“the“formŽ¡Ó"{t1,...,tn}–¿ªDELETE“t"Ö,‘Ywhere–BüÓ{t1,...,tn}“Öis“a“set“of“t¬rypSŽe“Ó(ty)set“Öand“Ót“Öis“a“term“ofŽ¡tš¬rypSŽe–NÓtyÖ.‘cThe“ rst“argumen˜t“to“ÓDELETE_CONV‘MõÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–Nthat“decidesŽ¡equalit•¬ry›Ì bSŽet“w“een˜v‘ÿXäalues˜of˜the˜base˜t“ypSŽe˜ÓtyÖ.‘.«Giv“en˜an˜equation˜Ó"e1–¿ª=“e2"Ö,‘Ò(where˜Óe1˜ÖandŽ¡Óe2–.eÖare“terms“of“tš¬rypSŽe“ÓtyÖ,‘?Uthis“con˜v˜ersion“should“return“the“theorem“Ó|-–¿ª(e1“=“e2)“=“T‘.TÖorŽ¡the–ê¨theorem“Ó|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.Ž¡‘ aGiv•¬ren›R\suc“h˜a˜con“v“ersion˜ÓconvÖ,‘pÒthe˜function˜ÓDELETE_CONV‘R5Öreturns˜a˜con“v“ersion˜that˜mapsŽ¡a–ê¨term“of“the“form“Ó"{t1,...,tn}–¿ªDELETE“t"–ê¨Öto“the“theoremŽ©"‘>þÓ|-–¿ª{t1,...,tn}“DELETE“t“=“{ti,...,tj}ŽŸˆ…Öwhere–Ó{ti,...,tj}“Öis“the“subset“of“Ó{t1,...,tn}“Öfor“whicš¬rh“the“supplied“equalit˜y“con˜v˜ersionŽ¡Óconv‘ê¨Öpro•¬rv“esŽ¦‘>þÓ|-–¿ª(ti“=“t)“=“F,“...,“|-“(tj“=“t)“=“FŽŸˆ…Öand–îfor“all“the“elemenš¬rts“Ótk“Öin“Ó{t1,...,tn}“Öbut“not“in“Ó{ti,...,tj}Ö,‘.àeither“Óconv“Öpro˜v˜esŽ¡Ó|-–¿ª(tk“=“t)“=“T‘¿Öor–Ótk“Öis“alpha-equiv‘ÿXäalen¬rt“to“ÓtÖ.‘ÓThat“is,‘jèthe“reduced“set“Ó{ti,...,tj}Ž¡Öcomprises–¦ºall“those“elemenš¬rts“of“the“original“set“that“are“pro˜v‘ÿXäably“not“equal“to“the“deletedŽ¡elemen¬rt‘ê¨ÓtÖ.ŽŽŸ$ý’烈Û23ŽŽŒ‹3' ÌU ýFÓŸú™š‘êñëÛ24’«[úChapter–€2.‘ €ML“F‘þàunctions“in“the“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽ¤‘êñëÖIn–Uthe“folloš¬rwing“example,‘rïthe“con˜v˜ersion“Ónum_EQ_CONV‘TÛÖis“supplied“as“a“parameter“and“usedŽ¡‘êñëto–ê¨test“equalitš¬ry“of“the“deleted“v‘ÿXäalue“Ó2“Öwith“the“elemen˜ts“of“the“set.ŽŸ_†‘ü0éÓ#DELETE_CONV–¿ªnum_EQ_CONV“"{2,1,SUC“1,3}“DELETE“2";;Ž© ™š‘ü0é|-–¿ª{2,1,SUC“1,3}“DELETE“2“=“{1,3}ŽŸ'QÄ‘êñëâF‘þž¸ailureŽ¡‘êñëÓDELETE_CONV›¿ªconv–@Öfails“if“applied“to“a“term“not“of“the“form“Ó"{t1,...,tn}˜DELETE˜t"Ö.‘95AŽ¡‘êñëcall›gäÓDELETE_CONV–¿ªconv“"{t1,...,tn}“DELETE“t"˜Öfails˜unless˜for˜eac•¬rh˜elemen“t˜Óti˜Öof˜theŽ¡‘êñëset–=MÓ{t1,...,tn}Ö,‘‘öthe“term“Ót“Öis“either“alpha-equiv‘ÿXäalen¬rt“to“Óti“Öor“Óconv–¿ª"ti“=“t"‘=MÖreturnsŽ¡‘êñëÓ|-–¿ª(ti“=“t)“=“T–ê¨Öor“Ó|-–¿ª(ti“=“t)“=“FÖ.Ž¤‹Ø‘êñëâSee‘…alsoŽ¦‘êñëÓINSERT_CONV.ŽŸ'£ˆŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKFINITE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.‚ ‘êñëÓFINITE_CONV–¿ª:“convŽ¡‘êñëâSynopsisŽ©‘êñëÖPro•¬rv“es–ê¨ niteness“of“sets“of“the“form“Ó"{x1,...,xn}"Ö.Ž¡‘êñëâDescriptionŽ¦‘êñëÖThe› Kcon•¬rv“ersion˜ÓFINITE_CONV‘ ÖexpSŽects˜its˜term˜argumen“t˜to˜bSŽe˜an˜assertion˜of˜the˜formŽ¦‘êñëÓ"FINITE‘¿ª{x1,...,xn}"Ö.‘8àGiv•¬ren›ê¨suc“h˜a˜term,˜the˜con“v“ersion˜returns˜the˜theoremŽ¤_†‘ü0éÓ|-–¿ªFINITE“{x1,...,xn}“=“TŽ©'QÄ‘êñëâExampleŽ¡‘êñëÓ#FINITE_CONV–¿ª"FINITE“{1,2,3}";;Ž¤ ™š‘êñë|-–¿ªFINITE{1,2,3}“=“TŽŸ34‘êñë#FINITE_CONV–¿ª"FINITE“({}:num“set)";;Ž¡‘êñë|-–¿ªFINITE{}“=“TŽ¦‘êñëâF‘þž¸ailureŽŸ‘êñëÖF‘ÿVails–ê¨if“applied“to“a“term“not“of“the“form“Ó"FINITE‘¿ª{x1,...,xn}"Ö.ŽŽŽŒ‹;k ÌU ýFÓŸú™š‘ÇaÒIMA¦tGE‘Ái‰ffÇŽ‘ˆ„CONV’c5>Û25Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKIMAGE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ2 ‘ÇaÓIMAGE_CONV–¿ª:“conv“->“conv“->“convŽ¤?‘ÇaâSynopsisŽ©_БÇaÖCompute–ê¨the“image“of“a“function“on“a“ nite“set.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖThe–€pfunction“ÓIMAGE_CONV‘€Öis“a“parameterized“con•¬rv“ersion–€pfor“computing“the“image“of“aŽ¤‘Çafunction–(´Óf:ty1->ty2“Öon“a“ nite“set“Ó"{t1,...,tn}"“Öof“tš¬rypSŽe“Ó(ty1)setÖ.‘óThe“ rst“argumen˜tŽ¡‘Çato–Ø¥ÓIMAGE_CONV‘ØgÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–Ø¥that“computes“the“result“of“applying“theŽ¡‘Çafunction–‰+Óf“Öto“eacš¬rh“elemen˜t“of“this“set.‘jWhen“applied“to“a“term“Ó"f‘¿ªti"Ö,‘°Ìthis“con˜v˜ersionŽ¡‘Çashould–V‚return“a“theorem“of“the“form“Ó|-–¿ª(f“ti)“=“riÖ,‘qywhere–V‚Óri“Öis“the“result“of“applyingŽ¡‘Çathe–¯ofunction“Óf“Öto“the“elemenš¬rt“ÓtiÖ.‘‡4This“con˜v˜ersion“is“used“b˜y“ÓIMAGE_CONV‘¯<Öto“compute“aŽ¡‘Çatheorem–ê¨of“the“formŽŸÙ‘$_Ó|-–¿ªIMAGE“f“{t1,...,tn}“=“{r1,...,rn}ŽŸp‘ÇaÖThe–IÞsecond“argumen¬rt“to“ÓIMAGE_CONV‘IÆÖis“used“(optionally)“to“simplify“the“resulting“imageŽ¡‘Çaset–ÿöÓ{r1,...,rn}“Öbš¬ry“remo˜ving“redundan˜t“oSŽccurrences“of“v‘ÿXäalues.‘xËThis“con˜v˜ersion“expSŽectedŽ¡‘Çato–¥Ûdecide“equalitš¬ry“of“v‘ÿXäalues“of“the“result“t˜ypSŽe“Óty2Ö;‘ugiv˜en“an“equation“Ó"e1–¿ª=“e2"Ö,‘Ô¨whereŽ¡‘ÇaÓe1–ŠgÖand“Óe2“Öare“terms“of“tš¬rypSŽe“Óty2Ö,‘§the“con˜v˜ersion“should“return“either“Ó|-–¿ª(e1“=“e2)“=“T‘ŠOÖorŽ¡‘ÇaÓ|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.Ž¦‘(ðGivš¬ren–Ê8appropriate“con˜v˜ersions“Óconv1“Öand“Óconv2Ö,‘Bthe“function“ÓIMAGE_CONV‘ɽÖreturns“aŽ¡‘Çacon•¬rv“ersion–ê¨that“maps“a“term“of“the“form“Ó"IMAGE–¿ªf“{t1,...,tn}"–ê¨Öto“the“theoremŽŸÙ‘$_Ó|-–¿ªIMAGE“f“{t1,...,tn}“=“{rj,...,rk}ŽŸp‘ÇaÖwhere–èÓconv1“Öpro•¬rv“es–èa“theorem“of“the“form“Ó|-–¿ª(f“ti)“=“ri–èÖfor“eacš¬rh“elemen˜t“Óti“Öof“the“setŽ¡‘ÇaÓ{t1,...,tn}Ö,‘…’and–f—where“the“set“Ó{rj,...,rk}“Öis“the“smallest“subset“of“Ó{r1,...,rn}“Ösuc¬rhŽ¡‘Çano›ïît•¬rw“o˜elemen“ts˜are˜alpha-equiv‘ÿXäalen“t˜and˜Óconv2˜ÖdoSŽes˜not˜map˜Ó"rl–¿ª=“rm"˜Öto˜the˜theoremŽ¡‘ÇaÓ|-–¿ª(rl“=“rm)“=“T‘è@Öfor–èAan¬ry“pair“of“v‘ÿXäalues“Órl“Öand“Órm“Öin“Ó{rj,...,rk}Ö.‘8That“is,‘è¼Ó{rj,...,rk}Ž¡‘ÇaÖis–×Âthe“set“obtained“bš¬ry“remo˜ving“m˜ultiple“oSŽccurrences“of“v‘ÿXäalues“from“the“set“Ó{r1,...,rn}Ö,Ž¡‘Çawhere–õ‘the“equalitš¬ry“con˜v˜ersion“Óconv2“Ö(or“alpha-equiv‘ÿXäalence)“is“used“to“determine“whic˜hŽ¡‘Çapairs–ê¨of“terms“in“Ó{r1,...,rn}“Öare“equal.ŽŸ?‘ÇaâExampleŽ¦‘ÇaÖThe–Yfolloš¬rwing“is“a“v˜ery“simple“example“in“whic˜h“ÓREFL‘/Öis“used“to“construct“the“result“ofŽ¡‘Çaapplying–the“function“Óf“Öto“eacš¬rh“elemen˜t“of“the“set“Ó{1,2,1,4}Ö,‘¡hand“ÓNO_CONV‘Öis“the“suppliedŽŽŽŒ‹B ÌU ýFÓŸú™š‘êñëÛ26’«[úChapter–€2.‘ €ML“F‘þàunctions“in“the“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖ`equalit•¬ry‘ê¨con“v“ersion'.Ž©z‘ü0éÓ#IMAGE_CONV–¿ªREFL“NO_CONV“"IMAGE“(f:num->num)“{1,2,1,4}";;ŽŸ ™š‘ü0é|-–¿ªIMAGE“f{1,2,1,4}“=“{f“2,f“1,f“4}ŽŸ¨W‘êñëÖThe–dresult“conš¬rtains“only“one“oSŽccurrence“of“`Óf‘¿ª1Ö',‘ev˜en“though“ÓNO_CONV‘^Öalw˜a˜ys“fails,‘sinceŽ¤‘êñëÓIMAGE_CONV‘âÑÖsimpli es–ãthe“resulting“set“bš¬ry“remo˜ving“elemen˜ts“that“are“redundan˜t“up“toŽ¡‘êñëalpha-equiv‘ÿXäalence.ŽŸ8‘öSzF‘ÿVor–­xthe“next“example,‘¹µwš¬re“construct“a“con˜v˜ersion“that“maps“ÓSUC‘¿ªn“Öfor“an˜y“n˜umeral“Ón“ÖtoŽ¡‘êñëthe–ê¨n¬rumeral“standing“for“the“successor“of“ÓnÖ.Ž¦‘ü0éÓ#let–¿ªSUC_CONV“tm“=Ž¤ ™š‘ï;let–¿ªn“=“int_of_string(fst(dest_const(rand“tm)))“inŽ¡‘ï;let–¿ªsucn“=“mk_const(string_of_int(n+1),“":num")“inŽ¡‘/íãSYM–¿ª(num_CONV“sucn);;Ž¡‘ü0éSUC_CONV–¿ª=“-“:“convŽŸ¨W‘êñëÖThe–ê¨result“is“a“con•¬rv“ersion–ê¨that“in•¬rv“erts‘ê¨Ónum_CONVÖ:Ž¦‘ü0éÓ#num_CONV‘¿ª"4";;Ž¡‘ü0é|-–¿ª4“=“SUC“3ŽŸ34‘ü0é#SUC_CONV–¿ª"SUC“3";;Ž¡‘ü0é|-–¿ªSUC“3“=“4ŽŸ¨W‘êñëÖThe›<þcon•¬rv“ersion˜ÓSUC_CONV‘<ÑÖcan˜then˜bSŽe˜used˜to˜compute˜the˜image˜of˜the˜successor˜functionŽŸ‘êñëon–ê¨a“ nite“set:Ž¦‘ü0éÓ#IMAGE_CONV–¿ªSUC_CONV“NO_CONV“"IMAGE“SUC“{1,2,1,4}";;Ž¡‘ü0é|-–¿ªIMAGE“SUC{1,2,1,4}“=“{3,2,5}ŽŸ¨W‘êñëÖNote–ê¨that“Ó2“Ö(=“ÓSUC‘¿ª1Ö)“appSŽears“only“once“in“the“resulting“set.ŽŸ8‘öSzFianlly‘ÿV,‘dhere–­¥is“an“example“of“using“ÓIMAGE_CONV‘­1Öto“compute“the“image“of“a“pairedŽŸ‘êñëaddition–ê¨function“on“a“set“of“pairs“of“n•¬rum“bSŽers:Ž¦‘ü0éÓ#IMAGE_CONV–¿ª(PAIRED_BETA_CONV“THENC“ADD_CONV)“num_EQ_CONVŽ¡‘A,á"IMAGE–¿ª(\(n,m).n+m)“{(1,2),“(3,4),“(0,3),“(1,3)}";;Ž¡‘ü0é|-–¿ªIMAGE(\(n,m).“n“+“m){(1,2),(3,4),(0,3),(1,3)}“=“{7,3,4}ŽŸ)P®‘êñëâF‘þž¸ailureŽŸ8‘êñëÓIMAGE_CONV–¿ªconv1“conv2–þÖfails“if“applied“to“a“term“not“of“the“form“Ó"IMAGE–¿ªf“{t1,...,tn}"Ö.Ž¤‘êñëAn–Ö´application“of“ÓIMAGE_CONV–¿ªconv1“conv2–Ö´Öto“a“term“Ó"IMAGE–¿ªf“{t1,...,tn}"–Ö´Öfails“unlessŽ¡‘êñëfor–5all“Óti“Öin“the“set“Ó{t1,...,tn}Ö,‘‡´ev‘ÿXäaluating“Óconv1–¿ª"f“ti"–5Öreturns“Ó|-–¿ª(f“ti)“=“ri‘5ÖforŽ¡‘êñësome‘ê¨ÓriÖ.ŽŽŽŒ‹M_ ÌU ýFÓŸú™š‘ÇaÒINSER‘þó\T‘Ái‰ffÇŽ‘ˆ„CONV’`:)Û27Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKINSERT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ3ï‘ÇaÓINSERT_CONV–¿ª:“conv“->“convŽ¤•‘ÇaâSynopsisŽ©¥@‘ÇaÖReduce›ê¨Óx–¿ªINSERT“{x1,...,x,...,xn}˜Öto˜Ó{x1,...,x,...,xn}Ö.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖThe–Üfunction“ÓINSERT_CONV‘ŒÖis“a“parameterized“con•¬rv“ersion–Üfor“reducing“ nite“sets“of“theŽ¤‘Çaform›¶ÛÓ"t–¿ªINSERT“{t1,...,tn}"Ö,‘Á7where˜Ó{t1,...,tn}˜Öis˜a˜set˜of˜t¬rypSŽe˜Ó(ty)set˜Öand˜Ót˜Öis˜equalŽ¡‘Çato–±some“elemenš¬rt“Óti“Öof“this“set.‘fThe“ rst“argumen˜t“to“ÓINSERT_CONV‘±LÖis“expšSŽected“to“b˜e“aŽ¡‘Çacon•¬rv“ersion–Wtthat“decides“equalitš¬ry“bSŽet˜w˜een“v‘ÿXäalues“of“the“base“t˜ypSŽe“ÓtyÖ.‘DGiv˜en“an“equationŽ¡‘ÇaÓ"e1–¿ª=“e2"Ö,›÷where–º=Óe1“Öand“Óe2“Öare“terms“of“t¬rypSŽe“ÓtyÖ,˜this“con•¬rv“ersion–º=should“return“the“theoremŽ¡‘ÇaÓ|-–¿ª(e1“=“e2)“=“T–ê¨Öor“the“theorem“Ó|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.Ž¦‘(ðGiv•¬ren›½»suc“h˜a˜con“v“ersion,‘òthe˜function˜ÓINSERT_CONV‘½„Öreturns˜a˜con“v“ersion˜that˜maps˜aŽ¡‘Çaterm–ê¨of“the“form“Ó"t–¿ªINSERT“{t1,...,tn}"–ê¨Öto“the“theoremŽŸ.š‘$_Ó|-–¿ªt“INSERT“{t1,...,tn}“=“{t1,...,tn}ŽŸïÀ‘ÇaÖif–îyÓt“Öis“alpha-equiv‘ÿXäalenš¬rt“to“an˜y“Óti“Öin“the“set“Ó{t1,...,tn}Ö,‘/mor“if“the“supplied“con˜v˜ersionŽ¡‘Çapro•¬rv“es›ê¨Ó|-–¿ª(t“=“ti)“=“T˜Öfor˜an¬ry˜ÓtiÖ.ŽŸ•‘ÇaâExampleŽ¦‘ÇaÖIn–Uthe“folloš¬rwing“example,‘rïthe“con˜v˜ersion“Ónum_EQ_CONV‘TÛÖis“supplied“as“a“parameter“and“usedŽ¡‘Çato–ê¨test“equalitš¬ry“of“the“inserted“v‘ÿXäalue“Ó2“Öwith“the“remaining“elemen˜ts“of“the“set.ŽŸ.š‘$_Ó#INSERT_CONV–¿ªnum_EQ_CONV“"2“INSERT“{1,SUC“1,3}";;ŽŸ ™š‘$_|-–¿ª{2,1,SUC“1,3}“=“{1,SUC“1,3}ŽŸïÀ‘ÇaÖIn–^Çthis“example,‘»Îthe“supplied“con•¬rv“ersion–^ÇÓnum_EQ_CONV‘^gÖis“able“to“pro•¬rv“e–^Çthat“Ó2“Öis“equalŽ¡‘Çato–}HÓSUC›¿ª1“Öand“the“set“is“therefore“reduced.‘ ð¿Note“that“Ó"2˜INSERT˜{1,SUC˜1,3}"“Öis“justŽ¡‘ÇaÓ"{2,1,SUC‘¿ª1,3}"Ö.Ž¦‘(ðA› Öcall– Þto“ÓINSERT_CONV˜Öfails“when“the“v›ÿXäalue“bSŽeing“inserted“is“pro¬rv˜ably“not“equal“to“an¬ryŽ¡‘Çaof–ê¨the“remaining“elemen¬rts:ŽŸ.š‘$_Ó#INSERT_CONV–¿ªnum_EQ_CONV“"1“INSERT“{2,3}";;ŽŸ ™š‘$_evaluation‘¿ªfailed‘¾RINSERT_CONVŽŸïÀ‘ÇaÖBut–ê¨this“failure“can,“if“desired,“bSŽe“caugh¬rt“using“ÓTRY_CONVÖ.ŽŽŽŒ‹V" ÌU ýFÓŸú™š‘êñëÛ28’«[úChapter–€2.‘ €ML“F‘þàunctions“in“the“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖThe–|ùbSŽehaš¬rviour“of“the“supplied“con˜v˜ersion“is“irrelev‘ÿXäan˜t“when“the“inserted“v‘ÿXäalue“is“alpha-Ž¤‘êñëequiv‘ÿXäalenš¬rt–ê¨to“one“of“the“remaining“elemen˜ts:Ž©‘ü0éÓ#INSERT_CONV–¿ªNO_CONV“"(y:*)“INSERT“{x,y,z}";;ŽŸ ™š‘ü0é|-–¿ª{y,x,y,z}“=“{x,y,z}ŽŸ€‚‘êñëÖThe›µ‰con•¬rv“ersion˜ÓNO_CONV‘µUÖalw“a“ys˜fails,‘èBbut˜ÓINSERT_CONV‘µUÖis˜non“theless˜able˜in˜this˜case˜toŽ¡‘êñëpro•¬rv“e–ê¨the“required“result.Ž¡‘öSzNote–)Òthat“ÓDEPTH_CONV(INSERT_CONV‘¿ªconv)“Öcan“bSŽe“used“to“remo•¬rv“e–)Òduplicate“elemen¬rtsŽ¡‘êñëfrom–ê¨a“ nite“set,“but“the“folloš¬rwing“con˜v˜ersion“is“faster:Ž¦‘ü0éÓ#letrec–¿ªREDUCE_CONV“conv“tm“=Ž¤ ™š‘ oç(SUB_CONV–¿ª(REDUCE_CONV“conv)“THENC“(TRY_CONV“(INSERT_CONV“conv)))“tm;;Ž¡‘ü0éREDUCE_CONV–¿ª=“-“:“(conv“->“conv)ŽŸ34‘ü0é#REDUCE_CONV–¿ªnum_EQ_CONV“"{1,2,1,3,2,4,3,5,6}";;Ž¡‘ü0é|-–¿ª{1,2,1,3,2,4,3,5,6}“=“{1,2,4,3,5,6}ŽŸ&‡‘êñëâF‘þž¸ailureŽ¤‘êñëÓINSERT_CONV›¿ªconv–@Öfails“if“applied“to“a“term“not“of“the“form“Ó"t˜INSERT˜{t1,...,tn}"Ö.‘95AŽ¡‘êñëcall›ŽÓINSERT_CONV–¿ªconv“"t“INSERT“{t1,...,tn}"˜Öfails˜unless˜Ót˜Öis˜alpha-equiv‘ÿXäalen¬rt˜to˜someŽ¡‘êñëÓtiÖ,–ê¨or“Óconv–¿ª"t“=“ti"–ê¨Öreturns“Ó|-–¿ª(t“=“ti)“=“T–ê¨Öfor“some“ÓtiÖ.Ž¤‘êñëâSee‘…alsoŽŸ ™š‘êñëÓDELETE_CONV.ŽŸ&Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKIN_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ-lb‘êñëÓIN_CONV–¿ª:“conv“->“convŽ¡‘êñëâSynopsisŽ©‘êñëÖDecision–ê¨prošSŽcedure“for“mem¬rb˜ership“in“ nite“sets.Ž¡‘êñëâDescriptionŽ¦‘êñëÖThe–20function“ÓIN_CONV‘2Öis“a“parameterized“con•¬rv“ersion–20for“proš¬rving“or“dispro˜ving“mem˜bSŽershipŽ¦‘êñëassertions–ê¨of“the“general“form:ŽŸ‘ü0éÓ"t–¿ªIN“{t1,...,tn}"ŽŸ€‚‘êñëÖwhere–á­Ó{t1,...,tn}“Öis“a“set“of“tš¬rypSŽe“Ó(ty)set“Öand“Ót“Öis“a“v‘ÿXäalue“of“the“base“t˜ypSŽe“ÓtyÖ.‘ðTheŽ¦‘êñë rst–©¤argumen¬rt“to“ÓIN_CONV‘©sÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–©¤that“decides“equalit¬ry“b˜et•¬rw“eenŽŽŽŒ‹_‘ ÌU ýFÓŸú™š‘ÇaÒIN‘Ái‰ffÇŽ‘ˆ„CONV’€¦°Û29Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖv‘ÿXäalues–of“the“base“tš¬rypSŽe“ÓtyÖ.‘×dGiv˜en“an“equation“Ó"e1–¿ª=“e2"Ö,‘l´where–Óe1“Öand“Óe2“Öare“termsŽ¤‘Çaof–Xñtš¬rypSŽe“ÓtyÖ,‘tƒthis“con˜v˜ersion“should“return“the“theorem“Ó|-–¿ª(e1“=“e2)“=“T‘XÔÖor–Xñthe“theoremŽ¡‘ÇaÓ|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.ŽŸ‚'‘(ðGiv•¬ren›KÀsuc“h˜a˜con“v“ersion,‘dthe˜function˜ÓIN_CONV‘K§Öreturns˜a˜con“v“ersion˜that˜maps˜a˜termŽ¡‘Çaof–ê¨the“form“Ó"t–¿ªIN“{t1,...,tn}"–ê¨Öto“the“theoremŽ©¢7‘$_Ó|-–¿ªt“IN“{t1,...,tn}“=“TŽŸ†v‘ÇaÖif–:ãÓt“Öis“alpha-equiv‘ÿXäalenš¬rt“to“an˜y“ÓtiÖ,‘^ or“if“the“supplied“con˜v˜ersion“pro˜v˜es“Ó|-–¿ª(t“=“ti)“=“T‘:¶ÖforŽ¡‘Çaanš¬ry–™ÓtiÖ.‘ªIf“the“supplied“con˜v˜ersion“pro˜v˜es“Ó|-–¿ª(t“=“ti)“=“F‘˜ðÖfor–™ev˜ery“ÓtiÖ,‘©Ythen“the“result“isŽ¡‘Çathe‘ê¨theoremŽ¦‘$_Ó|-–¿ªt“IN“{t1,...,tn}“=“FŽŸ†v‘ÇaÖIn–ê¨all“other“cases,“ÓIN_CONV“Öwill“fail.ŽŸ‘ÇaâExampleŽŸ‚'‘ÇaÖIn–Uthe“folloš¬rwing“example,‘rïthe“con˜v˜ersion“Ónum_EQ_CONV‘TÛÖis“supplied“as“a“parameter“and“usedŽ¡‘Çato–ê¨test“equalitš¬ry“of“the“candidate“elemen˜t“Ó1“Öwith“the“actual“elemen˜ts“of“the“giv˜en“set.Ž¦‘$_Ó#IN_CONV–¿ªnum_EQ_CONV“"2“IN“{0,SUC“1,3}";;ŽŸ ™š‘$_|-–¿ª2“IN“{0,SUC“1,3}“=“TŽŸ†v‘ÇaÖThe–yresult“is“ÓT›xäÖbSŽecause“Ónum_EQ_CONV˜Öis“able“to“pro•¬rv“e–ythat“Ó2“Öis“equal“to“ÓSUC‘¿ª1Ö.‘þAn“exampleŽ¡‘Çaof–ê¨a“negativ¬re“result“is:Ž¦‘$_Ó#IN_CONV–¿ªnum_EQ_CONV“"1“IN“{0,2,3}";;ŽŸ ™š‘$_|-–¿ª1“IN“{0,2,3}“=“FŽŸ†v‘ÇaÖFinally–²the“bSŽehaš¬rviour“of“the“supplied“con˜v˜ersion“is“irrelev‘ÿXäan˜t“when“the“v‘ÿXäalue“to“bSŽe“testedŽ¡‘Çafor–ê¨memš¬rbSŽership“is“alpha-equiv‘ÿXäalen˜t“to“an“actual“elemen˜t:Ž¦‘$_Ó#IN_CONV–¿ªNO_CONV“"1“IN“{3,2,1}";;ŽŸ ™š‘$_|-–¿ª1“IN“{3,2,1}“=“TŽŸ†v‘ÇaÖThe› žcon•¬rv“ersion˜ÓNO_CONV‘ •Öalw“a“ys˜fails,‘Ûbut˜ÓIN_CONV‘ •Öis˜non“theless˜able˜in˜this˜case˜to˜pro“v“eŽ¡‘Çathe–ê¨required“result.ŽŸ‘ÇaâF‘þž¸ailureŽŸ‚'‘ÇaÓIN_CONV›¿ªconv–ÀáÖfails“if“applied“to“a“term“that“is“not“of“the“form“Ó"t˜IN˜{t1,...,tn}"Ö.‘»ŒAŽ¡‘Çacall›fÓIN_CONV–¿ªconv“"t“IN“{t1,...,tn}"˜Öfails˜unless˜the˜term˜Ót˜Öis˜alpha-equiv‘ÿXäalen¬rt˜to˜someŽ¡‘ÇaÓtiÖ,‘öor›\Óconv–¿ª"t“=“ti"˜Öreturns˜Ó|-“(t“=“ti)“=“T‘ŒðÖfor˜some˜ÓtiÖ,‘öor˜Óconv“"t“=“ti"˜ÖreturnsŽ¡‘ÇaÓ|-–¿ª(t“=“ti)“=“F–ê¨Öfor“ev¬rery“ÓtiÖ.ŽŽŽŒ‹gÉ ÌU ýFÓŸú™š‘êñëÛ30’«[úChapter–€2.‘ €ML“F‘þàunctions“in“the“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKSET_INDUCT_TACŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0p‘êñëÓSET_INDUCT_TAC–¿ª:“tacticŽ¤•Œ‘êñëâSynopsisŽ©%c‘êñëÖT‘ÿVactic–ê¨for“induction“on“ nite“sets.Ž¡‘êñëâDescriptionŽ¦‘êñëÓSET_INDUCT_TAC‘:ÁÖis–:Õan“induction“tacic“for“pro¬rving“propSŽerties“of“ nite“sets.‘)hWhen“appliedŽ¤‘êñëto–ê¨a“goal“of“the“formŽŸ/&‘ü0éÓ!s.–¿ªFINITE“s“==>“P[s]ŽŸp)‘êñëSET_INDUCT_TAC‘+ÅÖreduces–+öthis“goal“to“proš¬rving“that“the“propSŽert˜y“Ó\s.P[s]“Öholds“of“the“empt˜yŽ¡‘êñëset–•¹and“is“preservš¬red“b˜y“insertion“of“an“elemen˜t“in˜to“an“arbitrary“ nite“set.‘:Since“ev˜eryŽ¡‘êñë nite–4tset“can“bSŽe“built“up“from“the“emptš¬ry“set“Ó"{}"“Öb˜y“repSŽeated“insertion“of“v‘ÿXäalues,‘FçtheseŽ¡‘êñësubgoals–ê¨imply“that“the“propSŽert¬ry“Ó\s.P[s]“Öholds“of“all“ nite“sets.Ž¦‘öSzThe–ê¨tactic“spSŽeci cation“of“ÓSET_INDUCT_TAC“Öis:ŽŸ/&‘L¬5ÓA–¿ª?-“!s.“FINITE“s“==>“PŽ¤ ™š‘ü0é==========================================================‘ TSET_INDUCT_TACŽ¡‘°=A–¿ª|-“P[{}/s]Ž¡‘°=A–¿ªu“{FINITE“s',“P[s'/s],“~e“IN“s'}“?-“P[e“INSERT“s'/s]ŽŸp)‘êñëÖwhere–ÞÓe“Öis“a“v‘ÿXäariable“c¬rhosen“so“as“not“to“appSŽear“free“in“the“assumptions“ÓAÖ,“and“Ós'“Öis“aŽ¤‘êñëprimed–ê¨v‘ÿXäarian¬rt“of“Ós“Öthat“došSŽes“not“app˜ear“free“in“ÓA“Ö(usually‘ÿV,“Ós'“Öis“just“ÓsÖ).ŽŸ•Œ‘êñëâF‘þž¸ailureŽ¦‘êñëÓSET_INDUCT_TAC›¿ª(A,g)–DNÖfails“unless“Óg“Öhas“the“form“Ó!s.˜FINITE˜s˜==>˜PÖ,“where“the“v‘ÿXäariableŽ¡‘êñëÓs–ê¨Öhas“tš¬rypSŽe“Ó(ty)set“Öfor“some“t˜ypSŽe“ÓtyÖ.ŽŸ*À¤Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKSET_SPEC_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0p‘êñëÓSET_SPEC_CONV–¿ª:“convŽŸ•Œ‘êñëâSynopsisŽ¦‘êñëÖAxiom-sc¬rheme–ê¨of“spSŽeci cation“for“set“abstractions.ŽŽŽŒ‹q@ ÌU ýFÓŸú™š‘ÇaÒUNION‘Ái‰ffÇŽ‘ˆ„CONV’c¦%Û31Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâDescriptionŽ¤‘ÇaÖThe›)Ýcon•¬rv“ersion˜ÓSET_SPEC_CONV‘)ÍÖexpSŽects˜its˜term˜argumen“t˜to˜bSŽe˜an˜assertion˜of˜the˜formŽ¡‘ÇaÓ"t–¿ªIN“{E“|“P}"Ö.‘€iGiv•¬ren›­+suc“h˜a˜term,‘ÝÌthe˜con“v“ersion˜returns˜a˜theorem˜that˜de nes˜theŽ¡‘Çacondition–5under“whicš¬rh“this“mem˜bSŽership“assertion“holds.‘yˆWhen“ÓE‘0Öis“just“a“v‘ÿXäariable“ÓvÖ,‘™theŽ¡‘Çacon•¬rv“ersion‘ê¨returns:Ž¤wú‘$_Ó|-–¿ªt“IN“{v“|“P}“=“P[t/v]Ž©Þ`‘ÇaÖand–ê¨when“ÓE“Öis“not“a“v‘ÿXäariable“but“some“other“expression,“the“theorem“returned“is:Ž¡‘$_Ó|-–¿ªt“IN“{E“|“P}“=“?x1...xn.“(t“=“E)“/\“PŽ¦‘ÇaÖwhere›!¯Óx1Ö,–oq...,“Óxn˜Öare˜the˜v‘ÿXäariables˜that˜o•SŽccur˜free˜b“oth˜in˜the˜expression˜ÓE‘!_Öand˜in˜theŽ©‘ÇapropSŽosition‘ê¨ÓPÖ.ŽŸ¼Á‘ÇaâExampleŽ¡‘ÇaÓ#SET_SPEC_CONV–¿ª"12“IN“{n“|“n“>“N}";;Ž¤ ™š‘Ça|-–¿ª12“IN“{n“|“n“>“N}“=“12“>“NŽŸ34‘Ça#SET_SPEC_CONV–¿ª"p“IN“{(n,m)“|“n“<“m}";;Ž¡‘Ça|-–¿ªp“IN“{(n,m)“|“n“<“m}“=“(?n“m.“(p“=“n,m)“/\“n“<“m)ŽŸ'›!‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖF‘ÿVails–ê¨if“applied“to“a“term“that“is“not“of“the“form“Ó"t–¿ªIN“{E“|“P}"Ö.ŽŸ(6BŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëKUNION_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.ãÚ‘ÇaÓUNION_CONV–¿ª:“conv“->“convŽ¤¼Á‘ÇaâSynopsisŽ¦‘ÇaÖReduce›ê¨Ó{t1,...,tn}–¿ªUNION“s˜Öto˜Ót1“INSERT“(...“(tn“INSERT“s))Ö.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖThe–Ê@function“ÓUNION_CONV‘ÉÅÖis“a“parameterized“con•¬rv“ersion–Ê@for“reducing“sets“of“the“formŽ¦‘ÇaÓ"{t1,...,tn}–¿ªUNION“s"Ö,‘¡‰where–IÂÓ{t1,...,tn}“Öand“Ós“Öare“sets“of“t¬rypSŽe“Ó(ty)setÖ.‘ V/The“ rstŽ¦‘Çaargumen¬rt–NMto“ÓUNION_CONV‘MòÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–NMthat“decides“equalit¬ry“b˜et•¬rw“eenŽ¦‘Çav‘ÿXäalues–of“the“base“tš¬rypSŽe“ÓtyÖ.‘×dGiv˜en“an“equation“Ó"e1–¿ª=“e2"Ö,‘l´where–Óe1“Öand“Óe2“Öare“termsŽ¦‘Çaof–Xñtš¬rypSŽe“ÓtyÖ,‘tƒthis“con˜v˜ersion“should“return“the“theorem“Ó|-–¿ª(e1“=“e2)“=“T‘XÔÖor–Xñthe“theoremŽ¦‘ÇaÓ|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.ŽŽŽŒ‹ xÁ ÌU ýFÓŸú™š‘êñëÛ32’«[úChapter–€2.‘ €ML“F‘þàunctions“in“the“sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖGiv•¬ren›5àsuc“h˜a˜con“v“ersion,‘ˆ®the˜function˜ÓUNION_CONV‘5‹Öreturns˜a˜con“v“ersion˜that˜maps˜aŽ¤‘êñëterm–ê¨of“the“form“Ó"{t1,...,tn}–¿ªUNION“s"–ê¨Öto“the“theoremŽŸ™š‘ü0éÓ|-–¿ªt“UNION“{t1,...,tn}“=“ti“INSERT“...“(tj“INSERT“s)Ž©‘êñëÖwhere–ËÓ{ti,...,tj}“Öis“the“set“of“all“terms“Ót“Öthat“oSŽccur“as“elemen¬rts“of“Ó{t1,...,tn}“ÖforŽ¡‘êñëwhicš¬rh–oÎthe“con˜v˜ersion“ÓIN_CONV‘¿ªconv“Öfails“to“pro˜v˜e“that“Ó|-–¿ª(t“IN“s)“=“T‘o¯Ö(that–oÎis,‘ˆ`either“b˜yŽ¡‘êñëpro¬rving›ê¨Ó|-–¿ª(t“IN“s)“=“F˜Öinstead,˜or˜b•¬ry˜failing˜outrigh“t).Ž¦‘êñëâExampleŽ¡‘êñëÖIn–vthe“follo¬rwing“example,‘hÓnum_EQ_CONV›uûÖis“supplied“as“a“parameter“to“ÓUNION_CONV˜Öand“usedŽ¡‘êñëto–)#test“for“memš¬rbSŽership“of“eac˜h“elemen˜t“of“the“ rst“ nite“set“Ó{1,2,3}“Öof“the“union“in“theŽ¡‘êñësecond–ê¨ nite“set“Ó{SUC‘¿ª0,3,4}Ö.ŽŸ™š‘ü0éÓ#UNION_CONV–¿ªnum_EQ_CONV“"{1,2,3}“UNION“{SUC“0,3,4}";;ŽŸ ™š‘ü0é|-–¿ª{1,2,3}“UNION“{SUC“0,3,4}“=“{2,SUC“0,3,4}Ž¦‘êñëÖThe–j7result“is“Ó{2,SUC›¿ª0,3,4}Ö,‘ƒçrather“than“Ó{1,2,SUC˜0,3,4}Ö,‘ƒçbSŽecause“ÓUNION_CONV‘jÖis“able“b¬ryŽ¡‘êñëmeans–ê¨of“a“call“toŽŸ™š‘ü0éÓIN_CONV–¿ªnum_EQ_CONV“"1“IN“{SUC“0,3,4}"Ž¦‘êñëÖto›ê¨pro•¬rv“e˜that˜Ó1˜Öis˜already˜an˜elemen“t˜of˜the˜set˜Ó{SUC‘¿ª0,3,4}Ö.Ž¡‘öSzThe›Ýïcon•¬rv“ersion˜supplied˜to˜ÓUNION_CONV‘ÝëÖneed˜not˜actually˜pro“v“e˜equalit“y˜of˜elemen“ts,‘àzifŽ¡‘êñësimpli cation–ê¨of“the“resulting“set“is“not“desired.‘8àF‘ÿVor“example:ŽŸ™š‘ü0éÓ#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“{SUC“0,3,4}";;ŽŸ ™š‘ü0é|-–¿ª{1,2,3}“UNION“{SUC“0,3,4}“=“{1,2,SUC“0,3,4}Ž¦‘êñëÖIn–£Êthis“case,›±öthe“resulting“set“is“just“left“unsimpli ed.‘!AMoreo•¬rv“er,˜the–£Êsecond“set“argumen¬rtŽ¡‘êñëto–ê¨ÓUNION“Öneed“not“bSŽe“a“ nite“set:ŽŸ™š‘ü0éÓ#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“s";;ŽŸ ™š‘ü0é|-–¿ª{1,2,3}“UNION“s“=“1“INSERT“(2“INSERT“(3“INSERT“s))Ž¦‘êñëÖAnd,–ê¨of“course,“in“this“case“the“con•¬rv“ersion›ê¨argumen“t˜to˜ÓUNION_CONV˜Öis˜irrelev‘ÿXäan“t.Ž¦‘êñëâF‘þž¸ailureŽ¡‘êñëÓUNION_CONV›¿ªconv–ê¨Öfails“if“applied“to“a“term“not“of“the“form“Ó"{t1,...,tn}˜UNION˜s"Ö.Ž¦‘êñëâSee‘…alsoŽŸ ™š‘êñëÓIN_CONV.ŽŽŽŒ‹!€ñ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…3Ž‘ÇaŸ Ì̉Ç>|ŸGëHPre-pro–ÿ4‰v“ed‘ ‰‹TheoremsŽŸÖx‰Ç>|Ÿ:UTÖThe–jšsections“that“follo¬rw“list“all“theorems“in“the“ÓsetsŽ‘ÓÜÖlibrary‘ÿV,‘Š—including“de nitions.‘¸·TheŽ¤theorems–×6are“groupSŽed“in¬rto“sections“according“to“sub‘§ject“matter.‘þŠSome“theorems“couldŽ¡bSŽe–Æclassi ed“under“more“than“one“sub‘§ject,‘ÍÆbut“eac¬rh“theorem“is“listed“in“only“one“section.Ž¡The– reader“maš¬ry“therefore“ha˜v˜e“to“consult“more“than“one“section“when“searc˜hing“for“an˜yŽ¡particular‘ê¨theorem.Ž¡‘ aWhen–®Äthe“ÓsetsŽ‘"\0Ölibrary“is“loaded,‘Ëall“the“theorems“listed“in“this“c¬rhapter“(includingŽ¡de nitions)–ê¨are“set“up“to“autoload“when“their“names“are“men¬rtioned“in“ÍMLÖ.Ž©(Vç3.1Ž‘-C„The–Ÿ¼t‘ÿr°yp‘Oe“de nitionŽŸ'C²Óset_ISO_DEF‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘9óÓ|-–¿ª(!a.“SPEC(CHF“a)“=“a)“/\“(!r.“(\p.“T)r“=“(CHF(SPEC“r)“=“r))ŽŸaset_TY_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘9óÓ|-–¿ª?rep.“TYPE_DEFINITION(\p.“T)repŽ¦ç3.2Ž‘-C„Mem–ÿr°b‘Oership,›Ÿ¼equalit“y‘þX,˜and˜set˜sp‘Oeci cationsŽŸ'C²ÓEXTENSION‘ ¿øÖ(ÓsetsÖ)Ž¡‘9óÓ|-–¿ª!s“t.“(s“=“t)“=“(!x.“x“IN“s“=“x“IN“t)Ž©aGSPECIFICATION‘ ¿øÖ(ÓsetsÖ)Ž¡‘9óÓ|-–¿ª!f“v.“v“IN“(GSPEC“f)“=“(?x.“v,T“=“f“x)Ž¦GSPEC_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘9óÓ|-–¿ª!f.“GSPEC“f“=“SPEC(\y.“?x.“y,T“=“f“x)Ž¦IN_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘9óÓ|-–¿ª!x“s.“x“IN“s“=“CHF“s“xŽ¦NOT_EQUAL_SETS‘ ¿øÖ(ÓsetsÖ)Ž¡‘9óÓ|-–¿ª!s“t.“~(s“=“t)“=“(?x.“x“IN“t“=“~x“IN“s)ŽŽŸ$ý’烈Û33ŽŽŒ‹"‰Õ ÌU ýFÓŸú™š‘êñëÛ34’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓNUM_SET_WOP‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s.“(?n.“n“IN“s)“=“(?n.“n“IN“s“/\“(!m.“m“IN“s“==>“n“<=“m))Ž©a‘êñëSET_MINIMUM‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“M.“(?x.“x“IN“s)“=“(?x.“x“IN“s“/\“(!y.“y“IN“s“==>“(M“x)“<=“(M“y)))Ž¦‘êñëSPECIFICATION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!P“x.“x“IN“(SPEC“P)“=“P“xŽŸ(V‘êñëç3.3Ž‘5oThe–Ÿ¼empt›ÿr°y“and“univ˜ersal“setsŽŸ'C²‘êñëÓEMPTY_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª{}“=“SPEC(\x.“F)Ž¦‘êñëEMPTY_NOT_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª~({}“=“UNIV)Ž¦‘êñëEQ_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!x.“x“IN“s)“=“(s“=“UNIV)Ž¦‘êñëIN_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“x“IN“UNIVŽ¦‘êñëMEMBER_NOT_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“(?x.“x“IN“s)“=“~(s“=“{})Ž¦‘êñëNOT_IN_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“~x“IN“{}Ž¦‘êñëUNIV_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ªUNIV“=“SPEC(\x.“T)Ž¦‘êñëUNIV_NOT_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª~(UNIV“=“{})ŽŸ(V‘êñëç3.4Ž‘5oSet‘Ÿ¼inclusionŽŸ'C²‘êñëÓEMPTY_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“{}“SUBSET“sŽ¦‘êñëNOT_PSUBSET_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“~s“PSUBSET“{}ŽŽŽŒ‹#­ ÌU ýFÓŸú™š‘ÇaÛ3.5.‘ €In tersection–€and“union’ÞÖ35Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓNOT_UNIV_PSUBSET‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-–¿ª!s.“~UNIV“PSUBSET“sŽ©a‘ÇaPSUBSET_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“PSUBSET“t“=“s“SUBSET“t“/\“~(s“=“t)Ž¦‘ÇaPSUBSET_IRREFL‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“~s“PSUBSET“sŽ¦‘ÇaPSUBSET_MEMBER‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“PSUBSET“t“=“s“SUBSET“t“/\“(?y.“y“IN“t“/\“~y“IN“s)Ž¦‘ÇaPSUBSET_TRANS‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“s“PSUBSET“t“/\“t“PSUBSET“u“==>“s“PSUBSET“uŽ¦‘ÇaPSUBSET_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“PSUBSET“UNIV“=“(?x.“~x“IN“s)Ž¦‘ÇaSUBSET_ANTISYM‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“SUBSET“t“/\“t“SUBSET“s“==>“(s“=“t)Ž¦‘ÇaSUBSET_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“SUBSET“t“=“(!x.“x“IN“s“==>“x“IN“t)Ž¦‘ÇaSUBSET_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“SUBSET“{}“=“(s“=“{})Ž¦‘ÇaSUBSET_REFL‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“SUBSET“sŽ¦‘ÇaSUBSET_TRANS‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“s“SUBSET“t“/\“t“SUBSET“u“==>“s“SUBSET“uŽ¦‘ÇaSUBSET_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“SUBSET“UNIVŽ¦‘ÇaUNIV_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“UNIV“SUBSET“s“=“(s“=“UNIV)ŽŸ(V‘Çaç3.5Ž‘@ åIn‘ÿr°tersection–Ÿ¼and“unionŽŸ'C²‘ÇaÓEMPTY_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“(s“UNION“t“=“{})“=“(s“=“{})“/\“(t“=“{})ŽŽŽŒ‹$”> ÌU ýFÓŸú™š‘êñëÛ36’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓINTER_ASSOC‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s“t“u.“(s“INTER“t)“INTER“u“=“s“INTER“(t“INTER“u)Ž©OÇ‘êñëINTER_COMM‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“INTER“t“=“t“INTER“sŽ¦‘êñëINTER_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“INTER“t“=“{x“|“x“IN“s“/\“x“IN“t}Ž¦‘êñëINTER_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!s.“{}“INTER“s“=“{})“/\“(!s.“s“INTER“{}“=“{})Ž¦‘êñëINTER_IDEMPOT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“s“INTER“s“=“sŽ¦‘êñëINTER_OVER_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“u.“s“UNION“(t“INTER“u)“=“(s“UNION“t)“INTER“(s“UNION“u)Ž¦‘êñëINTER_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!s“t.“(s“INTER“t)“SUBSET“s)“/\“(!s“t.“(t“INTER“s)“SUBSET“s)Ž¦‘êñëINTER_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!s.“UNIV“INTER“s“=“s)“/\“(!s.“s“INTER“UNIV“=“s)Ž¦‘êñëIN_INTER‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“x.“x“IN“(s“INTER“t)“=“x“IN“s“/\“x“IN“tŽ¦‘êñëIN_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“x.“x“IN“(s“UNION“t)“=“x“IN“s“\/“x“IN“tŽ¦‘êñëSUBSET_INTER_ABSORPTION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“SUBSET“t“=“(s“INTER“t“=“s)Ž¦‘êñëSUBSET_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!s“t.“s“SUBSET“(s“UNION“t))“/\“(!s“t.“s“SUBSET“(t“UNION“s))Ž¦‘êñëSUBSET_UNION_ABSORPTION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“SUBSET“t“=“(s“UNION“t“=“t)Ž¦‘êñëUNION_ASSOC‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“u.“(s“UNION“t)“UNION“u“=“s“UNION“(t“UNION“u)Ž¦‘êñëUNION_COMM‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“UNION“t“=“t“UNION“sŽ¦‘êñëUNION_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“UNION“t“=“{x“|“x“IN“s“\/“x“IN“t}ŽŽŽŒ‹%™u ÌU ýFÓŸú™š‘ÇaÛ3.6.‘ Set‘€di erence’K·a37Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓUNION_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-–¿ª(!s.“{}“UNION“s“=“s)“/\“(!s.“s“UNION“{}“=“s)Ž©a‘ÇaUNION_IDEMPOT‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“UNION“s“=“sŽ¦‘ÇaUNION_OVER_INTER‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“s“INTER“(t“UNION“u)“=“(s“INTER“t)“UNION“(s“INTER“u)Ž¦‘ÇaUNION_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª(!s.“UNIV“UNION“s“=“UNIV)“/\“(!s.“s“UNION“UNIV“=“UNIV)ŽŸ(V‘Çaç3.6Ž‘@ åSet‘Ÿ¼di erenceŽŸ'C²‘ÇaÓDIFF_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“DIFF“t“=“{x“|“x“IN“s“/\“~x“IN“t}Ž¦‘ÇaDIFF_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“(s“DIFF“t)“DIFF“t“=“s“DIFF“tŽ¦‘ÇaDIFF_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“DIFF“{}“=“sŽ¦‘ÇaDIFF_EQ_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“DIFF“s“=“{}Ž¦‘ÇaDIFF_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“DIFF“UNIV“=“{}Ž¦‘ÇaEMPTY_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“{}“DIFF“s“=“{}Ž¦‘ÇaIN_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“x.“x“IN“(s“DIFF“t)“=“x“IN“s“/\“~x“IN“tŽŸ(V‘Çaç3.7Ž‘@ åDisjoin‘ÿr°t‘Ÿ¼setsŽŸ'C²‘ÇaÓDISJOINT_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“DISJOINT“s“t“=“(s“INTER“t“=“{})Ž¦‘ÇaDISJOINT_DELETE_SYM‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“x.“DISJOINT(s“DELETE“x)t“=“DISJOINT(t“DELETE“x)sŽŽŽŒ‹&Ÿš ÌU ýFÓŸú™š‘êñëÛ38’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓDISJOINT_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s.“DISJOINT“{}“s“/\“DISJOINT“s“{}Ž©a‘êñëDISJOINT_EMPTY_REFL‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“(s“=“{})“=“DISJOINT“s“sŽ¦‘êñëDISJOINT_SYM‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“DISJOINT“s“t“=“DISJOINT“t“sŽ¦‘êñëDISJOINT_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“u.“DISJOINT(s“UNION“t)u“=“DISJOINT“s“u“/\“DISJOINT“t“uŽ¦‘êñëIN_DISJOINT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“DISJOINT“s“t“=“~(?x.“x“IN“s“/\“x“IN“t)ŽŸ(V‘êñëç3.8Ž‘5oInsertion–Ÿ¼and“deletion“of“an“elemen‘ÿr°tŽŸ'C²‘êñëÓABSORPTION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“x“IN“s“=“(x“INSERT“s“=“s)Ž¦‘êñëCOMPONENT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“x“IN“(x“INSERT“s)Ž¦‘êñëDECOMPOSITION‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x.“x“IN“s“=“(?t.“(s“=“x“INSERT“t)“/\“~x“IN“t)Ž¦‘êñëDELETE_COMM‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y“s.“(s“DELETE“x)“DELETE“y“=“(s“DELETE“y)“DELETE“xŽ¦‘êñëDELETE_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x.“s“DELETE“x“=“s“DIFF“{x}Ž¦‘êñëDELETE_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“(s“DELETE“x)“DELETE“x“=“s“DELETE“xŽ¦‘êñëDELETE_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y“s.Ž¡‘*†(x–¿ªINSERT“s)“DELETE“y“=Ž¡‘*†((x–¿ª=“y)“=>“s“DELETE“y“|“x“INSERT“(s“DELETE“y))Ž¦‘êñëDELETE_INTER‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“x.“(s“DELETE“x)“INTER“t“=“(s“INTER“t)“DELETE“xŽ¦‘êñëDELETE_NON_ELEMENT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~x“IN“s“=“(s“DELETE“x“=“s)ŽŽŽŒ‹'¤ ÌU ýFÓŸú™š‘ÇaÛ3.8.‘ €Insertion–€and“deletion“of“an“elemen t’ÃËJ39Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓDELETE_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-–¿ª!x“s.“(s“DELETE“x)“SUBSET“sŽ©6‘ÇaDIFF_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“x.“s“DIFF“(x“INSERT“t)“=“(s“DELETE“x)“DIFF“tŽ¦‘ÇaDISJOINT_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.“DISJOINT(x“INSERT“s)t“=“DISJOINT“s“t“/\“~x“IN“tŽ¦‘ÇaEMPTY_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“{}“DELETE“x“=“{}Ž¦‘ÇaINSERT_COMM‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“y“s.“x“INSERT“(y“INSERT“s)“=“y“INSERT“(x“INSERT“s)Ž¦‘ÇaINSERT_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s.“x“INSERT“s“=“{y“|“(y“=“x)“\/“y“IN“s}Ž¦‘ÇaINSERT_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s.“x“IN“s“==>“(x“INSERT“(s“DELETE“x)“=“s)Ž¦‘ÇaINSERT_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t“x.Ž¡‘7ÿü(x–¿ªINSERT“s)“DIFF“t“=“(x“IN“t“=>“s“DIFF“t“|“x“INSERT“(s“DIFF“t))Ž¦‘ÇaINSERT_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s.“x“INSERT“(x“INSERT“s)“=“x“INSERT“sŽ¦‘ÇaINSERT_INTER‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.Ž¡‘7ÿü(x–¿ªINSERT“s)“INTER“t“=“(x“IN“t“=>“x“INSERT“(s“INTER“t)“|“s“INTER“t)Ž¦‘ÇaINSERT_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.“(x“INSERT“s)“SUBSET“t“=“x“IN“t“/\“s“SUBSET“tŽ¦‘ÇaINSERT_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.Ž¡‘7ÿü(x–¿ªINSERT“s)“UNION“t“=“(x“IN“t“=>“s“UNION“t“|“x“INSERT“(s“UNION“t))Ž¦‘ÇaINSERT_UNION_EQ‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.“(x“INSERT“s)“UNION“t“=“x“INSERT“(s“UNION“t)Ž¦‘ÇaINSERT_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“x“INSERT“UNIV“=“UNIVŽ¦‘ÇaIN_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“x“y.“x“IN“(s“DELETE“y)“=“x“IN“s“/\“~(x“=“y)ŽŽŽŒ‹(ªU ÌU ýFÓŸú™š‘êñëÛ40’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓIN_DELETE_EQ‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s“x“x'.Ž¡‘*†(x–¿ªIN“s“=“x'“IN“s)“=“(x“IN“(s“DELETE“x')“=“x'“IN“(s“DELETE“x))Ž©a‘êñëIN_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y“s.“x“IN“(y“INSERT“s)“=“(x“=“y)“\/“x“IN“sŽ¦‘êñëNOT_EMPTY_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~({}“=“x“INSERT“s)Ž¦‘êñëNOT_INSERT_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~(x“INSERT“s“=“{})Ž¦‘êñëPSUBSET_INSERT_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“PSUBSET“t“=“(?x.“~x“IN“s“/\“(x“INSERT“s)“SUBSET“t)Ž¦‘êñëSET_CASES‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“(s“=“{})“\/“(?x“t.“(s“=“x“INSERT“t)“/\“~x“IN“t)Ž¦‘êñëSUBSET_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.“s“SUBSET“(t“DELETE“x)“=“~x“IN“s“/\“s“SUBSET“tŽ¦‘êñëSUBSET_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~x“IN“s“==>“(!t.“s“SUBSET“(x“INSERT“t)“=“s“SUBSET“t)Ž¦‘êñëSUBSET_INSERT_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.“s“SUBSET“(x“INSERT“t)“=“(s“DELETE“x)“SUBSET“tŽŸ(V‘êñëç3.9Ž‘5oThe–Ÿ¼ëICHOICE“çand“ëIREST“çfunctionsŽŸ'C²‘êñëÓCHOICE_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“~(s“=“{})“==>“(CHOICE“s)“IN“sŽ¦‘êñëCHOICE_INSERT_REST‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“~(s“=“{})“==>“((CHOICE“s)“INSERT“(REST“s)“=“s)Ž¦‘êñëCHOICE_NOT_IN_REST‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“~(CHOICE“s)“IN“(REST“s)Ž¦‘êñëCHOICE_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“CHOICE{x}“=“xŽ¦‘êñëREST_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“REST“s“=“s“DELETE“(CHOICE“s)ŽŽŽŒ‹)°Ÿ ÌU ýFÓŸú™š‘ÇaÛ3.10.‘ €Image–€of“a“function“on“a“set’íbe41Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓREST_PSUBSET‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-–¿ª!s.“~(s“=“{})“==>“(REST“s)“PSUBSET“sŽ©a‘ÇaREST_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“REST{x}“=“{}Ž¦‘ÇaREST_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“(REST“s)“SUBSET“sŽ¦‘ÇaSING_IFF_EMPTY_REST‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“SING“s“=“~(s“=“{})“/\“(REST“s“=“{})ŽŸ(V‘Çaç3.10Ž‘IúImage–Ÿ¼of“a“function“on“a“setŽŸ'C²‘ÇaÓIMAGE_COMPOSE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f“g“s.“IMAGE(f“o“g)s“=“IMAGE“f(IMAGE“g“s)Ž¦‘ÇaIMAGE_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f“s.“IMAGE“f“s“=“{f“x“|“x“IN“s}Ž¦‘ÇaIMAGE_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f“x“s.“~x“IN“s“==>“(IMAGE“f(s“DELETE“x)“=“IMAGE“f“s)Ž¦‘ÇaIMAGE_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f.“IMAGE“f{}“=“{}Ž¦‘ÇaIMAGE_EQ_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“f.“(IMAGE“f“s“=“{})“=“(s“=“{})Ž¦‘ÇaIMAGE_ID‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“IMAGE(\x.“x)s“=“sŽ¦‘ÇaIMAGE_IN‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“s.“x“IN“s“==>“(!f.“(f“x)“IN“(IMAGE“f“s))Ž¦‘ÇaIMAGE_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f“x“s.“IMAGE“f(x“INSERT“s)“=“(f“x)“INSERT“(IMAGE“f“s)Ž¦‘ÇaIMAGE_INTER‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.“(IMAGE“f(s“INTER“t))“SUBSET“((IMAGE“f“s)“INTER“(IMAGE“f“t))Ž¦‘ÇaIMAGE_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“SUBSET“t“==>“(!f.“(IMAGE“f“s)“SUBSET“(IMAGE“f“t))ŽŽŽŒ‹*¶u ÌU ýFÓŸú™š‘êñëÛ42’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓIMAGE_UNION‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!f“s“t.“IMAGE“f(s“UNION“t)“=“(IMAGE“f“s)“UNION“(IMAGE“f“t)Ž©a‘êñëIN_IMAGE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!y“s“f.“y“IN“(IMAGE“f“s)“=“(?x.“(y“=“f“x)“/\“x“IN“s)ŽŸ(V‘êñëç3.11Ž‘"% Mappings›Ÿ¼b‘Oet–ÿr°w“een˜setsŽŸ'C²‘êñëÓBIJ_COMPOSE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“g“s“t“u.“BIJ“f“s“t“/\“BIJ“g“t“u“==>“BIJ(g“o“f)s“uŽ¦‘êñëBIJ_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.“BIJ“f“s“t“=“INJ“f“s“t“/\“SURJ“f“s“tŽ¦‘êñëBIJ_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f.“(!s.“BIJ“f{}s“=“(s“=“{}))“/\“(!s.“BIJ“f“s{}“=“(s“=“{}))Ž¦‘êñëBIJ_ID‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“BIJ(\x.“x)s“sŽ¦‘êñëIMAGE_SURJ‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.“SURJ“f“s“t“=“(IMAGE“f“s“=“t)Ž¦‘êñëINJ_COMPOSE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“g“s“t“u.“INJ“f“s“t“/\“INJ“g“t“u“==>“INJ(g“o“f)s“uŽ¦‘êñëINJ_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.Ž¡‘*†INJ–¿ªf“s“t“=Ž¡‘*†(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘*†(!x–¿ªy.“x“IN“s“/\“y“IN“s“==>“(f“x“=“f“y)“==>“(x“=“y))Ž¦‘êñëINJ_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f.“(!s.“INJ“f{}s)“/\“(!s.“INJ“f“s{}“=“(s“=“{}))Ž¦‘êñëINJ_ID‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“INJ(\x.“x)s“sŽ¦‘êñëLINV_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.“INJ“f“s“t“==>“(!x.“x“IN“s“==>“(LINV“f“s(f“x)“=“x))Ž¦‘êñëRINV_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.“SURJ“f“s“t“==>“(!x.“x“IN“t“==>“(f(RINV“f“s“x)“=“x))ŽŽŽŒ‹+»Û ÌU ýFÓŸú™š‘ÇaÛ3.12.‘ €Singleton‘€sets’BN43Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓSURJ_COMPOSE‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-–¿ª!f“g“s“t“u.“SURJ“f“s“t“/\“SURJ“g“t“u“==>“SURJ(g“o“f)s“uŽ©a‘ÇaSURJ_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.Ž¡‘7ÿüSURJ–¿ªf“s“t“=Ž¡‘7ÿü(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘7ÿü(!x.–¿ªx“IN“t“==>“(?y.“y“IN“s“/\“(f“y“=“x)))Ž¦‘ÇaSURJ_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!f.“(!s.“SURJ“f{}s“=“(s“=“{}))“/\“(!s.“SURJ“f“s{}“=“(s“=“{}))Ž¦‘ÇaSURJ_ID‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“SURJ(\x.“x)s“sŽŸ(V‘Çaç3.12Ž‘IúSingleton‘Ÿ¼setsŽŸ'C²‘ÇaÓDELETE_EQ_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“x.“x“IN“s“==>“((s“DELETE“x“=“{})“=“(s“=“{x}))Ž¦‘ÇaDISJOINT_SING_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“DISJOINT{x}{}Ž¦‘ÇaEQUAL_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“y.“({x}“=“{y})“=“(x“=“y)Ž¦‘ÇaFINITE_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“FINITE{x}Ž¦‘ÇaINSERT_SING_UNION‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“x.“x“INSERT“s“=“{x}“UNION“sŽ¦‘ÇaIN_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x“y.“x“IN“{y}“=“(x“=“y)Ž¦‘ÇaNOT_EMPTY_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“~({}“=“{x})Ž¦‘ÇaNOT_SING_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“~({x}“=“{})Ž¦‘ÇaSING‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!x.“SING{x}ŽŽŽŒ‹,Á„ ÌU ýFÓŸú™š‘êñëÛ44’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓSING_DEF‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s.“SING“s“=“(?x.“s“=“{x})Ž©a‘êñëSING_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“{x}“DELETE“x“=“{}Ž¦‘êñëSING_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“SING“s“==>“FINITE“sŽŸ(V‘êñëç3.13Ž‘"% Finite–Ÿ¼and“in nite“setsŽŸ'C²‘êñëÓFINITE_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!s.Ž¡‘*†FINITE–¿ªs“=“(!P.“P{}“/\“(!s'.“P“s'“==>“(!e.“P(e“INSERT“s')))“==>“P“s)Ž¦‘êñëFINITE_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“FINITE(s“DELETE“x)“=“FINITE“sŽ¦‘êñëFINITE_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“FINITE“s“==>“(!t.“FINITE(s“DIFF“t))Ž¦‘êñëFINITE_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ªFINITE{}Ž¦‘êñëFINITE_INDUCT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!P.Ž¡‘*†P{}–¿ª/\“(!s.“FINITE“s“/\“P“s“==>“(!e.“~e“IN“s“==>“P(e“INSERT“s)))“==>Ž¡‘*†(!s.–¿ªFINITE“s“==>“P“s)Ž¦‘êñëFINITE_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“FINITE(x“INSERT“s)“=“FINITE“sŽ¦‘êñëFINITE_ISO_NUM‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!s.Ž¡‘*†FINITE–¿ªs“==>Ž¡‘*†(?f.Ž¡‘©Ú(!n–¿ªm.“n“<“(CARD“s)“/\“m“<“(CARD“s)“==>“(f“n“=“f“m)“==>“(n“=“m))“/\Ž¡‘©Ú(s–¿ª=“{f“n“|“n“<“(CARD“s)}))Ž¦‘êñëFINITE_PSUBSET_INFINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“INFINITE“s“=“(!t.“FINITE“t“==>“t“SUBSET“s“==>“t“PSUBSET“s)Ž¦‘êñëFINITE_PSUBSET_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ªINFINITE“UNIV“=“(!s.“FINITE“s“==>“s“PSUBSET“UNIV)ŽŽŽŒ‹-ÆQ ÌU ýFÓŸú™š‘ÇaÛ3.13.‘ Finite–€and“in nite“sets’ù45Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓFINITE_UNION‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-–¿ª!s“t.“FINITE(s“UNION“t)“=“FINITE“s“/\“FINITE“tŽ©a‘ÇaIMAGE_11_INFINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-‘¿ª!f.Ž¡‘7ÿü(!x–¿ªy.“(f“x“=“f“y)“==>“(x“=“y))“==>Ž¡‘7ÿü(!s.–¿ªINFINITE“s“==>“INFINITE(IMAGE“f“s))Ž¦‘ÇaIMAGE_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“FINITE“s“==>“(!f.“FINITE(IMAGE“f“s))Ž¦‘ÇaINFINITE_DEF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“INFINITE“s“=“~FINITE“sŽ¦‘ÇaINFINITE_DIFF_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“INFINITE“s“/\“FINITE“t“==>“~(s“DIFF“t“=“{})Ž¦‘ÇaINFINITE_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“INFINITE“s“==>“(!t.“s“SUBSET“t“==>“INFINITE“t)Ž¦‘ÇaINFINITE_UNIV‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ªINFINITE“(UNIV:(*)set)“=Ž¡‘2@R(?f:*->*.–¿ª(!x“y.“(f“x“=“f“y)“==>“(x“=“y))“/\“(?y.“!x.“~(f“x“=“y)))Ž¦‘ÇaINTER_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“FINITE“s“==>“(!t.“FINITE(s“INTER“t))Ž¦‘ÇaIN_INFINITE_NOT_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“INFINITE“s“/\“FINITE“t“==>“(?x.“x“IN“s“/\“~x“IN“t)Ž¦‘ÇaNOT_IN_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ªINFINITE“UNIV“=“(!s.“FINITE“s“==>“(?x.“~x“IN“s))Ž¦‘ÇaPSUBSET_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“FINITE“s“==>“(!t.“t“PSUBSET“s“==>“FINITE“t)Ž¦‘ÇaSUBSET_FINITE‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“FINITE“s“==>“(!t.“t“SUBSET“s“==>“FINITE“t)ŽŽŽŒ‹.ËÙ ÌU ýFÓŸú™š‘êñëÛ46’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç3.14Ž‘"% Cardinalit‘ÿr°y–Ÿ¼of“setsŽŸ'C²‘êñëÓCARD_DEF‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª(CARD{}“=“0)“/\Ž¡‘ jÜ(!s.Ž¡‘ê0FINITE–¿ªs“==>Ž¡‘ê0(!x.–¿ªCARD(x“INSERT“s)“=“(x“IN“s“=>“CARD“s“|“SUC(CARD“s))))Ž©a‘êñëCARD_DELETE‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!s.Ž¡‘*†FINITE–¿ªs“==>Ž¡‘*†(!x.–¿ªCARD(s“DELETE“x)“=“(x“IN“s“=>“(CARD“s)“-“1“|“CARD“s))Ž¦‘êñëCARD_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!t.Ž¡‘*†FINITE–¿ªt“==>Ž¡‘*†(!s.–¿ªFINITE“s“==>“(CARD(s“DIFF“t)“=“(CARD“s)“-“(CARD(s“INTER“t))))Ž¦‘êñëCARD_EMPTY‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ªCARD{}“=“0Ž¦‘êñëCARD_EQ_0‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“FINITE“s“==>“((CARD“s“=“0)“=“(s“=“{}))Ž¦‘êñëCARD_INSERT‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!s.Ž¡‘*†FINITE–¿ªs“==>Ž¡‘*†(!x.–¿ªCARD(x“INSERT“s)“=“(x“IN“s“=>“CARD“s“|“SUC(CARD“s)))Ž¦‘êñëCARD_INTER_LESS_EQ‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“FINITE“s“==>“(!t.“(CARD(s“INTER“t))“<=“(CARD“s))Ž¦‘êñëCARD_PSUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“FINITE“s“==>“(!t.“t“PSUBSET“s“==>“(CARD“t)“<“(CARD“s))Ž¦‘êñëCARD_SING‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“CARD{x}“=“1Ž¦‘êñëCARD_SUBSET‘ ¿øÖ(ÓsetsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“FINITE“s“==>“(!t.“t“SUBSET“s“==>“(CARD“t)“<=“(CARD“s))ŽŽŽŒ‹/Ñ> ÌU ýFÓŸú™š‘ÇaÛ3.14.‘ €Cardinalit y–€of“sets’&ë¢47Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓCARD_UNION‘ ¿øÖ(ÓsetsÖ)Ž¤ ™š‘!TÓ|-‘¿ª!s.Ž¡‘7ÿüFINITE–¿ªs“==>Ž¡‘7ÿü(!t.Ž¡‘CPFINITE–¿ªt“==>Ž¡‘CP((CARD(s–¿ªUNION“t))“+“(CARD(s“INTER“t))“=“(CARD“s)“+“(CARD“t)))Ž©a‘ÇaLESS_CARD_DIFF‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-‘¿ª!t.Ž¡‘7ÿüFINITE–¿ªt“==>Ž¡‘7ÿü(!s.–¿ªFINITE“s“==>“(CARD“t)“<“(CARD“s)“==>“0“<“(CARD(s“DIFF“t)))Ž¦‘ÇaSING_IFF_CARD1‘ ¿øÖ(ÓsetsÖ)Ž¡‘!TÓ|-–¿ª!s.“SING“s“=“(CARD“s“=“1)“/\“FINITE“sŽŽŽŒ‹0ÖG ÌU ýFÓŸú™š‘êñëÛ48’ðD,Chapter›€3.‘ €Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹1Øs ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸGëHReferencesŽŸ‰Ç>|Ÿ;‘ßüÖ[1]ŽŽ‘' Univ•¬rersit“y–‚3of“Cam¬rbridge“Computer“LabSŽoratory‘ÿV,‘—ÙThe‘Ó2HOL‘ÓSystem:‘6gDESCRIPTIONÖ,ŽŸ‘' revised–ê¨edition,“1991.ŽŽŸ$ý’烈Û49ŽŽŒ‹2Ù ÌU ýFÓ ”/ß ýáä‘êñ럳¸ä‰Ç>|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘êñëÜABSORPTIONÖ,‘ê¨38Ž¤(Ý‘êñëaxiom–ê¨of“extension,“2Ž¡‘êñëaxiom–ê¨of“spSŽeci cation,“2Ž¡‘þñëfor–ê¨generalized“set“spSŽeci cations,“3Ž¡‘þñëfor–ê¨set“abstractions,“5Ž©Ñè‘êñëÜBIJ_COMPOSEÖ,‘ê¨42Ž¡‘êñëÜBIJ_DEFÖ,–ê¨17,“42Ž¡‘êñëÜBIJ_EMPTYÖ,‘ê¨42Ž¡‘êñëÜBIJ_IDÖ,‘ê¨42Ž¦‘êñëÜCARD_DEFÖ,–ê¨19,“46Ž¡‘êñëÜCARD_DELETEÖ,‘ê¨46Ž¡‘êñëÜCARD_DIFFÖ,‘ê¨46Ž¡‘êñëÜCARD_EMPTYÖ,‘ê¨46Ž¡‘êñëÜCARD_EQ_0Ö,‘ê¨46Ž¡‘êñëÜCARD_INSERTÖ,‘ê¨46Ž¡‘êñëÜCARD_INTER_LESS_EQÖ,‘ê¨46Ž¡‘êñëÜCARD_PSUBSETÖ,‘ê¨46Ž¡‘êñëÜCARD_SINGÖ,–ê¨19,“46Ž¡‘êñëÜCARD_SUBSETÖ,‘ê¨46Ž¡‘êñëÜCARD_UNIONÖ,‘ê¨47Ž¡‘êñëÜCHFÖ,‘ê¨1Ž¡‘êñëÜCHOICE_DEFÖ,–ê¨14,“40Ž¡‘êñëÜCHOICE_INSERT_RESTÖ,‘ê¨40Ž¡‘êñëÜCHOICE_NOT_IN_RESTÖ,‘ê¨40Ž¡‘êñëÜCHOICE_SINGÖ,‘ê¨40Ž¡‘êñëÜCOMPONENTÖ,‘ê¨38Ž¡‘êñëcon•¬rv“ersionsŽ¡‘þñëÜDELETE_CONVÖ,‘ê¨13Ž¡‘þñëÜFINITE_CONVÖ,‘ê¨18Ž¡‘þñëÜIMAGE_CONVÖ,‘ê¨15{16Ž¡‘þñëÜIN_CONVÖ,‘ê¨10{11ŽŽŽ þä’ô)ÜINSERT_CONVÖ,‘ê¨12{13Ž¤’ô)ÜSET_SPEC_CONVÖ,‘ê¨5{6Ž¡’ô)ÜUNION_CONVÖ,‘ê¨11{12ŽŸ…ä’à)ÜDECOMPOSITIONÖ,‘ê¨38Ž¡’à)Üdefine_finite_set_syntaxÖ,‘ê¨9Ž¡’à)Üdefine_new_type_bijectionsÖ,‘ê¨1Ž¡’à)Üdefine_set_abstraction_syntaxÖ,‘ê¨3Ž¡’à)de nitionŽ¡’ô)of–ê¨Ü(*)setÖ,“1{2Ž¡’ô)of–ê¨ÜBIJÖ,“17Ž¡’ô)of–ê¨ÜCARDÖ,“19Ž¡’ô)of–ê¨ÜCHFÖ,“1Ž¡’ô)of–ê¨ÜCHOICEÖ,“14Ž¡’ô)of–ê¨ÜDELETEÖ,“8Ž¡’ô)of–ê¨ÜDIFFÖ,“7Ž¡’ô)of–ê¨ÜDISJOINTÖ,“8Ž¡’ô)of–ê¨ÜEMPTYÖ,“6Ž¡’ô)of–ê¨ÜFINITEÖ,“17Ž¡’ô)of–ê¨ÜGSPECÖ,“3Ž¡’ô)of–ê¨ÜIMAGEÖ,“15Ž¡’ô)of–ê¨ÜINÖ,“2Ž¡’ô)of–ê¨ÜINFINITEÖ,“17Ž¡’ô)of–ê¨ÜINJÖ,“16Ž¡’ô)of–ê¨ÜINSERTÖ,“8Ž¡’ô)of–ê¨ÜINTERÖ,“7Ž¡’ô)of–ê¨ÜLINVÖ,“17Ž¡’ô)of–ê¨ÜPSUBSETÖ,“7Ž¡’ô)of–ê¨ÜRESTÖ,“14Ž¡’ô)of–ê¨ÜRINVÖ,“17Ž¡’ô)of–ê¨ÜSINGÖ,“14Ž¡’ô)of–ê¨ÜSPECÖ,“1Ž¡’ô)of–ê¨ÜSUBSETÖ,“7ŽŽŽŽŽŽŸ$ý’ÇÑ)Û50ŽŽŒ‹3Ú$ ÌU ýFÓŸú™š‘ÇaÛIndex’˜n|51Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘&ÇaÖof–ê¨ÜSURJÖ,“16Ž¤¬‘&Çaof–ê¨ÜUNIONÖ,“7Ž¡‘&Çaof–ê¨ÜUNIVÖ,“6Ž¡‘ÇaÜDELETE_COMMÖ,‘ê¨38Ž¡‘ÇaÜDELETE_CONVÖ,–ê¨13,“23Ž¡‘ÇaÜDELETE_DEFÖ,–ê¨8,“38Ž¡‘ÇaÜDELETE_DELETEÖ,‘ê¨38Ž¡‘ÇaÜDELETE_EQ_SINGÖ,‘ê¨43Ž¡‘ÇaÜDELETE_INSERTÖ,‘ê¨38Ž¡‘ÇaÜDELETE_INTERÖ,‘ê¨38Ž¡‘ÇaÜDELETE_NON_ELEMENTÖ,‘ê¨38Ž¡‘ÇaÜDELETE_SUBSETÖ,‘ê¨39Ž¡‘ÇaÜDIFF_DEFÖ,–ê¨7,“37Ž¡‘ÇaÜDIFF_DIFFÖ,‘ê¨37Ž¡‘ÇaÜDIFF_EMPTYÖ,‘ê¨37Ž¡‘ÇaÜDIFF_EQ_EMPTYÖ,‘ê¨37Ž¡‘ÇaÜDIFF_INSERTÖ,‘ê¨39Ž¡‘ÇaÜDIFF_UNIVÖ,‘ê¨37Ž¡‘ÇaÜDISJOINT_DEFÖ,–ê¨8,“37Ž¡‘ÇaÜDISJOINT_DELETE_SYMÖ,‘ê¨37Ž¡‘ÇaÜDISJOINT_EMPTYÖ,‘ê¨38Ž¡‘ÇaÜDISJOINT_EMPTY_REFLÖ,‘ê¨38Ž¡‘ÇaÜDISJOINT_INSERTÖ,‘ê¨39Ž¡‘ÇaÜDISJOINT_SING_EMPTYÖ,‘ê¨43Ž¡‘ÇaÜDISJOINT_SYMÖ,‘ê¨38Ž¡‘ÇaÜDISJOINT_UNIONÖ,‘ê¨38Ž© Û‘ÇaÜEMPTY_DEFÖ,–ê¨6,“34Ž¡‘ÇaÜEMPTY_DELETEÖ,‘ê¨39Ž¡‘ÇaÜEMPTY_DIFFÖ,‘ê¨37Ž¡‘ÇaÜEMPTY_NOT_UNIVÖ,‘ê¨34Ž¡‘ÇaÜEMPTY_SUBSETÖ,–ê¨7,“34Ž¡‘ÇaÜEMPTY_UNIONÖ,‘ê¨35Ž¡‘ÇaÜEQ_UNIVÖ,‘ê¨34Ž¡‘ÇaÜEQUAL_SINGÖ,‘ê¨43Ž¡‘ÇaÜEXTENSIONÖ,–ê¨2,“33Ž¦‘ÇaÜFINITE_CONVÖ,–ê¨18,“24Ž¡‘ÇaÜFINITE_DEFÖ,–ê¨17,“44Ž¡‘ÇaÜFINITE_DELETEÖ,‘ê¨44Ž¡‘ÇaÜFINITE_DIFFÖ,‘ê¨44ŽŽŽ ý‹Ð!’æŸÜFINITE_EMPTYÖ,–ê¨17,“44Ž¤¬’æŸÜFINITE_INDUCTÖ,‘ê¨44Ž¡’æŸÜFINITE_INSERTÖ,–ê¨17,“44Ž¡’æŸÜFINITE_ISO_NUMÖ,–ê¨19,“44Ž¡’æŸÜFINITE_PSUBSET_INFINITEÖ,‘ê¨44Ž¡’æŸÜFINITE_PSUBSET_UNIVÖ,‘ê¨44Ž¡’æŸÜFINITE_SINGÖ,‘ê¨43Ž¡’æŸÜFINITE_UNIONÖ,‘ê¨45Ž© Û’æŸÜGSPECÖ,‘ê¨3Ž¡’æŸÜGSPEC_DEFÖ,–ê¨3,“33Ž¡’æŸÜGSPECIFICATIONÖ,–ê¨3,“33Ž¦’æŸÜIMAGE_11_INFINITEÖ,–ê¨18,“45Ž¡’æŸÜIMAGE_COMPOSEÖ,‘ê¨41Ž¡’æŸÜIMAGE_CONVÖ,–ê¨15{16,“25Ž¡’æŸÜIMAGE_DEFÖ,–ê¨15,“41Ž¡’æŸÜIMAGE_DELETEÖ,‘ê¨41Ž¡’æŸÜIMAGE_EMPTYÖ,‘ê¨41Ž¡’æŸÜIMAGE_EQ_EMPTYÖ,‘ê¨41Ž¡’æŸÜIMAGE_FINITEÖ,‘ê¨45Ž¡’æŸÜIMAGE_IDÖ,‘ê¨41Ž¡’æŸÜIMAGE_INÖ,‘ê¨41Ž¡’æŸÜIMAGE_INSERTÖ,‘ê¨41Ž¡’æŸÜIMAGE_INTERÖ,‘ê¨41Ž¡’æŸÜIMAGE_SUBSETÖ,‘ê¨41Ž¡’æŸÜIMAGE_SURJÖ,‘ê¨42Ž¡’æŸÜIMAGE_UNIONÖ,‘ê¨42Ž¡’æŸÜIN_CONVÖ,–ê¨10{11,“28Ž¡’æŸÜIN_DEFÖ,–ê¨2,“33Ž¡’æŸÜIN_DELETEÖ,–ê¨9,“39Ž¡’æŸÜIN_DELETE_EQÖ,‘ê¨40Ž¡’æŸÜIN_DIFFÖ,–ê¨8,“37Ž¡’æŸÜIN_DISJOINTÖ,‘ê¨38Ž¡’æŸÜIN_IMAGEÖ,–ê¨15,“42Ž¡’æŸÜIN_INFINITE_NOT_FINITEÖ,‘ê¨45Ž¡’æŸÜIN_INSERTÖ,–ê¨9,“40Ž¡’æŸÜIN_INTERÖ,–ê¨8,“36Ž¡’æŸÜIN_SINGÖ,‘ê¨43Ž¡’æŸÜIN_UNIONÖ,–ê¨8,“36Ž¡’æŸÜIN_UNIVÖ,–ê¨6,“34ŽŽŽŽŽŽŒ‹4á ÌU ýFÓŸú™š‘êñëÛ52’˜n|IndexŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÜINFINITE_DEFÖ,–ê¨17,“45Ž¤5‘êñëÜINFINITE_DIFF_FINITEÖ,‘ê¨45Ž¡‘êñëÜINFINITE_SUBSETÖ,‘ê¨45Ž¡‘êñëÜINFINITE_UNIVÖ,‘ê¨45Ž¡‘êñëÜINJ_COMPOSEÖ,‘ê¨42Ž¡‘êñëÜINJ_DEFÖ,–ê¨16,“42Ž¡‘êñëÜINJ_EMPTYÖ,‘ê¨42Ž¡‘êñëÜINJ_IDÖ,‘ê¨42Ž¡‘êñëÜINSERT_COMMÖ,‘ê¨39Ž¡‘êñëÜINSERT_CONVÖ,–ê¨12{13,“27Ž¡‘êñëÜINSERT_DEFÖ,–ê¨8,“39Ž¡‘êñëÜINSERT_DELETEÖ,‘ê¨39Ž¡‘êñëÜINSERT_DIFFÖ,‘ê¨39Ž¡‘êñëÜINSERT_INSERTÖ,‘ê¨39Ž¡‘êñëÜINSERT_INTERÖ,‘ê¨39Ž¡‘êñëÜINSERT_SING_UNIONÖ,‘ê¨43Ž¡‘êñëÜINSERT_SUBSETÖ,‘ê¨39Ž¡‘êñëÜINSERT_UNIONÖ,‘ê¨39Ž¡‘êñëÜINSERT_UNION_EQÖ,‘ê¨39Ž¡‘êñëÜINSERT_UNIVÖ,‘ê¨39Ž¡‘êñëÜINTER_ASSOCÖ,‘ê¨36Ž¡‘êñëÜINTER_COMMÖ,‘ê¨36Ž¡‘êñëÜINTER_DEFÖ,–ê¨7,“36Ž¡‘êñëÜINTER_EMPTYÖ,‘ê¨36Ž¡‘êñëÜINTER_FINITEÖ,‘ê¨45Ž¡‘êñëÜINTER_IDEMPOTÖ,‘ê¨36Ž¡‘êñëÜINTER_OVER_UNIONÖ,‘ê¨36Ž¡‘êñëÜINTER_SUBSETÖ,‘ê¨36Ž¡‘êñëÜINTER_UNIVÖ,‘ê¨36Ž©A¡‘êñëÜLESS_CARD_DIFFÖ,‘ê¨47Ž¡‘êñëÜLINV_DEFÖ,–ê¨17,“42Ž¡‘êñëÜload_setsÖ,‘ê¨21Ž¦‘êñëÜMEMBER_NOT_EMPTYÖ,‘ê¨34Ž¦‘êñënaming‘ê¨con•¬rv“en“tionsŽ¡‘þñëfor–ê¨de nitions,“2Ž¡‘þñëfor–ê¨mem¬rbSŽership“conditions,“8Ž¡‘þñëfor–ê¨theorems“abSŽout“singletons,“14Ž¡‘þñëfor–ê¨theorems“generally‘ÿV,“7ŽŽŽ ý‹Ð!’à)ÜNOT_EMPTY_INSERTÖ,‘ê¨40Ž¤5’à)ÜNOT_EMPTY_SINGÖ,‘ê¨43Ž¡’à)ÜNOT_EQUAL_SETSÖ,‘ê¨33Ž¡’à)ÜNOT_IN_EMPTYÖ,–ê¨6,“34Ž¡’à)ÜNOT_IN_FINITEÖ,‘ê¨45Ž¡’à)ÜNOT_INSERT_EMPTYÖ,‘ê¨40Ž¡’à)ÜNOT_PSUBSET_EMPTYÖ,–ê¨7,“34Ž¡’à)ÜNOT_SING_EMPTYÖ,‘ê¨43Ž¡’à)ÜNOT_UNIV_PSUBSETÖ,–ê¨7,“35Ž¡’à)ÜNUM_SET_WOPÖ,‘ê¨34Ž©A¡’à)Üprint_set–ê¨Ö( ag),“4,“9Ž¡’à)ÜPSUBSET_DEFÖ,–ê¨7,“35Ž¡’à)ÜPSUBSET_FINITEÖ,‘ê¨45Ž¡’à)ÜPSUBSET_INSERT_SUBSETÖ,‘ê¨40Ž¡’à)ÜPSUBSET_IRREFLÖ,‘ê¨35Ž¡’à)ÜPSUBSET_MEMBERÖ,‘ê¨35Ž¡’à)ÜPSUBSET_TRANSÖ,‘ê¨35Ž¡’à)ÜPSUBSET_UNIVÖ,‘ê¨35Ž¦’à)ÜREST_DEFÖ,–ê¨14,“40Ž¡’à)ÜREST_PSUBSETÖ,‘ê¨41Ž¡’à)ÜREST_SINGÖ,‘ê¨41Ž¡’à)ÜREST_SUBSETÖ,‘ê¨41Ž¡’à)ÜRINV_DEFÖ,–ê¨17,“42Ž¦’à)ÜSET_CASESÖ,‘ê¨40Ž¡’à)ÜSET_INDUCT_TACÖ,–ê¨18{19,“30Ž¡’à)Üset_ISO_DEFÖ,–ê¨1,“33Ž¡’à)ÜSET_MINIMUMÖ,‘ê¨34Ž¡’à)ÜSET_SPEC_CONVÖ,–ê¨5{6,“30Ž¡’à)Üset_TY_DEFÖ,–ê¨1,“33Ž¡’à)ÜSINGÖ,–ê¨14,“43Ž¡’à)ÜSING_DEFÖ,–ê¨14,“44Ž¡’à)ÜSING_DELETEÖ,‘ê¨44Ž¡’à)ÜSING_FINITEÖ,‘ê¨44Ž¡’à)ÜSING_IFF_CARD1Ö,‘ê¨47Ž¡’à)ÜSING_IFF_EMPTY_RESTÖ,‘ê¨41Ž¡’à)ÜSPECÖ,‘ê¨1Ž¡’à)ÜSPECIFICATIONÖ,–ê¨2,“34Ž¡’à)ÜSUBSET_ANTISYMÖ,–ê¨7,“35ŽŽŽŽŽŽŒ‹5êþ ÌU ýFÓŸú™š‘ÇaÛIndex’˜n|53Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÜSUBSET_DEFÖ,–ê¨7,“35Ž¤‘ÇaÜSUBSET_DELETEÖ,‘ê¨40Ž¡‘ÇaÜSUBSET_EMPTYÖ,‘ê¨35Ž¡‘ÇaÜSUBSET_FINITEÖ,‘ê¨45Ž¡‘ÇaÜSUBSET_INSERTÖ,‘ê¨40Ž¡‘ÇaÜSUBSET_INSERT_DELETEÖ,‘ê¨40Ž¡‘ÇaÜSUBSET_INTER_ABSORPTIONÖ,‘ê¨36Ž¡‘ÇaÜSUBSET_REFLÖ,–ê¨7,“35Ž¡‘ÇaÜSUBSET_TRANSÖ,–ê¨7,“35Ž¡‘ÇaÜSUBSET_UNIONÖ,‘ê¨36Ž¡‘ÇaÜSUBSET_UNION_ABSORPTIONÖ,‘ê¨36Ž¡‘ÇaÜSUBSET_UNIVÖ,–ê¨7,“35Ž¡‘ÇaÜSURJ_COMPOSEÖ,‘ê¨43Ž¡‘ÇaÜSURJ_DEFÖ,–ê¨16,“43Ž¡‘ÇaÜSURJ_EMPTYÖ,‘ê¨43Ž¡‘ÇaÜSURJ_IDÖ,‘ê¨43Ž©‘ÇatacticsŽ¡‘&ÇaÜSET_INDUCT_TACÖ,‘ê¨18{19Ž¦‘ÇaÜUNION_ASSOCÖ,‘ê¨36Ž¡‘ÇaÜUNION_COMMÖ,‘ê¨36Ž¡‘ÇaÜUNION_CONVÖ,–ê¨11{12,“31Ž¡‘ÇaÜUNION_DEFÖ,–ê¨7,“36Ž¡‘ÇaÜUNION_EMPTYÖ,‘ê¨37Ž¡‘ÇaÜUNION_IDEMPOTÖ,‘ê¨37Ž¡‘ÇaÜUNION_OVER_INTERÖ,‘ê¨37Ž¡‘ÇaÜUNION_UNIVÖ,‘ê¨37Ž¡‘ÇaÜUNIV_DEFÖ,–ê¨6,“34Ž¡‘ÇaÜUNIV_NOT_EMPTYÖ,‘ê¨34Ž¡‘ÇaÜUNIV_SUBSETÖ,‘ê¨35ŽŽŽŽŽŽŒøôŒƒ’À;èÌUÚÝ 9óKßê ó3 cmmi10ó"Kñ`y ó3 cmr10óp®0J cmsl10ó×2cmmi8ó |{Ycmr8ùøTßßßßhol88-2.02.19940316/Library/sets/Manual/sets.toc0000640000212700021270000000636405535606171017231 0ustar cammcamm\contentsline {chapter}{\numberline {1}The sets Library}{1} \contentsline {section}{\numberline {1.1}The type definition}{1} \contentsline {section}{\numberline {1.2}Membership and the axioms of set theory}{2} \contentsline {section}{\numberline {1.3}Generalized set specifications}{3} \contentsline {subsection}{\numberline {1.3.1}Parser and pretty-printer support}{3} \contentsline {subsection}{\numberline {1.3.2}Theorem-proving support}{5} \contentsline {section}{\numberline {1.4}The empty and universal sets}{6} \contentsline {section}{\numberline {1.5}Set inclusion}{7} \contentsline {section}{\numberline {1.6}Union, intersection, and set difference}{7} \contentsline {section}{\numberline {1.7}Disjoint sets}{8} \contentsline {section}{\numberline {1.8}Insertion and deletion of an element}{8} \contentsline {subsection}{\numberline {1.8.1}Parser and pretty-printer support}{9} \contentsline {subsection}{\numberline {1.8.2}Conversions for enumerated finite sets}{10} \contentsline {subsubsection}{\numberline {1.8.2.1}Membership}{10} \contentsline {subsubsection}{\numberline {1.8.2.2}Union}{11} \contentsline {subsubsection}{\numberline {1.8.2.3}Insertion}{12} \contentsline {subsubsection}{\numberline {1.8.2.4}Deletion}{13} \contentsline {section}{\numberline {1.9}Singleton sets}{14} \contentsline {section}{\numberline {1.10}The {\ptt CHOICE} and {\ptt REST} functions}{14} \contentsline {section}{\numberline {1.11}Image of a function on a set}{15} \contentsline {subsection}{\numberline {1.11.1}Theorem-proving support}{15} \contentsline {section}{\numberline {1.12}Mappings between sets}{16} \contentsline {section}{\numberline {1.13}Finite and infinite sets}{17} \contentsline {subsection}{\numberline {1.13.1}Theorem-proving support}{18} \contentsline {section}{\numberline {1.14}Cardinality of finite sets}{19} \contentsline {section}{\numberline {1.15}Using the library}{19} \contentsline {subsection}{\numberline {1.15.1}Example session}{20} \contentsline {subsection}{\numberline {1.15.2}The {\ptt load\unhbox \voidb@x \kern .06em \vbox {\hrule width.3em}sets} function}{21} \contentsline {chapter}{\numberline {2}ML Functions in the sets Library}{23} \contentsline {chapter}{\numberline {3}Pre-proved Theorems}{33} \contentsline {section}{\numberline {3.1}The type definition}{33} \contentsline {section}{\numberline {3.2}Membership, equality, and set specifications}{33} \contentsline {section}{\numberline {3.3}The empty and universal sets}{34} \contentsline {section}{\numberline {3.4}Set inclusion}{34} \contentsline {section}{\numberline {3.5}Intersection and union}{35} \contentsline {section}{\numberline {3.6}Set difference}{37} \contentsline {section}{\numberline {3.7}Disjoint sets}{37} \contentsline {section}{\numberline {3.8}Insertion and deletion of an element}{38} \contentsline {section}{\numberline {3.9}The {\ptt CHOICE} and {\ptt REST} functions}{40} \contentsline {section}{\numberline {3.10}Image of a function on a set}{41} \contentsline {section}{\numberline {3.11}Mappings between sets}{42} \contentsline {section}{\numberline {3.12}Singleton sets}{43} \contentsline {section}{\numberline {3.13}Finite and infinite sets}{44} \contentsline {section}{\numberline {3.14}Cardinality of sets}{46} \contentsline {chapter}{References}{49} \contentsline {chapter}{Index}{50} hol88-2.02.19940316/Library/sets/Manual/description.aux0000640000212700021270000001007105535606147020577 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {1}The sets Library}{1}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.1}The type definition}{1}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.2}Membership and the axioms of set theory}{2}} \citation{description} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.3}Generalized set specifications}{3}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.3.1}Parser and pretty-printer support}{3}} \newlabel{abst}{{1.3.1}{3}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.3.2}Theorem-proving support}{5}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.4}The empty and universal sets}{6}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.5}Set inclusion}{7}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.6}Union, intersection, and set difference}{7}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.7}Disjoint sets}{8}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.8}Insertion and deletion of an element}{8}} \citation{description} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.8.1}Parser and pretty-printer support}{9}} \newlabel{finite}{{1.8.1}{9}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.8.2}Conversions for enumerated finite sets}{10}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.1}Membership}{10}} \newlabel{inconv}{{1.8.2.1}{10}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.2}Union}{11}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.3}Insertion}{12}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.4}Deletion}{13}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.9}Singleton sets}{14}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.10}The {\string\ptt\space CHOICE} and {\string\ptt\space REST} functions}{14}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.11}Image of a function on a set}{15}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.11.1}Theorem-proving support}{15}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.12}Mappings between sets}{16}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.13}Finite and infinite sets}{17}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.13.1}Theorem-proving support}{18}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.14}Cardinality of finite sets}{19}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.15}Using the library}{19}} \newlabel{using}{{1.15}{19}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.15.1}Example session}{20}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.15.2}The {\string\ptt\space load\unhbox \voidb@x \kern .06em \vbox {\hrule width.3em}sets} function}{21}} \global\@namedef{cp@description}{ \setcounter{page}{22} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{1} \setcounter{section}{15} \setcounter{subsection}{2} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/sets/Manual/entries.aux0000640000212700021270000000137105535606156017730 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {2}ML Functions in the sets Library}{23}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \newlabel{entries}{{2}{23}} \global\@namedef{cp@entries}{ \setcounter{page}{33} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{2} \setcounter{section}{0} \setcounter{subsection}{2} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/sets/Manual/sets.tex0000640000212700021270000000535605112532142017227 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: sets library (standard latex style) % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % Define a few other commands. % --------------------------------------------------------------------- \def\bk{{\tt\char`\\}} \def\lb{{\tt\char`\{}} \def\rb{{\tt\char`\}}} \def\vb{{\tt\char`\|}} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{description} % --------------------------------------------------------------------- % Reference manual entries for functions % --------------------------------------------------------------------- \include{entries} % --------------------------------------------------------------------- % Listing of theorems % --------------------------------------------------------------------- \include{theorems} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/sets/Manual/theorems.aux0000640000212700021270000000453205535606170020103 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {3}Pre-proved Theorems}{33}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \newlabel{theorems}{{3}{33}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.1}The type definition}{33}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.2}Membership, equality, and set specifications}{33}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.3}The empty and universal sets}{34}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.4}Set inclusion}{34}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.5}Intersection and union}{35}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.6}Set difference}{37}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.7}Disjoint sets}{37}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.8}Insertion and deletion of an element}{38}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.9}The {\string\ptt\space CHOICE} and {\string\ptt\space REST} functions}{40}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.10}Image of a function on a set}{41}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.11}Mappings between sets}{42}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.12}Singleton sets}{43}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.13}Finite and infinite sets}{44}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.14}Cardinality of sets}{46}} \global\@namedef{cp@theorems}{ \setcounter{page}{48} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{14} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/sets/Manual/Makefile0000640000212700021270000000702405267277273017207 0ustar cammcamm# ===================================================================== # Makefile for the sets library documentation # ===================================================================== # --------------------------------------------------------------------- # Pathname to the sets help files # --------------------------------------------------------------------- Help=../help # --------------------------------------------------------------------- # Pathname to the doc-to-tex script and doc-to-tex.sed file # --------------------------------------------------------------------- DOCTOTEX=../../../Manual/Reference/bin/doc-to-tex DOCTOTEXSED=../../../Manual/Reference/bin/doc-to-tex.sed # --------------------------------------------------------------------- # Pathname to the makeindex script # --------------------------------------------------------------------- MAKEINDEX=../../../Manual/LaTeX/makeindex ../../../ default: @echo "INSTRUCTIONS: Type \"make all\" to make the documentation" # --------------------------------------------------------------------- # Remove all trace of previous LaTeX jobs # --------------------------------------------------------------------- clean: rm -f *.dvi *.aux *.toc *.log *.idx *.ilg @echo "\begin{theindex}" > index.tex @echo "\mbox{}" >> index.tex @echo "\end{theindex}" >> index.tex tex: theorems ids @echo "TeX files made" ids: @echo "\chapter{ML Functions in the sets Library}">entries.tex @echo "\label{entries}">>entries.tex @echo "\input{entries-intro}" >> entries.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex theorems: @echo "\chapter{Pre-proved Theorems}" > theorems.tex @echo "\input{theorems-intro}" >> theorems.tex @echo "\section{The type definition}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/sdef theorems.tex @echo "\section{Membership, equality, and set specifications}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/mem theorems.tex @echo "\section{The empty and universal sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/emuniv theorems.tex @echo "\section{Set inclusion}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/subs theorems.tex @echo "\section{Intersection and union}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/unin theorems.tex @echo "\section{Set difference}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/diff theorems.tex @echo "\section{Disjoint sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/disj theorems.tex @echo "\section{Insertion and deletion of an element}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/insdel theorems.tex @echo "\section{The {\tt CHOICE} and {\tt REST} functions}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/chre theorems.tex @echo "\section{Image of a function on a set}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/image theorems.tex @echo "\section{Mappings between sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/fun theorems.tex @echo "\section{Singleton sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/sing theorems.tex @echo "\section{Finite and infinite sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/fin theorems.tex @echo "\section{Cardinality of sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/card theorems.tex index: ${MAKEINDEX} sets.idx index.tex sets: latex sets.tex all: make clean; make tex; make sets; make index; make sets hol88-2.02.19940316/Library/sets/Manual/references.aux0000640000212700021270000000114205535606170020370 0ustar cammcamm\relax \bibcite{description}{1} \@writefile{toc}{\string\contentsline\space {chapter}{References}{49}} \global\@namedef{cp@references}{ \setcounter{page}{50} \setcounter{equation}{0} \setcounter{enumi}{1} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{14} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/sets/Manual/index.aux0000640000212700021270000000107705535606170017365 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{Index}{50}} \global\@namedef{cp@index}{ \setcounter{page}{54} \setcounter{equation}{0} \setcounter{enumi}{1} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{14} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/sets/Makefile0000640000212700021270000000402004726032641015746 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: sets # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o @echo "===> library sets: all object code deleted" clobber: rm -f *_ml.o *_ml.l *.th @echo "===> library sets: all object code and theory files deleted" # ===================================================================== # Entries for individual files. # ===================================================================== sets.th: mk_sets.ml rm -f sets.th echo 'set_flag(`abort_when_fail`,true);;'\ 'loadt `mk_sets`;;' | ${Hol} gspec_ml.o: sets.th gspec.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `sets`;;'\ 'compilet `gspec`;;'\ 'quit();;' | ${Hol} set_ind_ml.o: sets.th set_ind.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `sets`;;'\ 'compilet `set_ind`;;'\ 'quit();;' | ${Hol} fset_conv_ml.o: sets.th fset_conv.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `sets`;;'\ 'compilet `fset_conv`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: sets.th set_ind_ml.o gspec_ml.o fset_conv_ml.o @echo "===> library sets rebuilt" hol88-2.02.19940316/Library/sets/gspec.ml0000640000212700021270000001760604727213111015751 0ustar cammcamm% ===================================================================== % % FILE : gspec.ml % % DESCRIPTION : Generalized set specification : {tm[xi...xn] | P} % % % % REWRITTEN : T Melham % % DATE : 90.07.30 % % ===================================================================== % begin_section SET_SPEC_CONV;; % --------------------------------------------------------------------- % % Local function: dest_tuple "t1,t2,...,tn" = [t1;t2;...;tnm] % % --------------------------------------------------------------------- % letrec dest_tuple tm = (let (x,y) = dest_pair tm in x.dest_tuple y) ? [tm];; % --------------------------------------------------------------------- % % Local function: MK_PAIR % % % % A call to: % % % % MK_PAIR "[x1;x2;...;xn]" "v:(ty1 # ty2 # ... # tyn)" % % % % returns: % % % % |- v = FST v, FST(SND v), ..., SND(SND...(SND v)) % % --------------------------------------------------------------------- % letrec MK_PAIR vs v = if (null (tl vs)) then (REFL v) else let vty = type_of v in let _,[ty1;ty2] = dest_type vty in let inst = SYM(SPEC v (INST_TYPE [ty1,":*";ty2,":**"] PAIR)) in let FST,SND = dest_pair(rhs(concl inst)) in let thm = MK_PAIR (tl vs) SND and gv = genvar ty2 in SUBST [thm,gv] (mk_eq(v,mk_pair(FST,gv))) inst;; % --------------------------------------------------------------------- % % Local function: EXISTS_TUPLE_CONV % % % % A call to: % % % % EXISTS_TUPLE_CONV ["x1";...;"xn"] "?v. tm' = (\(x1,...,xn). tm) v % % % % returns: % % % % |- (?v. tm' = (\(x1,...,xn). tm) v ) = ?x1...xn. tm' = tm % % --------------------------------------------------------------------- % let EXISTS_TUPLE_CONV = let EX (v,tm) th = EXISTS (mk_exists(v,subst [v,tm] (concl th)),tm) th and CH tm th = CHOOSE (tm,ASSUME (mk_exists(tm,hd(hyp th)))) th in let conv = RAND_CONV (BETA_CONV ORELSEC PAIRED_BETA_CONV) in \vs tm. let tup = end_itlist (curry mk_pair) vs in let v,body = dest_exists tm in let tupeq = MK_PAIR vs v in let asm1 = SUBST [tupeq,v] body (ASSUME body) in let comp = dest_tuple (rand(concl tupeq)) in let thm1 = itlist2 EX (vs,comp) asm1 in let imp1 = DISCH tm (CHOOSE (v,ASSUME tm) thm1) in let asm2 = ASSUME (subst [tup,v] body) in let thm2 = itlist CH vs (EXISTS (tm,tup) asm2) in let imp2 = DISCH (hd(hyp thm2)) thm2 in let eq = IMP_ANTISYM_RULE imp1 imp2 in let beta = conv (snd(strip_exists(rhs(concl eq)))) in TRANS eq (itlist EXISTS_EQ vs beta);; % --------------------------------------------------------------------- % % Local function: PAIR_EQ_CONV. % % % % A call to PAIR_EQ_CONV "?x1...xn. a,b = c,T" returns: % % % % |- (?x1...xn. a,T = b,c) = (?x1...xn. (a = b) /\ c) % % --------------------------------------------------------------------- % let PAIR_EQ_CONV = let EQT = el 1 (CONJUNCTS (SPEC "c:bool" EQ_CLAUSES)) in let PEQ = let inst = INST_TYPE [":bool",":**"] PAIR_EQ in let spec = SPECL ["a:*";"T";"b:*";"c:bool"] inst in GENL ["a:*";"b:*";"c:bool"] (SUBS [EQT] spec) in \tm. let vs,body = strip_exists tm in let (a,T),(b,c) = (dest_pair # dest_pair) (dest_eq body) in let th = SPEC c (SPEC b (SPEC a (INST_TYPE [type_of a,":*"] PEQ))) in itlist EXISTS_EQ vs th;; % --------------------------------------------------------------------- % % Local function: ELIM_EXISTS_CONV. % % % % ELIM_EXISTS_CONV "?x. (x = tm) /\ P[x]" returns: % % % % |- (?x. x = tm /\ P[x]) = P[tm/x] % % --------------------------------------------------------------------- % let ELIM_EXISTS_CONV tm = let x,eq,body = (I # dest_conj)(dest_exists tm) in let asm1,asm2 = (SYM # I) (CONJ_PAIR (ASSUME (mk_conj(eq,body)))) in let imp1 = DISCH tm (CHOOSE(x,ASSUME tm) (SUBST [asm1,x] body asm2)) in let r = lhs eq in let asm = subst [r,x] body in let imp2 = DISCH asm (EXISTS (tm,r) (CONJ (REFL r) (ASSUME asm))) in IMP_ANTISYM_RULE imp1 imp2;; % --------------------------------------------------------------------- % % Local function: PROVE_EXISTS. % % % % PROVE_EXISTS "?x. tm" (x not free in tm) returns: % % % % |- ?x.tm = tm % % --------------------------------------------------------------------- % let PROVE_EXISTS tm = let x,body = dest_exists tm in let v = genvar (type_of x) in let imp1 = DISCH tm (CHOOSE (v,ASSUME tm) (ASSUME body)) in let imp2 = DISCH body (EXISTS (tm,v) (ASSUME body)) in IMP_ANTISYM_RULE imp1 imp2;; % --------------------------------------------------------------------- % % Internal function: list_variant % % % % makes variants of the variables in l2 such that they are all not in % % l1 and are all different. % % --------------------------------------------------------------------- % letrec list_variant l1 l2 = if (null l2) then [] else (let v = variant l1 (hd l2) in (v.list_variant (v.l1) (tl l2)));; % --------------------------------------------------------------------- % % SET_SPEC_CONV: implements the axiom of specification for generalized % % set specifications. % % % % There are two cases: % % % % 1) SET_SPEC_CONV "t IN {v | p[v]}" (v a variable, t a term) % % % % returns: % % % % |- t IN {v | p[v]} = p[t/v] % % % % % % 2) SET_SPEC_CONV "t IN {tm[x1;...;xn] | p[x1;...xn]}" % % % % returns: % % % % |- t IN {tm[x1;...;xn] | p[x1;...xn]} % % = % % ?x1...xn. t = tm[x1;...;xn] /\ p[x1;...xn] % % % % Note that {t[x1,...,xm] | p[x1,...,xn]} means: % % % % GGSPEC (\(x1,...,xn). (t[x1,...,xn], p[x1,...,xn])) % % --------------------------------------------------------------------- % let SET_SPEC_CONV = let check name = assert \tm.fst(dest_const tm) = name in let GSPEC = let th = theorem `sets` `GSPECIFICATION` in let vs = fst(strip_forall(concl th)) in GENL (rev vs) (SPECL vs th) in let RAconv = RAND_CONV o ABS_CONV in let conv = RAND_CONV(RAconv(RAND_CONV BETA_CONV)) in let conv2 = RAND_CONV (PAIR_EQ_CONV THENC PROVE_EXISTS) in letrec mktup tm = (let x,(xs,res) = (I # mktup) (dest_abs(rand tm)) in ((x.xs),res)) ? (let x,res = (I # (fst o dest_pair)) (dest_abs tm) in [x],res) in \tm. (let _,[v;set] = (check `IN` # I) (strip_comb tm) in let _,f = (check `GSPEC` # I ) (dest_comb set) in let vty = type_of v and _,[uty;_] = dest_type(type_of f) in let inst = SPEC v (INST_TYPE [vty,":*";uty,":**"] GSPEC) in let vs,res = mktup f in if (forall ($not o (C free_in res)) vs) then let spec = CONV_RULE conv (SPEC f inst) in let thm1 = CONV_RULE conv2 spec in thm1 else if (is_var res) then let spec = CONV_RULE conv (SPEC f inst) in let thm1 = CONV_RULE (RAND_CONV PAIR_EQ_CONV) spec in TRANS thm1 (ELIM_EXISTS_CONV (rhs(concl thm1))) else let spec = SPEC f inst in let nvs = list_variant (frees v) vs in let thm = EXISTS_TUPLE_CONV nvs (rhs(concl spec)) in TRANS spec (CONV_RULE (RAND_CONV PAIR_EQ_CONV) thm)) ? failwith `SET_SPEC_CONV`;; % --------------------------------------------------------------------- % % Bind SET_SPEC_CONV to "it". % % --------------------------------------------------------------------- % SET_SPEC_CONV;; end_section SET_SPEC_CONV;; % --------------------------------------------------------------------- % % Save exported value of SET_SPEC_CONV. % % --------------------------------------------------------------------- % let SET_SPEC_CONV = it;; hol88-2.02.19940316/Library/sets/set_ind.ml0000640000212700021270000000473604706625211016302 0ustar cammcamm% ===================================================================== % % FILE : set_ind.ml % % DESCRIPTION : Induction principle for finite sets. % % % % AUTHOR : Philippe Leveilley % % % % REWRITTEN : T Melham % % DATE : 90.03.14 % % % % REMARKS : Dependence on taut library removed. Use of rewriting % % eliminated. Optimized for speed. Simplified. % % ===================================================================== % % --------------------------------------------------------------------- % % % % "!s. FINITE s ==> P s" % % ========================== SET_INDUCT_TAC % % P EMPTY P (x INSERT t) % % [ "FINITE t" ] % % [ "P s" % % [ "~x IN t"] % % % % --------------------------------------------------------------------- % let SET_INDUCT_TAC = let FINITE_INDUCT = theorem `sets` `FINITE_INDUCT` and check = assert \tm. fst(dest_const(rator tm)) = `FINITE` in let MK_IMP1 = let IMP = "==>" in \tm. AP_TERM (mk_comb(IMP,tm)) and MK_IMP2 = let IMP = "==>" in \th1 th2. MK_COMB(AP_TERM IMP th1,th2) in let sconv = let dest = (I # dest_imp) o dest_forall in \tm. let s,a,e,h,c = (I # (I # dest)) (dest tm) in let th1 = RAND_CONV BETA_CONV a and th2 = BETA_CONV c in FORALL_EQ s (MK_IMP2 th1 (FORALL_EQ e (MK_IMP1 h th2))) in let conv = let CONJ = "/\" in \tm. let base,step = dest_conj tm in MK_COMB(AP_TERM CONJ (BETA_CONV base), sconv step) in let STAC = GEN_TAC THEN DISCH_THEN (CONJUNCTS_THEN ASSUME_TAC) THEN GEN_TAC THEN DISCH_THEN ASSUME_TAC in \A,g. (let s,_,conc = (I # ((check # I) o dest_imp)) (dest_forall g) in let (_,[ty]) = dest_type(type_of s) in let inst = INST_TYPE [ty,":*"] FINITE_INDUCT in let sv = genvar (type_of s) in let pred = mk_abs(sv,(subst [sv,s] conc)) in let spec = SPEC s (UNDISCH (SPEC pred inst)) in let beta = GEN s (CONV_RULE (RAND_CONV BETA_CONV) spec) in let disc = DISCH (hd(hyp beta)) beta in let ithm = CONV_RULE (RATOR_CONV(RAND_CONV conv)) disc in (MATCH_MP_TAC ithm THEN CONJ_TAC THENL [ALL_TAC; STAC])(A,g)) ? failwith `SET_INDUCT_TAC`;; hol88-2.02.19940316/Library/sets/load_sets.ml0000640000212700021270000000256104751051107016621 0ustar cammcamm% ===================================================================== % % FILE : load_sets.ml % % DESCRIPTION : creates a function that loads the contents of the % % library "sets" into hol. % % % % AUTHOR : T. Melham % % DATE : 91.01.20 % % ===================================================================== % % --------------------------------------------------------------------- % % define the function load_sets. % % --------------------------------------------------------------------- % let load_sets (v:void) = if (mem `sets` (ancestry())) then (print_string `Loading contents of sets...`; print_newline(); define_set_abstraction_syntax `GSPEC`; define_finite_set_syntax(`EMPTY`,`INSERT`); set_flag(`print_set`,true); let path st = library_pathname() ^ `/sets/` ^ st in load(path `gspec`, get_flag_value `print_lib`); load(path `set_ind`, get_flag_value `print_lib`); load(path `fset_conv`, get_flag_value `print_lib`); let defs = map fst (definitions `sets`) in map (\st. autoload_theory(`definition`,`sets`,st)) defs; let thms = map fst (theorems `sets`) in map (\st. autoload_theory(`theorem`,`sets`,st)) thms; delete_cache `sets`; ()) else failwith `theory sets not an ancestor of the current theory`;; hol88-2.02.19940316/Library/sets/READ-ME0000640000212700021270000000313105261374324015247 0ustar cammcamm + ===================================================================== + | | | LIBRARY : sets | | | | DESCRIPTION : Theory of finite and infinite sets | | | | AUTHORS : P Leveilley, T Melham | | | | DATE : 29 June 1989, revised August 1990 | | | + ===================================================================== + + --------------------------------------------------------------------- + | FILES: | + --------------------------------------------------------------------- + mk_sets.ml creates the theory of sets fset_conv.ml conversions for finite sets gspec.ml a conversion for generalized set specifications set_ind.ml induction tactic for finite sets sets.ml loadfile for the sets library load_sets.ml auxiliary loadfile for the sets library + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clobber" 3) type "make all" + --------------------------------------------------------------------- + | | | TO USE THE LIBRARY: | | | + --------------------------------------------------------------------- + load_library `sets` + --------------------------------------------------------------------- + | | | DOCUMENTATION: | | | + --------------------------------------------------------------------- + Manual/sets.dvi hol88-2.02.19940316/Library/sets/fset_conv.ml0000640000212700021270000002532505117160060016631 0ustar cammcamm% ===================================================================== % % FILE : fset_conv.ml % % DESCRIPTION : Conversions for taking unions and intersections of % % finite sets, for deciding membership of finite sets, % % and so on. % % % % REWRITTEN : T Melham % % DATE : 90.10.16 % % ===================================================================== % % ===================================================================== % % FINITE_CONV: prove that a normal-form finite set is finite. The set % % in question must have the standard form: % % % % INSERT x1 (INSERT x2 ...(INSERT xn EMPTY)... )) % % % % A call to: % % % % FINITE_CONV "{x1,...,xn}" % % % % returns: % % % % |- FINITE {x1,...,xn} = T % % % % The conversion fails on sets of the wrong form. % % --------------------------------------------------------------------- % let FINITE_CONV = let finE = theorem `sets` `FINITE_EMPTY` in let finI = let th1 = theorem `sets` `FINITE_INSERT` in let th2 = snd(EQ_IMP_RULE (SPECL ["x:*";"s:(*)set"] th1)) in GEN "s:(*)set" (DISCH_ALL (GEN "x:*" (UNDISCH th2))) in let check st = assert (\c. fst(dest_const c) = st) in letrec strip_set tm = (let _,[h;t] = (check `INSERT` # I)(strip_comb tm) in h . strip_set t) ? (fst(dest_const tm) = `EMPTY` => [] | fail) in let itfn ith x th = SPEC x (MP (SPEC (rand(concl th)) ith) th) in \tm. (let _,els = (check `FINITE` # strip_set) (dest_comb tm) in let _,[ty] = dest_type (type_of(rand tm)) in let eth = INST_TYPE [ty,":*"] finE in let ith = INST_TYPE [ty,":*"] finI in EQT_INTRO (itlist (itfn ith) els eth)) ? failwith `FINITE_CONV`;; % ===================================================================== % % IN_CONV: decide membership for finite sets. % % % % A call to: % % % % IN_CONV conv "x IN {x1,...,xn}" % % % % returns: % % % % |- x IN {x1,...,xn} = T % % % % if x is syntactically identical to xi for some i, where 1<=i<=n, or % % if conv proves |- (x=xi)=T for some i, where 1<=i<=n; or it returns: % % % % |- x IN {x1,...,xn} = F % % % % if conv proves |- (x=xi)=F for all 1<=i<=n. % % ===================================================================== % let IN_CONV = let check st = assert (\c. fst(dest_const c) = st) in let inI = theorem `sets` `IN_INSERT` in let inE = GEN "x:*" (EQF_INTRO (SPEC "x:*" th)) where th = theorem `sets` `NOT_IN_EMPTY` in let T = "T" and F = "F" and gv = genvar ":bool" in let DISJ = AP_TERM "\/:bool->bool->bool" in let F_OR = el 3 (CONJUNCTS (SPEC gv OR_CLAUSES)) in let OR_T = el 2 (CONJUNCTS (SPEC gv OR_CLAUSES)) in letrec in_conv conv (eth,ith) x S = (let (_,[y;S']) = (check `INSERT` # I) (strip_comb S) in let thm = SPEC S' (SPEC y ith) in let rectm = rand(rand(concl thm)) in if (aconv x y) then EQT_INTRO (EQ_MP (SYM thm) (DISJ1 (ALPHA x y) rectm)) else (let eql = conv (mk_eq (x, y)) in let res = rand(concl eql) in if (res=T) then EQT_INTRO (EQ_MP (SYM thm) (DISJ1 (EQT_ELIM eql) rectm)) else if (res=F) then let rthm = in_conv conv (eth,ith) x S' in let thm2 = MK_COMB (DISJ eql,rthm) in let thm3 = INST [rand(concl rthm),gv] F_OR in TRANS thm (TRANS thm2 thm3) else fail) ? let rthm = in_conv conv (eth,ith) x S' in if (rand(concl rthm)=T) then let eqn = mk_eq(x,y) in let thm2 = MK_COMB(DISJ (REFL eqn), rthm) in let thm3 = TRANS thm2 (INST [eqn,gv] OR_T) in TRANS thm thm3 else fail) ? (let e = check `EMPTY` S in eth) in \conv tm. (let (_,[x;S]) = (check `IN` # I) (strip_comb tm) in let ith = ISPEC x inI and eth = ISPEC x inE in in_conv conv (eth,ith) x S) ? failwith `IN_CONV`;; % ===================================================================== % % DELETE_CONV: delete an element from a finite set. % % % % A call to: % % % % DELETE_CONV conv "{x1,...,xn} DELETE x" % % % % returns: % % % % |-{x1,...,xn} DELETE x = {xi,...,xk} % % % % where for all xj in {xi,...,xk}, either conv proves |- xj=x or xj is % % syntactically identical to x and for all xj in {x1,...,xn} and NOT in % % {xi,...,xj}, conv proves |- (xj=x)=F. % % ===================================================================== % let DELETE_CONV = let check st = assert (\c. fst(dest_const c) = st) in let bv = genvar ":bool" in let Edel = theorem `sets` `EMPTY_DELETE` in let Dins = GENL ["y:*";"x:*"] (SPECL ["x:*";"y:*"] th) where th = theorem `sets` `DELETE_INSERT` in letrec del_conv conv (eth,ith) x S = (let (_,[y;S']) = (check `INSERT` # I) (strip_comb S) in let thm = SPEC S' (SPEC y ith) in let eql = (aconv x y) => EQT_INTRO (ALPHA y x) | conv (mk_eq(y,x)) in let rthm = del_conv conv (eth,ith) x S' in let v = genvar (type_of S) in let pat = mk_eq(lhs(concl thm),mk_cond(bv,v,mk_comb(rator S,v))) in let thm2 = SUBST [rthm,v;eql,bv] pat thm in TRANS thm2 (COND_CONV (rand(concl thm2)))) ? (let e = check `EMPTY` S in eth) in \conv tm. (let (_,[S;x]) = (check `DELETE` # I) (strip_comb tm) in let ith = ISPEC x Dins and eth = ISPEC x Edel in del_conv conv (eth,ith) x S) ? failwith `DELETE_CONV`;; % ===================================================================== % % UNION_CONV: compute the union of two sets. % % % % A call to: % % % % UNION_CONV conv "{x1,...,xn} UNION S" % % % % returns: % % % % |-{x1,...,xn} UNION S = xi INSERT ... (xk INSERT S) % % % % where for all xj in {x1,...,xn} but NOT in {xi,...,xk}, IN_CONV conv % % proves that |- xj IN S = T % % ===================================================================== % let UNION_CONV = let InU = theorem `sets` `INSERT_UNION` in let InUE = theorem `sets` `INSERT_UNION_EQ` in let Eu = CONJUNCT1 (theorem `sets` `UNION_EMPTY`) in let check st = assert (\c. fst(dest_const c) = st) in letrec strip_set tm = (let [h;t] = snd ((check `INSERT` # I) (strip_comb tm)) in (h .(strip_set t))) ? (fst(dest_const tm) = `EMPTY` => [] | fail) in let mkIN = let boolty = ":bool" in \x s. let ty = type_of x in let sty = mk_type(`set`,[ty]) in let INty = mk_type(`fun`,[ty;mk_type(`fun`,[sty;boolty])]) in mk_comb(mk_comb(mk_const(`IN`,INty),x),s) in let bv = genvar ":bool" in let itfn conv (ith,iith) x th = let _,[S;T] = strip_comb(lhs(concl th)) in (let eql = IN_CONV conv (mkIN x T) in let thm = SPEC T (SPEC S (SPEC x ith)) in let l,ins = (I # (rator o rand)) (dest_eq(concl thm)) in let v = genvar (type_of S) in let pat = mk_eq(l,mk_cond(bv,v,mk_comb(ins,v))) in let thm2 = SUBST [th,v;eql,bv] pat thm in TRANS thm2 (COND_CONV (rand(concl thm2)))) ? let v = genvar (type_of S) in let thm = SPEC T (SPEC S (SPEC x iith)) in let l,r = (I # rator) (dest_eq (concl thm)) in SUBST [th,v] (mk_eq(l,mk_comb(r,v))) thm in \conv tm. (let (_,[S1;S2]) = (check `UNION` # I) (strip_comb tm) in let els = strip_set S1 in let ty = hd(snd(dest_type(type_of S1))) in let ith = INST_TYPE [ty,":*"] InU in let iith = INST_TYPE [ty,":*"] InUE in itlist (itfn conv (ith,iith)) els (ISPEC S2 Eu)) ? failwith `UNION_CONV`;; % ===================================================================== % % INSERT_CONV: non-redundantly insert a value into a set. % % % % A call to: % % % % INSERT_CONV conv "x INSERT S" % % % % returns: % % % % |- x INSERT S = S % % % % if IN_CONV conv proves that |- x IN s = T, otherwise fail. % % % % Note that DEPTH_CONV (INSERT_CONV conv) can be used to remove % % duplicate elements from a set, but the following conversion is % % faster: % % % % letrec REDUCE_CONV conv tm = % % (SUB_CONV (REDUCE_CONV conv) THENC (TRY_CONV (INSERT_CONV conv))) % % tm;; % % ===================================================================== % let INSERT_CONV = let absth = let th = theorem `sets` `ABSORPTION` in let th1 = fst(EQ_IMP_RULE (SPECL ["x:*";"s:(*)set"] th)) in GENL ["x:*";"s:(*)set"] th1 in let check = assert (\c. fst(dest_const c) = `INSERT`) in let mkIN = let boolty = ":bool" in \x s. let ty = type_of x in let sty = mk_type(`set`,[ty]) in let INty = mk_type(`fun`,[ty;mk_type(`fun`,[sty;boolty])]) in mk_comb(mk_comb(mk_const(`IN`,INty),x),s) in let isT = let T = "T" in \thm. rand(concl thm)=T in \conv tm. (let _,[x;s] = (check # I) (strip_comb tm) in let thm = IN_CONV conv (mkIN x s) in if (isT thm) then MP (SPEC s (ISPEC x absth)) (EQT_ELIM thm) else fail) ? failwith `INSERT_CONV`;; % ===================================================================== % % IMAGE_CONV: compute the image of a function on a finite set. % % % % A call to: % % % % IMAGE_CONV conv iconv "IMAGE f {x1,...,xn}" % % % % returns: % % % % |- IMAGE f {x1,...,xn} = {y1,...,yn} % % % % where conv proves |- f xi = yi for all 1<=i<=n. The conversion also % % trys to use INSERT_CONV iconv to simplify insertion of the results % % into the set {y1,...,yn}. % % % % ===================================================================== % let IMAGE_CONV = let Ith = theorem `sets` `IMAGE_INSERT` and Eth = theorem `sets` `IMAGE_EMPTY` in let check st = assert (\c. fst(dest_const c) = st) in letrec iconv IN cnv1 cnv2 ith eth s = (let _,[x;t] = (check `INSERT` # I) (strip_comb s) in let thm1 = SPEC t (SPEC x ith) in let el = rand(rator(rand(concl thm1))) in let cth = MK_COMB(AP_TERM IN (cnv1 el),iconv IN cnv1 cnv2 ith eth t) in let thm2 = TRY_CONV (INSERT_CONV cnv2) (rand(concl cth)) in TRANS thm1 (TRANS cth thm2)) ? (if (fst(dest_const s) = `EMPTY`) then eth else fail) in \conv1 conv2 tm. (let _,[f;s] = (check `IMAGE` # I) (strip_comb tm) in let _,[_;ty] = dest_type(type_of f) in let sty = mk_type(`set`,[ty]) in let INty = mk_type(`fun`, [ty;mk_type(`fun`,[sty;sty])]) in let IN = mk_const(`INSERT`, INty) in iconv IN conv1 conv2 (ISPEC f Ith) (ISPEC f Eth) s) ? failwith `IMAGE_CONV`;; hol88-2.02.19940316/Library/sets/sets.ml0000640000212700021270000000563205145042273015626 0ustar cammcamm% ===================================================================== % % FILE : sets.ml % % DESCRIPTION : loads the library "sets" into hol. % % % % AUTHOR : T. Melham % % DATE : 90.12.01 % % REVISED : 91.01.23 % % ===================================================================== % % --------------------------------------------------------------------- % % Put the pathname to the library sets onto the search path. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/sets/` in tty_write `Updating search path`; set_search_path (union (search_path()) [path]);; % --------------------------------------------------------------------- % % Add the help files to online help. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/sets/help/entries/` in print_newline(); tty_write `Updating help search path`; set_help_search_path (union [path] (help_search_path()));; % --------------------------------------------------------------------- % % Load (or attempt to load) the theory sets % % --------------------------------------------------------------------- % if draft_mode() then (print_newline(); print_string `Declaring theory sets a new parent`; print_newline(); new_parent `sets`) else (print_newline(); load_theory `sets` ? (tty_write `Defining ML function load_sets`; loadf `load_sets`; print_newline()));; % --------------------------------------------------------------------- % % Activate parser/pretty-printer support for sets (if possible). % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `sets`)) then (define_set_abstraction_syntax `GSPEC`; define_finite_set_syntax(`EMPTY`,`INSERT`); set_flag(`print_set`,true); ());; % --------------------------------------------------------------------- % % Load compiled code if possible % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `sets`)) then let path st = library_pathname() ^ `/sets/` ^ st in load(path `gspec`, get_flag_value `print_lib`); load(path `set_ind`, get_flag_value `print_lib`); load(path `fset_conv`, get_flag_value `print_lib`);; % --------------------------------------------------------------------- % % Set up autoloading of definitions and theorems from sets.th % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `sets`)) then let defs = map fst (definitions `sets`) in map (\name. autoload_theory(`definition`,`sets`,name)) defs; let thms = map fst (theorems `sets`) in map (\name. autoload_theory(`theorem`,`sets`,name)) thms; delete_cache `sets`; ();; hol88-2.02.19940316/Library/sets/mk_sets.ml0000640000212700021270000026024605321730672016324 0ustar cammcamm% ===================================================================== % % LIBRARY: sets % % FILE: mk_sets.ml % % DESCRIPTION: a simple theory of sets % % % % AUTHOR: Philippe Leveilley % % DATE: June 9, 1989 % % % % REVISED: Tom Melham (extensively revised and extended) % % DATE: August 1990 % % ===================================================================== % % --------------------------------------------------------------------- % % Create the new theory. % % --------------------------------------------------------------------- % new_theory `sets`;; % ===================================================================== % % Type definition for (*)set. % % % % Sets are represented by predicates of type *->bool. The empty set is % % is represented by the abstraction \x.F. A set is represented by its % % characteristic function. % % ===================================================================== % % --------------------------------------------------------------------- % % Theorem stating that the representing type is non empty. % % --------------------------------------------------------------------- % let EXISTENCE_THM = TAC_PROOF(([],"?s:*->bool. (\p.T) s"), EXISTS_TAC "p:*->bool" THEN CONV_TAC BETA_CONV THEN ACCEPT_TAC TRUTH);; % --------------------------------------------------------------------- % % Now, make the type definition. % % --------------------------------------------------------------------- % let set_TY_DEF = new_type_definition(`set`,"\p:*->bool.T", EXISTENCE_THM);; % --------------------------------------------------------------------- % % Define (*)set <-> (*->bool) bijections % % --------------------------------------------------------------------- % let set_ISO_DEF = define_new_type_bijections `set_ISO_DEF` `SPEC` `CHF` set_TY_DEF;; % --------------------------------------------------------------------- % % Prove that CHF is one-to-one. % % --------------------------------------------------------------------- % let CHF_11 = REWRITE_RULE [] (prove_rep_fn_one_one set_ISO_DEF);; % --------------------------------------------------------------------- % % Remove the lambda in set_ISO_DEF % % --------------------------------------------------------------------- % let set_ISO_DEF = REWRITE_RULE [] set_ISO_DEF;; % ===================================================================== % % Membership. % % ===================================================================== % let IN_DEF = new_infix_definition (`IN_DEF`, "$IN (x:*) (s:(*)set) = CHF s x");; % --------------------------------------------------------------------- % % Axiom of specification: x IN {y | P y} iff P x % % --------------------------------------------------------------------- % let SPECIFICATION = prove_thm (`SPECIFICATION`, "!(P:*->bool) x. x IN (SPEC P) = P x", REWRITE_TAC [IN_DEF; set_ISO_DEF]);; % --------------------------------------------------------------------- % % Axiom of extension: (s = t) iff !x. x IN s = x in t % % --------------------------------------------------------------------- % let EXTENSION = prove_thm (`EXTENSION`, "!s t. (s=t) = (!x:*. x IN s = x IN t)", REPEAT GEN_TAC THEN REWRITE_TAC [IN_DEF;SYM (FUN_EQ_CONV "f:*->** = g");CHF_11]);; let NOT_EQUAL_SETS = prove_thm (`NOT_EQUAL_SETS`, "!s:(*)set. !t. ~(s = t) = ?x. x IN t = ~x IN s", PURE_ONCE_REWRITE_TAC [EXTENSION] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN ASM_CASES_TAC "(x:*) IN s" THEN ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]; STRIP_TAC THEN EXISTS_TAC "x:*" THEN ASM_CASES_TAC "(x:*) IN s" THEN ASM_REWRITE_TAC []]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let NUM_SET_WOP = prove_thm (`NUM_SET_WOP`, "!s. (?n. n IN s) = ?n. n IN s /\ (!m. m IN s ==> n <= m)", REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [let th = BETA_RULE (ISPEC "\n:num. n IN s" WOP) in IMP_RES_THEN (X_CHOOSE_THEN "N:num" STRIP_ASSUME_TAC) th THEN EXISTS_TAC "N:num" THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC [GSYM NOT_LESS]]; EXISTS_TAC "n:num" THEN FIRST_ASSUM ACCEPT_TAC]);; % ===================================================================== % % Generalized set specification. % % ===================================================================== % let GSPEC_DEF = new_definition (`GSPEC_DEF`, "GSPEC f = SPEC(\y:*. ?x:**. (y,T) = f x)");; % --------------------------------------------------------------------- % % generalized axiom of specification. % % --------------------------------------------------------------------- % let GSPECIFICATION = prove_thm (`GSPECIFICATION`, "!f. !v:*. v IN (GSPEC f) = ?x:**. v,T = f x", REPEAT GEN_TAC THEN REWRITE_TAC [GSPEC_DEF;SPECIFICATION] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REFL_TAC);; % --------------------------------------------------------------------- % % load generalized specification code. % % --------------------------------------------------------------------- % loadt `gspec.ml`;; % --------------------------------------------------------------------- % % activate generalized specification parser/pretty-printer. % % --------------------------------------------------------------------- % define_set_abstraction_syntax `GSPEC`;; set_flag(`print_set`,true);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let lemma = TAC_PROOF (([], "!s x. x IN s ==> !f:*->**. (f x) IN {f x | x IN s}"), REPEAT STRIP_TAC THEN CONV_TAC SET_SPEC_CONV THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]);; let SET_MINIMUM = prove_thm (`SET_MINIMUM`, "!s:(*)set. !M. (?x. x IN s) = ?x. x IN s /\ !y. y IN s ==> M x <= M y", REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [IMP_RES_THEN (ASSUME_TAC o ISPEC "M:*->num") lemma THEN let th = SET_SPEC_CONV "(n:num) IN {M x | (x:*) IN s}" in IMP_RES_THEN (STRIP_ASSUME_TAC o REWRITE_RULE [th]) NUM_SET_WOP THEN EXISTS_TAC "x':*" THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM (SUBST_ALL_TAC o SYM) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC "y:*" THEN CONJ_TAC THENL [REFL_TAC; FIRST_ASSUM ACCEPT_TAC]]; EXISTS_TAC "x:*" THEN FIRST_ASSUM ACCEPT_TAC]);; % ===================================================================== % % The empty set % % ===================================================================== % let EMPTY_DEF = new_definition (`EMPTY_DEF`, "EMPTY = SPEC(\x:*.F)");; let NOT_IN_EMPTY = prove_thm (`NOT_IN_EMPTY`, "!x:*.~(x IN EMPTY)", PURE_REWRITE_TAC [EMPTY_DEF;SPECIFICATION] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC);; let MEMBER_NOT_EMPTY = prove_thm (`MEMBER_NOT_EMPTY`, "!s:(*)set. (?x. x IN s) = ~(s = EMPTY)", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REWRITE_TAC [NOT_CLAUSES]);; % ===================================================================== % % The set of everything % % ===================================================================== % let UNIV_DEF = new_definition (`UNIV_DEF`,"UNIV = SPEC(\x:*.T)");; let IN_UNIV = prove_thm (`IN_UNIV`, "!x:*. x IN UNIV", GEN_TAC THEN PURE_REWRITE_TAC [UNIV_DEF;SPECIFICATION] THEN CONV_TAC BETA_CONV THEN ACCEPT_TAC TRUTH);; let UNIV_NOT_EMPTY = prove_thm (`UNIV_NOT_EMPTY`, "~(UNIV:(*)set = EMPTY)", REWRITE_TAC [EXTENSION;IN_UNIV;NOT_IN_EMPTY]);; let EMPTY_NOT_UNIV = prove_thm (`EMPTY_NOT_UNIV`, "~(EMPTY = (UNIV:(*)set))", REWRITE_TAC [EXTENSION;IN_UNIV;NOT_IN_EMPTY]);; let EQ_UNIV = prove_thm (`EQ_UNIV`, "(!x:*. x IN s) = (s = UNIV)", REWRITE_TAC [EXTENSION;IN_UNIV]);; % ===================================================================== % % Set inclusion. % % ===================================================================== % let SUBSET_DEF = new_infix_definition (`SUBSET_DEF`, "SUBSET s t = !x:*. x IN s ==> x IN t");; let SUBSET_TRANS = prove_thm (`SUBSET_TRANS`, "!(s:(*)set) t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u", REWRITE_TAC [SUBSET_DEF] THEN REPEAT STRIP_TAC THEN REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN FIRST_ASSUM ACCEPT_TAC);; let SUBSET_REFL = prove_thm (`SUBSET_REFL`, "!(s:(*)set). s SUBSET s", REWRITE_TAC[SUBSET_DEF]);; let SUBSET_ANTISYM = prove_thm (`SUBSET_ANTISYM`, "!(s:(*)set) t. (s SUBSET t) /\ (t SUBSET s) ==> (s = t)", REWRITE_TAC [SUBSET_DEF; EXTENSION] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let EMPTY_SUBSET = prove_thm (`EMPTY_SUBSET`, "!s:(*)set. EMPTY SUBSET s", REWRITE_TAC [SUBSET_DEF;NOT_IN_EMPTY]);; let SUBSET_EMPTY = prove_thm (`SUBSET_EMPTY`, "!s:(*)set. s SUBSET EMPTY = (s = EMPTY)", PURE_REWRITE_TAC [SUBSET_DEF;NOT_IN_EMPTY] THEN REWRITE_TAC [EXTENSION;NOT_IN_EMPTY]);; let SUBSET_UNIV = prove_thm (`SUBSET_UNIV`, "!s:(*)set. s SUBSET UNIV", REWRITE_TAC [SUBSET_DEF;IN_UNIV]);; let UNIV_SUBSET = prove_thm (`UNIV_SUBSET`, "!s:(*)set. UNIV SUBSET s = (s = UNIV)", REWRITE_TAC [SUBSET_DEF;IN_UNIV;EXTENSION]);; % ===================================================================== % % Proper subset. % % ===================================================================== % let PSUBSET_DEF = new_infix_definition (`PSUBSET_DEF`, "PSUBSET (s:(*)set) t = (s SUBSET t /\ ~(s = t))");; let PSUBSET_TRANS = prove_thm (`PSUBSET_TRANS`, "!s:(*)set. !t u. (s PSUBSET t /\ t PSUBSET u) ==> (s PSUBSET u)", PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [IMP_RES_TAC SUBSET_TRANS; DISCH_THEN SUBST_ALL_TAC THEN IMP_RES_TAC SUBSET_ANTISYM THEN RES_TAC]);; let PSUBSET_IRREFL = prove_thm (`PSUBSET_IRREFL`, "!s:(*)set. ~(s PSUBSET s)", REWRITE_TAC [PSUBSET_DEF;SUBSET_REFL]);; let NOT_PSUBSET_EMPTY = prove_thm (`NOT_PSUBSET_EMPTY`, "!s:(*)set. ~(s PSUBSET EMPTY)", REWRITE_TAC [PSUBSET_DEF;SUBSET_EMPTY;NOT_AND]);; let NOT_UNIV_PSUBSET = prove_thm (`NOT_UNIV_PSUBSET`, "!s:(*)set. ~(UNIV PSUBSET s)", REWRITE_TAC [PSUBSET_DEF;UNIV_SUBSET;DE_MORGAN_THM] THEN GEN_TAC THEN CONV_TAC (RAND_CONV SYM_CONV) THEN PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN MATCH_ACCEPT_TAC EXCLUDED_MIDDLE);; let PSUBSET_UNIV = prove_thm (`PSUBSET_UNIV`, "!s:(*)set. (s PSUBSET UNIV) = ?x:*. ~(x IN s)", REWRITE_TAC [PSUBSET_DEF;SUBSET_UNIV;EXTENSION;IN_UNIV] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN REFL_TAC);; % ===================================================================== % % Union % % ===================================================================== % let UNION_DEF = new_infix_definition (`UNION_DEF`, "UNION s t = {x:* | x IN s \/ x IN t}");; let IN_UNION = prove_thm (`IN_UNION`, "!s t (x:*). x IN (s UNION t) = x IN s \/ x IN t", PURE_ONCE_REWRITE_TAC [UNION_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let UNION_ASSOC = prove_thm (`UNION_ASSOC`, "!(s:(*)set) t u. (s UNION t) UNION u = s UNION (t UNION u)", REWRITE_TAC [EXTENSION; IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let UNION_IDEMPOT = prove_thm (`UNION_IDEMPOT`, "!(s:(*)set). s UNION s = s", REWRITE_TAC[EXTENSION; IN_UNION]);; let UNION_COMM = prove_thm (`UNION_COMM`, "!(s:(*)set) t. s UNION t = t UNION s", REWRITE_TAC[EXTENSION; IN_UNION] THEN REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC DISJ_SYM);; let SUBSET_UNION = prove_thm (`SUBSET_UNION`, "(!s:(*)set. !t. s SUBSET (s UNION t)) /\ (!s:(*)set. !t. s SUBSET (t UNION s))", PURE_REWRITE_TAC [SUBSET_DEF;IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; let SUBSET_UNION_ABSORPTION = prove_thm (`SUBSET_UNION_ABSORPTION`, "!s:(*)set. !t. s SUBSET t = (s UNION t = t)", REWRITE_TAC [SUBSET_DEF;EXTENSION;IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [RES_TAC;ASM_REWRITE_TAC[];RES_TAC]);; let UNION_EMPTY = prove_thm (`UNION_EMPTY`, "(!s:(*)set. EMPTY UNION s = s) /\ (!s:(*)set. s UNION EMPTY = s)", REWRITE_TAC [IN_UNION;EXTENSION;NOT_IN_EMPTY]);; let UNION_UNIV = prove_thm (`UNION_UNIV`, "(!s:(*)set. UNIV UNION s = UNIV) /\ (!s:(*)set. s UNION UNIV = UNIV)", REWRITE_TAC [IN_UNION;EXTENSION;IN_UNIV]);; let EMPTY_UNION = prove_thm (`EMPTY_UNION`, "!s:(*)set. !t. (s UNION t = EMPTY) = ((s = EMPTY) /\ (t = EMPTY))", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_UNION;DE_MORGAN_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC);; % ===================================================================== % % Intersection % % ===================================================================== % let INTER_DEF = new_infix_definition (`INTER_DEF`, "INTER s t = {x:* | x IN s /\ x IN t}");; let IN_INTER = prove_thm (`IN_INTER`, "!s t (x:*). x IN (s INTER t) = x IN s /\ x IN t", PURE_ONCE_REWRITE_TAC [INTER_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let INTER_ASSOC = prove_thm (`INTER_ASSOC`, "!(s:(*)set) t u. (s INTER t) INTER u = s INTER (t INTER u)", REWRITE_TAC [EXTENSION; IN_INTER; CONJ_ASSOC]);; let INTER_IDEMPOT = prove_thm (`INTER_IDEMPOT`, "!(s:(*)set). s INTER s = s", REWRITE_TAC[EXTENSION; IN_INTER]);; let INTER_COMM = prove_thm (`INTER_COMM`, "!(s:(*)set) t. s INTER t = t INTER s", REWRITE_TAC[EXTENSION; IN_INTER] THEN REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC CONJ_SYM);; let INTER_SUBSET = prove_thm (`INTER_SUBSET`, "(!s:(*)set. !t. (s INTER t) SUBSET s) /\ (!s:(*)set. !t. (t INTER s) SUBSET s)", PURE_REWRITE_TAC [SUBSET_DEF;IN_INTER] THEN REPEAT STRIP_TAC);; let SUBSET_INTER_ABSORPTION = prove_thm (`SUBSET_INTER_ABSORPTION`, "!s:(*)set. !t. s SUBSET t = (s INTER t = s)", REWRITE_TAC [SUBSET_DEF;EXTENSION;IN_INTER] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM ACCEPT_TAC; RES_TAC; RES_TAC]);; let INTER_EMPTY = prove_thm (`INTER_EMPTY`, "(!s:(*)set. EMPTY INTER s = EMPTY) /\ (!s:(*)set. s INTER EMPTY = EMPTY)", REWRITE_TAC [IN_INTER;EXTENSION;NOT_IN_EMPTY]);; let INTER_UNIV = prove_thm (`INTER_UNIV`, "(!s:(*)set. UNIV INTER s = s) /\ (!s:(*)set. s INTER UNIV = s)", REWRITE_TAC [IN_INTER;EXTENSION;IN_UNIV]);; % ===================================================================== % % Distributivity % % ===================================================================== % let UNION_OVER_INTER = prove_thm (`UNION_OVER_INTER`, "!s:(*)set. !t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u)", REWRITE_TAC [EXTENSION;IN_INTER;IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let INTER_OVER_UNION = prove_thm (`INTER_OVER_UNION`, "!s:(*)set. !t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u)", REWRITE_TAC [EXTENSION;IN_INTER;IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; % ===================================================================== % % Disjoint sets. % % ===================================================================== % let DISJOINT_DEF = new_definition (`DISJOINT_DEF`, "DISJOINT (s:(*)set) t = ((s INTER t) = EMPTY)");; let IN_DISJOINT = prove_thm (`IN_DISJOINT`, "!s:(*)set. !t. DISJOINT s t = ~(?x. x IN s /\ x IN t)", REWRITE_TAC [DISJOINT_DEF;EXTENSION;IN_INTER;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let DISJOINT_SYM = prove_thm (`DISJOINT_SYM`, "!s:(*)set. !t. DISJOINT s t = DISJOINT t s", PURE_ONCE_REWRITE_TAC [DISJOINT_DEF] THEN REPEAT GEN_TAC THEN SUBST1_TAC (SPECL ["s:(*)set";"t:(*)set"] INTER_COMM) THEN REFL_TAC);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_EMPTY = prove_thm (`DISJOINT_EMPTY`, "!s:(*)set. DISJOINT EMPTY s /\ DISJOINT s EMPTY", REWRITE_TAC [DISJOINT_DEF;INTER_EMPTY]);; let DISJOINT_EMPTY_REFL = prove_thm (`DISJOINT_EMPTY_REFL`, "!s:(*)set. (s = EMPTY) = (DISJOINT s s)", REWRITE_TAC [DISJOINT_DEF;INTER_IDEMPOT]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_UNION = prove_thm (`DISJOINT_UNION`, "!s:(*)set. !t u. DISJOINT (s UNION t) u = DISJOINT s u /\ DISJOINT t u", REWRITE_TAC [IN_DISJOINT;IN_UNION] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV AND_FORALL_CONV) THEN REWRITE_TAC [DE_MORGAN_THM;RIGHT_AND_OVER_OR] THEN REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN (\th. GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "x:*" th)) THEN ASM_REWRITE_TAC []);; % ===================================================================== % % Set difference % % ===================================================================== % let DIFF_DEF = new_infix_definition (`DIFF_DEF`, "DIFF s t = {x:* | x IN s /\ ~ x IN t}");; let IN_DIFF = prove_thm (`IN_DIFF`, "!(s:(*)set) t x. x IN (s DIFF t) = x IN s /\ ~x IN t", REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [DIFF_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REFL_TAC);; let DIFF_EMPTY = prove_thm (`DIFF_EMPTY`, "!s:(*)set. s DIFF EMPTY = s", GEN_TAC THEN REWRITE_TAC [NOT_IN_EMPTY;IN_DIFF;EXTENSION]);; let EMPTY_DIFF = prove_thm (`EMPTY_DIFF`, "!s:(*)set. EMPTY DIFF s = EMPTY", GEN_TAC THEN REWRITE_TAC [NOT_IN_EMPTY;IN_DIFF;EXTENSION]);; let DIFF_UNIV = prove_thm (`DIFF_UNIV`, "!s:(*)set. s DIFF UNIV = EMPTY", GEN_TAC THEN REWRITE_TAC [NOT_IN_EMPTY;IN_DIFF;IN_UNIV;EXTENSION]);; let DIFF_DIFF = prove_thm (`DIFF_DIFF`, "!s:(*)set. !t. (s DIFF t) DIFF t = s DIFF t", REWRITE_TAC [EXTENSION;IN_DIFF;SYM(SPEC_ALL CONJ_ASSOC)]);; let DIFF_EQ_EMPTY = prove_thm (`DIFF_EQ_EMPTY`, "!s:(*)set. s DIFF s = EMPTY", REWRITE_TAC [EXTENSION;IN_DIFF;NOT_IN_EMPTY;DE_MORGAN_THM] THEN PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN REWRITE_TAC [EXCLUDED_MIDDLE]);; % ===================================================================== % % The insertion function. % % ===================================================================== % let INSERT_DEF = new_infix_definition (`INSERT_DEF`, "INSERT (x:*) s = {y | (y = x) \/ y IN s}");; % --------------------------------------------------------------------- % % Set up the {x1,...,xn} notation. % % --------------------------------------------------------------------- % define_finite_set_syntax(`EMPTY`,`INSERT`);; % --------------------------------------------------------------------- % % Theorems about INSERT. % % --------------------------------------------------------------------- % let IN_INSERT = prove_thm (`IN_INSERT`, "!x:*. !y s. x IN (y INSERT s) = ((x=y) \/ x IN s)", PURE_ONCE_REWRITE_TAC [INSERT_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let COMPONENT = prove_thm (`COMPONENT`, "!x:*. !s. x IN (x INSERT s)", REWRITE_TAC [IN_INSERT]);; let SET_CASES = prove_thm (`SET_CASES`, "!s:(*)set. (s = EMPTY) \/ ?x:*. ?t. ((s = x INSERT t) /\ ~x IN t)", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY] THEN GEN_TAC THEN DISJ_CASES_THEN MP_TAC (SPEC "?x:*. x IN s" EXCLUDED_MIDDLE) THENL [STRIP_TAC THEN DISJ2_TAC THEN MAP_EVERY EXISTS_TAC ["x:*";"{y:* | y IN s /\ ~(y = x)}"] THEN REWRITE_TAC [IN_INSERT] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN ASM_REWRITE_TAC [] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[EXCLUDED_MIDDLE]; CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN STRIP_TAC THEN DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; let DECOMPOSITION = prove_thm (`DECOMPOSITION`, "!s:(*)set. !x. x IN s = ?t. (s = x INSERT t) /\ ~x IN t", REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN EXISTS_TAC "{y:* | y IN s /\ ~(y = x)}" THEN ASM_REWRITE_TAC [EXTENSION;IN_INSERT] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REWRITE_TAC [] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC [EXCLUDED_MIDDLE]; STRIP_TAC THEN ASM_REWRITE_TAC [IN_INSERT]]);; let ABSORPTION = prove_thm (`ABSORPTION`, "!x:*. !s. (x IN s) = (x INSERT s = s)", REWRITE_TAC [EXTENSION;IN_INSERT] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC [] THEN FIRST_ASSUM (\th g. PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL th)] g) THEN DISJ1_TAC THEN REFL_TAC);; let INSERT_INSERT = prove_thm (`INSERT_INSERT`, "!x:*. !s. x INSERT (x INSERT s) = x INSERT s", REWRITE_TAC [IN_INSERT;EXTENSION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let INSERT_COMM = prove_thm (`INSERT_COMM`, "!x:*. !y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)", REWRITE_TAC [IN_INSERT;EXTENSION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let INSERT_UNIV = prove_thm (`INSERT_UNIV`, "!x:*. x INSERT UNIV = UNIV", REWRITE_TAC [EXTENSION;IN_INSERT;IN_UNIV]);; let NOT_INSERT_EMPTY = prove_thm (`NOT_INSERT_EMPTY`, "!x:*. !s. ~(x INSERT s = EMPTY)", REWRITE_TAC [EXTENSION;IN_INSERT;NOT_IN_EMPTY;IN_UNION] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REPEAT GEN_TAC THEN EXISTS_TAC "x:*" THEN REWRITE_TAC []);; let NOT_EMPTY_INSERT = prove_thm (`NOT_EMPTY_INSERT`, "!x:*. !s. ~(EMPTY = x INSERT s)", REWRITE_TAC [EXTENSION;IN_INSERT;NOT_IN_EMPTY;IN_UNION] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REPEAT GEN_TAC THEN EXISTS_TAC "x:*" THEN REWRITE_TAC []);; let INSERT_UNION = prove_thm (`INSERT_UNION`, "!x:*. !s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t))", REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [EXTENSION;IN_UNION;IN_INSERT] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC []);; let INSERT_UNION_EQ = prove_thm (`INSERT_UNION_EQ`, "!x:*. !s t. (x INSERT s) UNION t = x INSERT (s UNION t)", REPEAT GEN_TAC THEN REWRITE_TAC [EXTENSION;IN_UNION;IN_INSERT;DISJ_ASSOC]);; let INSERT_INTER = prove_thm (`INSERT_INTER`, "!x:*. !s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t)", REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [EXTENSION;IN_INTER;IN_INSERT] THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC []; STRIP_TAC THEN ASM_REWRITE_TAC []; PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN DISCH_THEN (CONJUNCTS_THEN MP_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC []; STRIP_TAC THEN ASM_REWRITE_TAC []]);; let DISJOINT_INSERT = prove_thm (`DISJOINT_INSERT`, "!(x:*) s t. DISJOINT (x INSERT s) t = (DISJOINT s t) /\ ~(x IN t)", REWRITE_TAC [IN_DISJOINT;IN_INSERT] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC [DE_MORGAN_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [(let v = genvar ":*" in let GTAC = X_GEN_TAC v in DISCH_THEN (\th. CONJ_TAC THENL [GTAC;ALL_TAC] THEN MP_TAC th) THENL [DISCH_THEN (STRIP_ASSUME_TAC o SPEC v) THEN ASM_REWRITE_TAC []; DISCH_THEN (MP_TAC o SPEC "x:*") THEN REWRITE_TAC[]]); REPEAT STRIP_TAC THEN ASM_CASES_TAC "x':* = x" THENL [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]]);; let INSERT_SUBSET = prove_thm (`INSERT_SUBSET`, "!x:*. !s t. (x INSERT s) SUBSET t = (x IN t /\ s SUBSET t)", REWRITE_TAC [IN_INSERT;SUBSET_DEF] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM MATCH_MP_TAC THEN DISJ1_TAC THEN REFL_TAC; FIRST_ASSUM MATCH_MP_TAC THEN DISJ2_TAC THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC []; RES_TAC]);; let SUBSET_INSERT = prove_thm (`SUBSET_INSERT`, "!x:*. !s. ~(x IN s) ==> !t. s SUBSET (x INSERT t) = s SUBSET t", PURE_REWRITE_TAC [SUBSET_DEF;IN_INSERT] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN let tac th g = SUBST_ALL_TAC th g ? STRIP_ASSUME_TAC th g in RES_THEN (STRIP_THM_THEN tac) THEN RES_TAC; REPEAT STRIP_TAC THEN DISJ2_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; let INSERT_DIFF = prove_thm (`INSERT_DIFF`, "!s t. !x:*. (x INSERT s) DIFF t = (x IN t => s DIFF t | (x INSERT (s DIFF t)))", REPEAT GEN_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC [EXTENSION;IN_DIFF;IN_INSERT] THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_ASSUM (\th g. SUBST_ALL_TAC th g) THEN RES_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[]]; ASM_REWRITE_TAC [EXTENSION;IN_DIFF;IN_INSERT] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC [] THENL [FIRST_ASSUM (\th g. SUBST_ALL_TAC th g) THEN RES_TAC;RES_TAC]]);; % ===================================================================== % % Removal of an element % % ===================================================================== % let DELETE_DEF = new_infix_definition (`DELETE_DEF`, "DELETE s (x:*) = s DIFF {x}");; let IN_DELETE = prove_thm (`IN_DELETE`, "!s. !x:*. !y. x IN (s DELETE y) = (x IN s /\ ~(x = y))", PURE_ONCE_REWRITE_TAC [DELETE_DEF] THEN REWRITE_TAC [IN_DIFF;IN_INSERT;NOT_IN_EMPTY]);; let DELETE_NON_ELEMENT = prove_thm (`DELETE_NON_ELEMENT`, "!x:*. !s. ~x IN s = ((s DELETE x) = s)", PURE_REWRITE_TAC [EXTENSION;IN_DELETE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM (\th g. SUBST_ALL_TAC th g ? NO_TAC g) THEN RES_TAC; RES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REFL_TAC]);; let IN_DELETE_EQ = prove_thm (`IN_DELETE_EQ`, "!s x. !x':*. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x))", REPEAT GEN_TAC THEN ASM_CASES_TAC "x:* = x'" THENL [ASM_REWRITE_TAC []; FIRST_ASSUM (ASSUME_TAC o NOT_EQ_SYM) THEN ASM_REWRITE_TAC [IN_DELETE]]);; let EMPTY_DELETE = prove_thm (`EMPTY_DELETE`, "!x:*. EMPTY DELETE x = EMPTY", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_DELETE]);; let DELETE_DELETE = prove_thm (`DELETE_DELETE`, "!x:*. !s. (s DELETE x) DELETE x = s DELETE x", REWRITE_TAC [EXTENSION;IN_DELETE;SYM(SPEC_ALL CONJ_ASSOC)]);; let DELETE_COMM = prove_thm (`DELETE_COMM`, "!x:*. !y. !s. (s DELETE x) DELETE y = (s DELETE y) DELETE x", PURE_REWRITE_TAC [EXTENSION;IN_DELETE;CONJ_ASSOC] THEN REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let DELETE_SUBSET = prove_thm (`DELETE_SUBSET`, "!x:*. !s. (s DELETE x) SUBSET s", PURE_REWRITE_TAC [SUBSET_DEF;IN_DELETE] THEN REPEAT STRIP_TAC);; let SUBSET_DELETE = prove_thm (`SUBSET_DELETE`, "!x:*. !s t. s SUBSET (t DELETE x) = (~(x IN s) /\ (s SUBSET t))", REWRITE_TAC [SUBSET_DEF;IN_DELETE;EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THENL [ASSUME_TAC (REFL "x:*") THEN RES_TAC; RES_TAC]; REPEAT STRIP_TAC THENL [RES_TAC; FIRST_ASSUM (\th g. SUBST_ALL_TAC th g) THEN RES_TAC]]);; let SUBSET_INSERT_DELETE = prove_thm (`SUBSET_INSERT_DELETE`, "!x:*. !s t. s SUBSET (x INSERT t) = ((s DELETE x) SUBSET t)", REPEAT GEN_TAC THEN REWRITE_TAC [SUBSET_DEF;IN_INSERT;IN_DELETE] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [RES_TAC THEN RES_TAC; ASM_CASES_TAC "x':* = x" THEN ASM_REWRITE_TAC[] THEN RES_TAC]);; let DIFF_INSERT = prove_thm (`DIFF_INSERT`, "!s t. !x:*. s DIFF (x INSERT t) = (s DELETE x) DIFF t", PURE_REWRITE_TAC [EXTENSION;IN_DIFF;IN_INSERT;IN_DELETE] THEN REWRITE_TAC [DE_MORGAN_THM;CONJ_ASSOC]);; let PSUBSET_INSERT_SUBSET = prove_thm (`PSUBSET_INSERT_SUBSET`, "!s t. s PSUBSET t = ?x:*. ~(x IN s) /\ (x INSERT s) SUBSET t", PURE_REWRITE_TAC [PSUBSET_DEF;NOT_EQUAL_SETS] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ASM_CASES_TAC "(x:*) IN s" THENL [ASM_CASES_TAC "(x:*) IN t" THENL [RES_TAC; IMP_RES_TAC SUBSET_DEF THEN RES_TAC]; EXISTS_TAC "x:*" THEN RES_TAC THEN ASM_REWRITE_TAC [INSERT_SUBSET]]; IMP_RES_TAC INSERT_SUBSET; IMP_RES_TAC INSERT_SUBSET THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]]);; let lemma = TAC_PROOF(([], "~(a:bool = b) = (b = ~a)"), BOOL_CASES_TAC "b:bool" THEN REWRITE_TAC[]);; let PSUBSET_MEMBER = prove_thm (`PSUBSET_MEMBER`, "!s:(*)set. !t. s PSUBSET t = (s SUBSET t /\ ?y. y IN t /\ ~y IN s)", REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN PURE_ONCE_REWRITE_TAC [EXTENSION;SUBSET_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN PURE_ONCE_REWRITE_TAC [lemma] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [RES_TAC; EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC [] THEN ASM_CASES_TAC "(x:*) IN s" THENL [RES_TAC THEN RES_TAC;FIRST_ASSUM ACCEPT_TAC]; RES_TAC; EXISTS_TAC "y:*" THEN ASM_REWRITE_TAC[]]);; let DELETE_INSERT = prove_thm (`DELETE_INSERT`, "!x:*. !y s. (x INSERT s) DELETE y = ((x=y) => s DELETE y | x INSERT (s DELETE y))", REWRITE_TAC [EXTENSION;IN_DELETE;IN_INSERT] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN DISCH_TAC THEN let tac th g = SUBST_ALL_TAC th g ? ASSUME_TAC th g in DISCH_THEN (STRIP_THM_THEN tac) THENL [ASM_REWRITE_TAC [IN_INSERT]; COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE;IN_INSERT]]; COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE;IN_INSERT] THENL [STRIP_TAC THEN ASM_REWRITE_TAC []; STRIP_TAC THEN ASM_REWRITE_TAC []]]);; let INSERT_DELETE = prove_thm (`INSERT_DELETE`, "!x:*. !s. x IN s ==> (x INSERT (s DELETE x) = s)", PURE_REWRITE_TAC [EXTENSION;IN_INSERT;IN_DELETE] THEN REPEAT GEN_TAC THEN DISCH_THEN (\th. GEN_TAC THEN MP_TAC th) THEN ASM_CASES_TAC "x':* = x" THEN ASM_REWRITE_TAC[]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DELETE_INTER = prove_thm (`DELETE_INTER`, "!s t. !x:*. (s DELETE x) INTER t = (s INTER t) DELETE x", PURE_ONCE_REWRITE_TAC [EXTENSION] THEN REPEAT GEN_TAC THEN REWRITE_TAC [IN_INTER;IN_DELETE] THEN EQ_TAC THEN REPEAT STRIP_TAC THEN FIRST [FIRST_ASSUM ACCEPT_TAC;RES_TAC]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_DELETE_SYM = prove_thm (`DISJOINT_DELETE_SYM`, "!s t. !x:*. DISJOINT (s DELETE x) t = DISJOINT (t DELETE x) s", REWRITE_TAC [DISJOINT_DEF;EXTENSION;NOT_IN_EMPTY] THEN REWRITE_TAC [IN_INTER;IN_DELETE;DE_MORGAN_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THEN let X = "X:*" in DISCH_THEN (\th. X_GEN_TAC X THEN STRIP_ASSUME_TAC (SPEC X th)) THEN ASM_REWRITE_TAC []);; % ===================================================================== % % Choice % % ===================================================================== % let CHOICE_EXISTS = TAC_PROOF (([], "?CHOICE. !s:(*)set. ~(s = EMPTY) ==> (CHOICE s) IN s"), REWRITE_TAC [EXTENSION;NOT_IN_EMPTY] THEN EXISTS_TAC "\s. @x:*. x IN s" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV SELECT_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REWRITE_TAC []);; let CHOICE_DEF = new_specification `CHOICE_DEF` [`constant`,`CHOICE`] CHOICE_EXISTS;; % ===================================================================== % % The REST of a set after removing a chosen element. % % ===================================================================== % let REST_DEF = new_definition (`REST_DEF`, "REST (s:(*)set) = s DELETE (CHOICE s)");; let CHOICE_NOT_IN_REST = prove_thm (`CHOICE_NOT_IN_REST`, "!s:(*)set. ~(CHOICE s) IN (REST s)", REWRITE_TAC [IN_DELETE;REST_DEF]);; let CHOICE_INSERT_REST = prove_thm (`CHOICE_INSERT_REST`, "!s:(*)set. ~(s = EMPTY) ==> (((CHOICE s) INSERT (REST s)) = s)", REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [EXTENSION;IN_INSERT;REST_DEF;IN_DELETE] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [IMP_RES_TAC CHOICE_DEF THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC [EXCLUDED_MIDDLE]]);; let REST_SUBSET = prove_thm (`REST_SUBSET`, "!s:(*)set. (REST s) SUBSET s", REWRITE_TAC [SUBSET_DEF;REST_DEF;IN_DELETE] THEN REPEAT STRIP_TAC);; let lemma = TAC_PROOF(([], "(P /\ Q = P) = (P ==> Q)"), BOOL_CASES_TAC "P:bool" THEN REWRITE_TAC[]);; let REST_PSUBSET = prove_thm (`REST_PSUBSET`, "!s:(*)set. ~(s = EMPTY) ==> (REST s) PSUBSET s", REWRITE_TAC [PSUBSET_DEF;REST_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [EXTENSION;REST_DEF;IN_DELETE] THEN CONV_TAC NOT_FORALL_CONV THEN REWRITE_TAC [DE_MORGAN_THM;lemma;NOT_IMP] THEN EXISTS_TAC "CHOICE (s:(*)set)" THEN IMP_RES_TAC CHOICE_DEF THEN ASM_REWRITE_TAC []);; % ===================================================================== % % Singleton set. % % ===================================================================== % let SING_DEF = new_definition (`SING_DEF`, "SING s = ?x:*. s = {x}");; let SING = prove_thm (`SING`, "!x:*. SING {x}", PURE_ONCE_REWRITE_TAC [SING_DEF] THEN GEN_TAC THEN EXISTS_TAC "x:*" THEN REFL_TAC);; let IN_SING = prove_thm (`IN_SING`, "!x y. x IN {y:*} = (x = y)", REWRITE_TAC [IN_INSERT;NOT_IN_EMPTY]);; let NOT_SING_EMPTY = prove_thm (`NOT_SING_EMPTY`, "!x:*. ~({x} = EMPTY)", REWRITE_TAC [EXTENSION;IN_SING;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN EXISTS_TAC "x:*" THEN REWRITE_TAC[]);; let NOT_EMPTY_SING = prove_thm (`NOT_EMPTY_SING`, "!x:*. ~(EMPTY = {x})", REWRITE_TAC [EXTENSION;IN_SING;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN EXISTS_TAC "x:*" THEN REWRITE_TAC[]);; let EQUAL_SING = prove_thm (`EQUAL_SING`, "!x:*. !y. ({x} = {y}) = (x = y)", REWRITE_TAC [EXTENSION;IN_SING] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (\th. REWRITE_TAC [SYM(SPEC_ALL th)]); DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC]);; let DISJOINT_SING_EMPTY = prove_thm (`DISJOINT_SING_EMPTY`, "!x:*. DISJOINT {x} EMPTY", REWRITE_TAC [DISJOINT_DEF;INTER_EMPTY]);; let INSERT_SING_UNION = prove_thm (`INSERT_SING_UNION`, "!s. !x:*. x INSERT s = {x} UNION s", REWRITE_TAC [EXTENSION;IN_INSERT;IN_UNION;NOT_IN_EMPTY]);; let SING_DELETE = prove_thm (`SING_DELETE`, "!x:*. {x} DELETE x = EMPTY", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_DELETE;IN_INSERT] THEN PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN REWRITE_TAC [DE_MORGAN_THM;EXCLUDED_MIDDLE]);; let DELETE_EQ_SING = prove_thm (`DELETE_EQ_SING`, "!s. !x:*. (x IN s) ==> ((s DELETE x = EMPTY) = (s = {x}))", PURE_ONCE_REWRITE_TAC [EXTENSION] THEN REWRITE_TAC [NOT_IN_EMPTY;DE_MORGAN_THM;IN_INSERT;IN_DELETE] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM (\th g. STRIP_ASSUME_TAC (SPEC "x':*" th) g) THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC; let th = PURE_ONCE_REWRITE_RULE [DISJ_SYM] EXCLUDED_MIDDLE in DISCH_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC [th]]);; let CHOICE_SING = prove_thm (`CHOICE_SING`, "!x:*. CHOICE {x} = x", GEN_TAC THEN MP_TAC (MATCH_MP CHOICE_DEF (SPEC "x:*" NOT_SING_EMPTY)) THEN REWRITE_TAC [IN_SING]);; let REST_SING = prove_thm (`REST_SING`, "!x:*. REST {x} = EMPTY", REWRITE_TAC [CHOICE_SING;REST_DEF;SING_DELETE]);; let SING_IFF_EMPTY_REST = prove_thm (`SING_IFF_EMPTY_REST`, "!s:(*)set. SING s = ~(s = EMPTY) /\ (REST s = EMPTY)", PURE_ONCE_REWRITE_TAC [SING_DEF] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_REWRITE_TAC [REST_SING] THEN REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_INSERT] THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC "x:*" THEN REWRITE_TAC []; EXISTS_TAC "CHOICE s:*" THEN IMP_RES_THEN (SUBST1_TAC o SYM) CHOICE_INSERT_REST THEN ASM_REWRITE_TAC [EXTENSION;IN_SING;CHOICE_SING]]);; % ===================================================================== % % The image of a function on a set. % % ===================================================================== % let IMAGE_DEF = new_definition (`IMAGE_DEF`, "IMAGE (f:*->**) s = {f x | x IN s}");; let IN_IMAGE = prove_thm (`IN_IMAGE`, "!y:**. !s f. (y IN (IMAGE f s)) = ?x:*. (y = f x) /\ x IN s", PURE_ONCE_REWRITE_TAC [IMAGE_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let IMAGE_IN = prove_thm (`IMAGE_IN`, "!x s. (x IN s) ==> !(f:*->**). f x IN (IMAGE f s)", PURE_ONCE_REWRITE_TAC [IN_IMAGE] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x:*" THEN CONJ_TAC THENL [REFL_TAC; FIRST_ASSUM ACCEPT_TAC]);; let IMAGE_EMPTY = prove_thm (`IMAGE_EMPTY`, "!f:*->**. IMAGE f EMPTY = EMPTY", REWRITE_TAC[EXTENSION;IN_IMAGE;NOT_IN_EMPTY]);; let IMAGE_ID = prove_thm (`IMAGE_ID`, "!s:* set. IMAGE (\x:*.x) s = s", REWRITE_TAC [EXTENSION;IN_IMAGE] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ALL_TAC;EXISTS_TAC "x:*"] THEN ASM_REWRITE_TAC []);; let IMAGE_COMPOSE = prove_thm (`IMAGE_COMPOSE`, "!f:**->***. !g:*->**. !s. IMAGE (f o g) s = IMAGE f (IMAGE g s)", PURE_REWRITE_TAC [EXTENSION;IN_IMAGE;o_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [EXISTS_TAC "g (x':*):**" THEN CONJ_TAC THENL [ALL_TAC;EXISTS_TAC "x':*"] THEN ASM_REWRITE_TAC []; EXISTS_TAC "x'':*" THEN ASM_REWRITE_TAC[]]);; let IMAGE_INSERT = prove_thm (`IMAGE_INSERT`, "!(f:*->**) x s. IMAGE f (x INSERT s) = f x INSERT (IMAGE f s)", PURE_REWRITE_TAC [EXTENSION;IN_INSERT;IN_IMAGE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ALL_TAC;DISJ2_TAC THEN EXISTS_TAC "x'':*"; EXISTS_TAC "x:*";EXISTS_TAC "x'':*"] THEN ASM_REWRITE_TAC[]);; let IMAGE_EQ_EMPTY = prove_thm (`IMAGE_EQ_EMPTY`, "!s. !f:*->**. ((IMAGE f s) = EMPTY) = (s = EMPTY)", GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "s:(*)set" SET_CASES) THEN ASM_REWRITE_TAC [IMAGE_EMPTY;IMAGE_INSERT;NOT_INSERT_EMPTY]);; let IMAGE_DELETE = prove_thm (`IMAGE_DELETE`, "!(f:*->**) x s. ~(x IN s) ==> (IMAGE f (s DELETE x) = (IMAGE f s))", REPEAT GEN_TAC THEN STRIP_TAC THEN PURE_REWRITE_TAC [EXTENSION;IN_DELETE;IN_IMAGE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN EXISTS_TAC "x'':*" THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC);; let IMAGE_UNION = prove_thm (`IMAGE_UNION`, "!(f:*->**) s t. IMAGE f (s UNION t) = (IMAGE f s) UNION (IMAGE f t)", PURE_REWRITE_TAC [EXTENSION;IN_UNION;IN_IMAGE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [DISJ1_TAC;DISJ2_TAC;ALL_TAC;ALL_TAC] THEN EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []);; let IMAGE_SUBSET = prove_thm (`IMAGE_SUBSET`, "!s t. (s SUBSET t) ==> !f:*->**. (IMAGE f s) SUBSET (IMAGE f t)", PURE_REWRITE_TAC [SUBSET_DEF;IN_IMAGE] THEN REPEAT STRIP_TAC THEN RES_TAC THEN EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []);; let IMAGE_INTER = prove_thm (`IMAGE_INTER`, "!(f:*->**) s t. IMAGE f (s INTER t) SUBSET (IMAGE f s INTER IMAGE f t)", REPEAT GEN_TAC THEN REWRITE_TAC [SUBSET_DEF;IN_IMAGE;IN_INTER] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x':*" THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC);; % ===================================================================== % % Injective functions on a set. % % ===================================================================== % let INJ_DEF = new_definition (`INJ_DEF`, "INJ (f:*->**) s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. (x IN s /\ y IN s) ==> (f x = f y) ==> (x = y))");; let INJ_ID = prove_thm (`INJ_ID`, "!s. INJ (\x:*.x) s s", PURE_ONCE_REWRITE_TAC [INJ_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC);; let INJ_COMPOSE = prove_thm (`INJ_COMPOSE`, "!f:*->**. !g:**->***. !s t u. (INJ f s t /\ INJ g t u) ==> INJ (g o f) s u", PURE_REWRITE_TAC [INJ_DEF;o_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC; RES_TAC THEN RES_TAC]);; let INJ_EMPTY = prove_thm (`INJ_EMPTY`, "!f:*->**. (!s. INJ f {} s) /\ (!s. INJ f s {} = (s = {}))", REWRITE_TAC [INJ_DEF;NOT_IN_EMPTY;EXTENSION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC);; % ===================================================================== % % Surjective functions on a set. % % ===================================================================== % let SURJ_DEF = new_definition (`SURJ_DEF`, "SURJ (f:*->**) s t = (!x. x IN s ==> (f x) IN t) /\ (!x. (x IN t) ==> ?y. y IN s /\ (f y = x))");; let SURJ_ID = prove_thm (`SURJ_ID`, "!s. SURJ (\x:*.x) s s", PURE_ONCE_REWRITE_TAC [SURJ_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []);; let SURJ_COMPOSE = prove_thm (`SURJ_COMPOSE`, "!f:*->**. !g:**->***. !s t u. (SURJ f s t /\ SURJ g t u) ==> SURJ (g o f) s u", PURE_REWRITE_TAC [SURJ_DEF;o_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC; RES_TAC THEN RES_TAC THEN EXISTS_TAC "y'':*" THEN ASM_REWRITE_TAC []]);; let SURJ_EMPTY = prove_thm (`SURJ_EMPTY`, "!f:*->**. (!s. SURJ f {} s = (s = {})) /\ (!s. SURJ f s {} = (s = {}))", REWRITE_TAC [SURJ_DEF;NOT_IN_EMPTY;EXTENSION]);; let IMAGE_SURJ = prove_thm (`IMAGE_SURJ`, "!f:*->**. !s t. SURJ f s t = ((IMAGE f s) = t)", PURE_REWRITE_TAC [SURJ_DEF;EXTENSION;IN_IMAGE] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [RES_TAC THEN ASM_REWRITE_TAC []; MAP_EVERY PURE_ONCE_REWRITE_TAC [[CONJ_SYM];[EQ_SYM_EQ]] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]; DISCH_THEN (ASSUME_TAC o CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC []; EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []]]);; % ===================================================================== % % Bijective functions on a set. % % ===================================================================== % let BIJ_DEF = new_definition (`BIJ_DEF`, "BIJ (f:*->**) s t = INJ f s t /\ SURJ f s t");; let BIJ_ID = prove_thm (`BIJ_ID`, "!s. BIJ (\x:*.x) s s", REWRITE_TAC [BIJ_DEF;INJ_ID;SURJ_ID]);; let BIJ_EMPTY = prove_thm (`BIJ_EMPTY`, "!f:*->**. (!s. BIJ f {} s = (s = {})) /\ (!s. BIJ f s {} = (s = {}))", REWRITE_TAC [BIJ_DEF;INJ_EMPTY;SURJ_EMPTY]);; let BIJ_COMPOSE = prove_thm (`BIJ_COMPOSE`, "!f:*->**. !g:**->***. !s t u. (BIJ f s t /\ BIJ g t u) ==> BIJ (g o f) s u", PURE_REWRITE_TAC [BIJ_DEF] THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC INJ_COMPOSE;IMP_RES_TAC SURJ_COMPOSE]);; % ===================================================================== % % Left and right inverses. % % ===================================================================== % let lemma1 = TAC_PROOF (([], "!f:*->**. !s. (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) = (!y. y IN s ==> !x.((x IN s /\ (f x = f y))=(y IN s /\ (x = y))))"), REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC THEN ASM_REWRITE_TAC []);; let lemma2 = TAC_PROOF (([], "!f:*->**. !s. ?g. !t. INJ f s t ==> !x:*. x IN s ==> (g(f x) = x)"), REPEAT GEN_TAC THEN PURE_REWRITE_TAC [INJ_DEF;lemma1] THEN EXISTS_TAC "\y:**. @x:*. x IN s /\ (f x = y)" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN (RES_THEN \th. REWRITE_TAC [th]) THEN ASM_REWRITE_TAC [] THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "x:*" THEN REFL_TAC);; % --------------------------------------------------------------------- % % LINV_DEF: % % |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) % % --------------------------------------------------------------------- % let LINV_DEF = let th1 = CONV_RULE (ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) lemma2 in let th2 = CONV_RULE SKOLEM_CONV th1 in new_specification `LINV_DEF` [`constant`,`LINV`] th2;; let lemma3 = TAC_PROOF (([], "!f:*->**. !s. ?g. !t. SURJ f s t ==> !x:**. x IN t ==> (f(g x) = x)"), REPEAT GEN_TAC THEN PURE_REWRITE_TAC [SURJ_DEF] THEN EXISTS_TAC "\y:**. @x:*. x IN s /\ (f x = y)" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN (\(A,g). let tm = mk_conj("^(rand(lhs g)) IN s",g) in SUBGOAL_THEN tm (\th. ACCEPT_TAC(CONJUNCT2 th))(A,g)) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; % --------------------------------------------------------------------- % % RINV_DEF: % % |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) % % --------------------------------------------------------------------- % let RINV_DEF = let th1 = CONV_RULE (ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) lemma3 in let th2 = CONV_RULE SKOLEM_CONV th1 in new_specification `RINV_DEF` [`constant`,`RINV`] th2;; % ===================================================================== % % Finiteness % % ===================================================================== % let FINITE_DEF = new_definition (`FINITE_DEF`, "!s:(*)set. FINITE s = !P. (P EMPTY /\ (!s. P s ==> !e. P (e INSERT s))) ==> P s");; let FINITE_EMPTY = prove_thm (`FINITE_EMPTY`, "FINITE (EMPTY:(*)set)", PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN REPEAT STRIP_TAC);; let FINITE_INSERT = TAC_PROOF (([], "!s. FINITE s ==> !x:*. FINITE (x INSERT s)"), PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN REPEAT STRIP_TAC THEN SPEC_TAC ("x:*","x:*") THEN REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let SIMPLE_FINITE_INDUCT = TAC_PROOF (([], "!P. P EMPTY /\ (!s. P s ==> (!e:*. P(e INSERT s))) ==> !s. FINITE s ==> P s"), GEN_TAC THEN STRIP_TAC THEN PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN GEN_TAC THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC []);; let lemma = let tac = ASM_CASES_TAC "P:bool" THEN ASM_REWRITE_TAC[] in let lem = TAC_PROOF(([],"(P ==> P /\ Q) = (P ==> Q)"), tac) in let th1 = SPEC "\s:(*)set. FINITE s /\ P s" SIMPLE_FINITE_INDUCT in REWRITE_RULE [lem;FINITE_EMPTY] (BETA_RULE th1);; let FINITE_INDUCT = prove_thm (`FINITE_INDUCT`, "!P. P EMPTY /\ (!s. FINITE s /\ P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> !s:(*)set. FINITE s ==> P s", GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THENL [IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT; ASM_CASES_TAC "(e:*) IN s" THENL [IMP_RES_THEN SUBST1_TAC ABSORPTION; RES_TAC] THEN ASM_REWRITE_TAC []]);; % --------------------------------------------------------------------- % % Load the set induction tactic in... uncompiled. % % --------------------------------------------------------------------- % loadt `set_ind`;; let FINITE_DELETE = TAC_PROOF (([], "!s. FINITE s ==> (!x:*. FINITE(s DELETE x))"), SET_INDUCT_TAC THENL [REWRITE_TAC [EMPTY_DELETE;FINITE_EMPTY]; PURE_ONCE_REWRITE_TAC [DELETE_INSERT] THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM (\th g. ASSUME_TAC (SPEC "x:*" th) g) THEN IMP_RES_TAC FINITE_INSERT THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]);; let INSERT_FINITE = TAC_PROOF (([], "!x:*. !s. FINITE(x INSERT s) ==> FINITE s"), REPEAT GEN_TAC THEN ASM_CASES_TAC "(x:*) IN s" THENL [IMP_RES_TAC ABSORPTION THEN ASM_REWRITE_TAC []; DISCH_THEN (MP_TAC o SPEC "x:*" o MATCH_MP FINITE_DELETE) THEN REWRITE_TAC [DELETE_INSERT] THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC[]]);; let FINITE_INSERT = prove_thm (`FINITE_INSERT`, "!x:*. !s. FINITE(x INSERT s) = FINITE s", REPEAT GEN_TAC THEN EQ_TAC THENL [MATCH_ACCEPT_TAC INSERT_FINITE; DISCH_THEN (MATCH_ACCEPT_TAC o MATCH_MP FINITE_INSERT)]);; let DELETE_FINITE = TAC_PROOF (([], "!x:*. !s. FINITE (s DELETE x) ==> FINITE s"), REPEAT GEN_TAC THEN ASM_CASES_TAC "(x:*) IN s" THEN DISCH_TAC THENL [IMP_RES_THEN (SUBST1_TAC o SYM) INSERT_DELETE THEN ASM_REWRITE_TAC [FINITE_INSERT]; IMP_RES_THEN (SUBST1_TAC o SYM) DELETE_NON_ELEMENT THEN FIRST_ASSUM ACCEPT_TAC]);; let FINITE_DELETE = prove_thm (`FINITE_DELETE`, "!x:*. !s. FINITE(s DELETE x) = FINITE s", REPEAT GEN_TAC THEN EQ_TAC THENL [MATCH_ACCEPT_TAC DELETE_FINITE; DISCH_THEN (MATCH_ACCEPT_TAC o MATCH_MP FINITE_DELETE)]);; let UNION_FINITE = TAC_PROOF (([], "!s:(*)set. FINITE s ==> !t. FINITE t ==> FINITE (s UNION t)"), SET_INDUCT_TAC THENL [REWRITE_TAC [UNION_EMPTY]; SET_INDUCT_TAC THENL [IMP_RES_TAC FINITE_INSERT THEN ASM_REWRITE_TAC [UNION_EMPTY]; SUBST1_TAC (SPECL ["s':(*)set";"e':*"] INSERT_SING_UNION) THEN PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL UNION_ASSOC)] THEN PURE_REWRITE_TAC [SPECL ["s:(*)set";"{x:*}"] UNION_COMM] THEN PURE_REWRITE_TAC [UNION_ASSOC; SYM(SPEC_ALL INSERT_SING_UNION)] THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT]]);; let FINITE_UNION_LEMMA = TAC_PROOF (([], "!s:(*)set. FINITE s ==> !t. FINITE (s UNION t) ==> FINITE t"), SET_INDUCT_TAC THENL [REWRITE_TAC [UNION_EMPTY]; GEN_TAC THEN ASM_REWRITE_TAC [INSERT_UNION] THEN COND_CASES_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC; DISCH_THEN (MP_TAC o MATCH_MP INSERT_FINITE) THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]);; let FINITE_UNION = TAC_PROOF (([], "!s:(*)set. !t. FINITE(s UNION t) ==> (FINITE s /\ FINITE t)"), REPEAT STRIP_TAC THEN IMP_RES_THEN MATCH_MP_TAC FINITE_UNION_LEMMA THENL [SUBST1_TAC (SPECL ["s:(*)set";"t:(*)set"] UNION_COMM) THEN REWRITE_TAC [UNION_ASSOC;UNION_IDEMPOT] THEN PURE_ONCE_REWRITE_TAC [UNION_COMM] THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC [UNION_ASSOC;UNION_IDEMPOT]]);; let FINITE_UNION = prove_thm (`FINITE_UNION`, "!s:(*)set. !t. FINITE(s UNION t) = (FINITE s /\ FINITE t)", REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN IMP_RES_TAC FINITE_UNION; REPEAT STRIP_TAC THEN IMP_RES_TAC UNION_FINITE]);; let INTER_FINITE = prove_thm (`INTER_FINITE`, "!s:(*)set. FINITE s ==> !t. FINITE (s INTER t)", SET_INDUCT_TAC THENL [REWRITE_TAC [INTER_EMPTY;FINITE_EMPTY]; REWRITE_TAC [INSERT_INTER] THEN GEN_TAC THEN COND_CASES_TAC THENL [FIRST_ASSUM (\th g. ASSUME_TAC (SPEC "t:(*)set" th) g ? NO_TAC g) THEN IMP_RES_TAC FINITE_INSERT THEN FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM MATCH_ACCEPT_TAC]]);; let SUBSET_FINITE = prove_thm (`SUBSET_FINITE`, "!s:(*)set. FINITE s ==> (!t. t SUBSET s ==> FINITE t)", SET_INDUCT_TAC THENL [PURE_ONCE_REWRITE_TAC [SUBSET_EMPTY] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [FINITE_EMPTY]; GEN_TAC THEN ASM_CASES_TAC "(e:*) IN t" THENL [REWRITE_TAC [SUBSET_INSERT_DELETE] THEN STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC DELETE_FINITE; IMP_RES_TAC SUBSET_INSERT THEN ASM_REWRITE_TAC []]]);; let PSUBSET_FINITE = prove_thm (`PSUBSET_FINITE`, "!s:(*)set. FINITE s ==> (!t. t PSUBSET s ==> FINITE t)", PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC SUBSET_FINITE);; let FINITE_DIFF = prove_thm (`FINITE_DIFF`, "!s:(*)set. FINITE s ==> !t. FINITE(s DIFF t)", SET_INDUCT_TAC THENL [REWRITE_TAC [EMPTY_DIFF;FINITE_EMPTY]; ASM_REWRITE_TAC [INSERT_DIFF] THEN GEN_TAC THEN COND_CASES_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC; FIRST_ASSUM (\th g. ASSUME_TAC (SPEC "t:(*)set" th) g) THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT]]);; let FINITE_SING = prove_thm (`FINITE_SING`, "!x:*. FINITE {x}", GEN_TAC THEN MP_TAC FINITE_EMPTY THEN SUBST1_TAC (SYM (SPEC "x:*" SING_DELETE)) THEN DISCH_TAC THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT);; let SING_FINITE = prove_thm (`SING_FINITE`, "!s:(*)set. SING s ==> FINITE s", PURE_ONCE_REWRITE_TAC [SING_DEF] THEN GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC) THEN MATCH_ACCEPT_TAC FINITE_SING);; let IMAGE_FINITE = prove_thm (`IMAGE_FINITE`, "!s. FINITE s ==> !f:*->**. FINITE(IMAGE f s)", SET_INDUCT_TAC THENL [REWRITE_TAC [IMAGE_EMPTY;FINITE_EMPTY]; ASM_REWRITE_TAC [IMAGE_INSERT;FINITE_INSERT]]);; % ===================================================================== % % Cardinality % % ===================================================================== % % --------------------------------------------------------------------- % % card_rel_def: defining equations for a relation "R s n", which means % % that the finite s has cardinality n. % % --------------------------------------------------------------------- % let card_rel_def = "(!s. R s 0 = (s = EMPTY)) /\ (!s n. R s (SUC n) = ?x:*. x IN s /\ R (s DELETE x) n)";; % --------------------------------------------------------------------- % % Prove that such a relation exists. % % --------------------------------------------------------------------- % let CARD_REL_EXISTS = prove_rec_fn_exists num_Axiom card_rel_def;; % --------------------------------------------------------------------- % % Now, prove that it doesn't matter which element we delete % % Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] % % --------------------------------------------------------------------- % let CARD_REL_DEL_LEMMA = TAC_PROOF ((conjuncts card_rel_def, "!n:num.!s.!x:*. x IN s ==> R (s DELETE x) n ==> !y:*. y IN s ==> R (s DELETE y) n"), INDUCT_TAC THENL [REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_TAC DELETE_EQ_SING THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [IN_SING] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [SING_DELETE]; ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN let th = (SPEC "y:* = x'" EXCLUDED_MIDDLE) in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th THENL [MP_TAC (SPECL ["s:(*)set";"x:*";"x':*"] IN_DELETE_EQ) THEN ASM_REWRITE_TAC [] THEN DISCH_TAC THEN PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]; let th = (SPEC "x:* = y" EXCLUDED_MIDDLE) in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th THENL [EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []; EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC [IN_DELETE] THEN RES_THEN (TRY o IMP_RES_THEN ASSUME_TAC) THEN PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [IN_DELETE] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN FIRST_ASSUM ACCEPT_TAC]]]);; % --------------------------------------------------------------------- % % So "R s" specifies a unique number. % % --------------------------------------------------------------------- % let CARD_REL_UNIQUE = TAC_PROOF ((conjuncts card_rel_def, "!n:num. !s:(*)set. R s n ==> (!m. R s m ==> (n = m))"), INDUCT_TAC THEN ASM_REWRITE_TAC [] THENL [GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THENL [STRIP_TAC THEN REFL_TAC; ASM_REWRITE_TAC[NOT_SUC;NOT_IN_EMPTY]]; GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ASM_REWRITE_TAC [NOT_SUC;SYM(SPEC_ALL MEMBER_NOT_EMPTY)] THEN EXISTS_TAC "x:*" THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC [INV_SUC_EQ] THEN STRIP_TAC THEN IMP_RES_TAC CARD_REL_DEL_LEMMA THEN RES_TAC]]);; % --------------------------------------------------------------------- % % Now, ?n. R s n if s is finite. % % --------------------------------------------------------------------- % let CARD_REL_EXISTS_LEMMA = TAC_PROOF ((conjuncts card_rel_def, "!s:(*)set. FINITE s ==> ?n:num. R s n"), SET_INDUCT_TAC THENL [EXISTS_TAC "0" THEN ASM_REWRITE_TAC[]; FIRST_ASSUM (\th g. CHOOSE_THEN ASSUME_TAC th g) THEN EXISTS_TAC "SUC n" THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC "e:*" THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC [DELETE_INSERT;IN_INSERT]]);; % --------------------------------------------------------------------- % % So (@n. R s n) = m iff R s m (\s.@n.R s n defines a function) % % Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] % % --------------------------------------------------------------------- % let CARD_REL_THM = TAC_PROOF ((conjuncts card_rel_def, "!m s. FINITE s ==> (((@n:num. R (s:(*)set) n) = m) = R s m)"), REPEAT STRIP_TAC THEN IMP_RES_TAC CARD_REL_EXISTS_LEMMA THEN EQ_TAC THENL [DISCH_THEN (SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "n:num" THEN FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC THEN IMP_RES_THEN ASSUME_TAC CARD_REL_UNIQUE THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "n:num" THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; % --------------------------------------------------------------------- % % Now, prove the existence of the required cardinality function. % % --------------------------------------------------------------------- % let CARD_EXISTS = TAC_PROOF (([]," ?CARD. (CARD EMPTY = 0) /\ (!s. FINITE s ==> !x:*. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)))"), STRIP_ASSUME_TAC CARD_REL_EXISTS THEN EXISTS_TAC "\s:(*)set. @n:num. R s n" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONJ_TAC THENL [ASSUME_TAC FINITE_EMPTY THEN IMP_RES_TAC CARD_REL_THM THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []; REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [IMP_RES_THEN SUBST1_TAC ABSORPTION THEN REFL_TAC; IMP_RES_THEN (ASSUME_TAC o SPEC "x:*") FINITE_INSERT THEN IMP_RES_THEN (TRY o MATCH_MP_TAC) CARD_REL_THM THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC "x:*" THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC [IN_INSERT;DELETE_INSERT] THEN CONV_TAC SELECT_CONV THEN IMP_RES_THEN (TRY o MATCH_ACCEPT_TAC) CARD_REL_EXISTS_LEMMA]]);; % --------------------------------------------------------------------- % % Finally, introduce the CARD function via a constant specification. % % --------------------------------------------------------------------- % let CARD_DEF = new_specification `CARD_DEF` [`constant`,`CARD`] CARD_EXISTS;; % --------------------------------------------------------------------- % % Various cardinality results. % % --------------------------------------------------------------------- % let CARD_EMPTY = save_thm(`CARD_EMPTY`,CONJUNCT1 CARD_DEF);; let CARD_INSERT = save_thm(`CARD_INSERT`,CONJUNCT2 CARD_DEF);; let CARD_EQ_0 = prove_thm (`CARD_EQ_0`, "!s:(*)set. FINITE s ==> ((CARD s = 0) = (s = EMPTY))", SET_INDUCT_TAC THENL [REWRITE_TAC [CARD_EMPTY]; IMP_RES_TAC CARD_INSERT THEN ASM_REWRITE_TAC [NOT_INSERT_EMPTY;NOT_SUC]]);; let CARD_DELETE = prove_thm (`CARD_DELETE`, "!s. FINITE s ==> !x:*. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s)", SET_INDUCT_TAC THENL [REWRITE_TAC [EMPTY_DELETE;NOT_IN_EMPTY]; PURE_REWRITE_TAC [DELETE_INSERT;IN_INSERT] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC "x:* = e" THENL [IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [SUC_SUB1]; SUBST1_TAC (SPECL ["e:*";"x:*"] EQ_SYM_EQ) THEN IMP_RES_THEN (ASSUME_TAC o SPEC "x:*") FINITE_DELETE THEN IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [IN_DELETE;SUC_SUB1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_ASSUME_TAC (SPEC "CARD(s:(*)set)" num_CASES) THENL [(let tac th g = SUBST_ALL_TAC th g ? ASSUME_TAC th g in REPEAT_GTCL IMP_RES_THEN tac CARD_EQ_0 THEN IMP_RES_TAC NOT_IN_EMPTY); ASM_REWRITE_TAC [SUC_SUB1]]]]);; let lemma1 = TAC_PROOF (([], "!n m. (SUC n <= SUC m) = (n <= m)"), REWRITE_TAC [LESS_OR_EQ;INV_SUC_EQ;LESS_MONO_EQ]);; let lemma2 = TAC_PROOF (([], "!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))"), REWRITE_TAC [LESS_OR_EQ;LESS_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let CARD_INTER_LESS_EQ = prove_thm (`CARD_INTER_LESS_EQ`, "!s:(*)set. FINITE s ==> !t. CARD (s INTER t) <= CARD s", SET_INDUCT_TAC THENL [REWRITE_TAC [CARD_DEF;INTER_EMPTY;LESS_EQ_REFL]; PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN GEN_TAC THEN COND_CASES_TAC THENL [IMP_RES_THEN (ASSUME_TAC o SPEC "t:(*)set") INTER_FINITE THEN IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [IN_INTER;lemma1]; IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [lemma2]]]);; let CARD_UNION = prove_thm (`CARD_UNION`, "!s:(*)set. FINITE s ==> !t. FINITE t ==> (CARD (s UNION t) + CARD (s INTER t) = CARD s + CARD t)", SET_INDUCT_TAC THENL [REWRITE_TAC [UNION_EMPTY;INTER_EMPTY;CARD_DEF;ADD_CLAUSES]; REPEAT STRIP_TAC THEN REWRITE_TAC [INSERT_UNION;INSERT_INTER] THEN ASM_CASES_TAC "(e:*) IN t" THENL [IMP_RES_THEN (ASSUME_TAC o SPEC "t:(*)set") INTER_FINITE THEN IMP_RES_TAC CARD_DEF THEN RES_TAC THEN ASM_REWRITE_TAC [IN_INTER;ADD_CLAUSES]; IMP_RES_TAC UNION_FINITE THEN IMP_RES_TAC CARD_DEF THEN RES_TAC THEN ASM_REWRITE_TAC [ADD_CLAUSES; INV_SUC_EQ; IN_UNION]]]);; let lemma = TAC_PROOF (([], "!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))"), REWRITE_TAC [LESS_OR_EQ;LESS_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let CARD_SUBSET = prove_thm (`CARD_SUBSET`, "!s:(*)set. FINITE s ==> (!t. t SUBSET s ==> (CARD t <= CARD s))", SET_INDUCT_TAC THENL [REWRITE_TAC [SUBSET_EMPTY;CARD_EMPTY] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [CARD_DEF;LESS_EQ_REFL]; IMP_RES_THEN (ASSUME_TAC o SPEC "e:*") FINITE_INSERT THEN IMP_RES_TAC CARD_INSERT THEN ASM_REWRITE_TAC [SUBSET_INSERT_DELETE] THEN REPEAT STRIP_TAC THEN RES_THEN MP_TAC THEN IMP_RES_TAC SUBSET_FINITE THEN IMP_RES_TAC DELETE_FINITE THEN IMP_RES_TAC CARD_DELETE THEN ASM_REWRITE_TAC [] THEN COND_CASES_TAC THENL [(let th = SPEC "CARD (t:(*)set)" num_CASES in REPEAT_TCL STRIP_THM_THEN SUBST_ALL_TAC th) THENL [REWRITE_TAC [LESS_OR_EQ;LESS_0]; REWRITE_TAC [SUC_SUB1;LESS_OR_EQ;LESS_MONO_EQ;INV_SUC_EQ]]; STRIP_TAC THEN ASM_REWRITE_TAC [lemma]]]);; let CARD_PSUBSET = prove_thm (`CARD_PSUBSET`, "!s:(*)set. FINITE s ==> (!t. t PSUBSET s ==> (CARD t < CARD s))", REPEAT STRIP_TAC THEN IMP_RES_TAC PSUBSET_DEF THEN IMP_RES_THEN (IMP_RES_THEN MP_TAC) CARD_SUBSET THEN PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN DISCH_THEN (STRIP_THM_THEN (\th g. ACCEPT_TAC th g ? MP_TAC th g)) THEN IMP_RES_THEN STRIP_ASSUME_TAC PSUBSET_INSERT_SUBSET THEN IMP_RES_THEN (IMP_RES_THEN MP_TAC) CARD_SUBSET THEN IMP_RES_TAC INSERT_SUBSET THEN IMP_RES_TAC SUBSET_FINITE THEN IMP_RES_TAC CARD_INSERT THEN ASM_REWRITE_TAC [LESS_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let CARD_SING = prove_thm (`CARD_SING`, "!x:*. CARD {x} = 1", CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN GEN_TAC THEN ASSUME_TAC FINITE_EMPTY THEN IMP_RES_THEN (ASSUME_TAC o SPEC "x:*") FINITE_INSERT THEN IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [NOT_IN_EMPTY;CARD_DEF]);; let SING_IFF_CARD1 = prove_thm (`SING_IFF_CARD1`, "!s:(*)set. (SING s) = ((CARD s = 1) /\ (FINITE s))", REWRITE_TAC [SING_DEF;num_CONV "1"] THEN GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (CHOOSE_THEN SUBST1_TAC) THEN CONJ_TAC THENL [ASSUME_TAC FINITE_EMPTY THEN IMP_RES_TAC CARD_INSERT THEN ASM_REWRITE_TAC [CARD_EMPTY;NOT_IN_EMPTY]; REWRITE_TAC [FINITE_INSERT;FINITE_EMPTY]]; STRIP_ASSUME_TAC (SPEC "s:(*)set" SET_CASES) THENL [ASM_REWRITE_TAC [CARD_EMPTY;NOT_EQ_SYM(SPEC_ALL NOT_SUC)]; ASM_REWRITE_TAC [FINITE_INSERT] THEN DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN IMP_RES_TAC CARD_INSERT THEN IMP_RES_TAC CARD_EQ_0 THEN ASM_REWRITE_TAC [INV_SUC_EQ] THEN DISCH_TAC THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC []]]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let CARD_DIFF = prove_thm (`CARD_DIFF`, "!t:(*)set. FINITE t ==> !s:(*)set. FINITE s ==> (CARD (s DIFF t) = (CARD s - CARD (s INTER t)))", SET_INDUCT_TAC THEN REPEAT STRIP_TAC THENL [REWRITE_TAC [DIFF_EMPTY;INTER_EMPTY;CARD_EMPTY;SUB_0]; PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN COND_CASES_TAC THENL [let th = SPEC "s':(*)set" (UNDISCH (SPEC "s:(*)set" INTER_FINITE)) in PURE_ONCE_REWRITE_TAC [MATCH_MP CARD_INSERT th] THEN IMP_RES_THEN (ASSUME_TAC o SPEC "e:*") FINITE_DELETE THEN IMP_RES_TAC CARD_DELETE THEN RES_TAC THEN ASM_REWRITE_TAC [IN_INTER;DIFF_INSERT] THEN PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL SUB_PLUS)] THEN REWRITE_TAC [num_CONV "1";ADD_CLAUSES;DELETE_INTER] THEN MP_TAC (SPECL ["s':(*)set";"s:(*)set";"e:*"] IN_INTER) THEN ASM_REWRITE_TAC [DELETE_NON_ELEMENT] THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC (SPECL ["s:(*)set";"s':(*)set"] INTER_COMM) THEN REFL_TAC; IMP_RES_TAC DELETE_NON_ELEMENT THEN PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN RES_TAC THEN ASM_REWRITE_TAC [DIFF_INSERT]]]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let LESS_CARD_DIFF = prove_thm (`LESS_CARD_DIFF`, "!t:(*)set. FINITE t ==> !s. FINITE s ==> (CARD t < CARD s) ==> (0 < CARD(s DIFF t))", REPEAT STRIP_TAC THEN REPEAT_GTCL IMP_RES_THEN SUBST1_TAC CARD_DIFF THEN PURE_REWRITE_TAC [GSYM SUB_LESS_0] THEN let th1 = UNDISCH (SPEC "s:(*)set" CARD_INTER_LESS_EQ) in let th2 = SPEC "t:(*)set" (PURE_ONCE_REWRITE_RULE [LESS_OR_EQ] th1) in DISJ_CASES_THEN2 ACCEPT_TAC (SUBST_ALL_TAC o SYM) th2 THEN let th3 = SPEC "s:(*)set" (UNDISCH(SPEC "t:(*)set" CARD_INTER_LESS_EQ)) in let th4 = PURE_ONCE_REWRITE_RULE [INTER_COMM] th3 in IMP_RES_TAC (PURE_ONCE_REWRITE_RULE [GSYM NOT_LESS] th4));; % ===================================================================== % % Infiniteness % % ===================================================================== % let INFINITE_DEF = new_definition (`INFINITE_DEF`, "!s:(*)set. INFINITE s = ~(FINITE s)");; let NOT_IN_FINITE = prove_thm (`NOT_IN_FINITE`, "INFINITE (UNIV:(*)set) = !s:(*)set. FINITE s ==> ?x. ~ (x IN s)", PURE_ONCE_REWRITE_TAC [INFINITE_DEF] THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REWRITE_TAC [NOT_IMP] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC [EQ_UNIV] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []; REPEAT STRIP_TAC THEN RES_THEN STRIP_ASSUME_TAC THEN ASSUME_TAC (SPEC "x:*" IN_UNIV) THEN RES_TAC]);; let INVERSE_LEMMA = TAC_PROOF (([], "!f:*->**. (!x y. (f x = f y) ==> (x = y)) ==> ((\x:**. @y:*. x = f y) o f = \x:*.x)"), REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN PURE_ONCE_REWRITE_TAC [o_THM] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN GEN_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONV_TAC (SYM_CONV THENC SELECT_CONV) THEN EXISTS_TAC "x:*" THEN REFL_TAC);; let IMAGE_11_INFINITE = prove_thm (`IMAGE_11_INFINITE`, "!f:*->**. (!x y. (f x = f y) ==> (x = y)) ==> !s:(*)set. INFINITE s ==> INFINITE (IMAGE f s)", GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC [INFINITE_DEF] THEN STRIP_TAC THEN let thm = INST_TYPE [":*",":**";":**",":*"] IMAGE_FINITE in IMP_RES_THEN (MP_TAC o ISPEC "\x:**.@y:*.x=f y") thm THEN REWRITE_TAC [SYM(SPEC_ALL IMAGE_COMPOSE)] THEN IMP_RES_TAC INVERSE_LEMMA THEN ASM_REWRITE_TAC [IMAGE_ID]);; let INFINITE_SUBSET = prove_thm (`INFINITE_SUBSET`, "!s:(*)set. INFINITE s ==> (!t. s SUBSET t ==> INFINITE t)", PURE_ONCE_REWRITE_TAC [INFINITE_DEF] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC SUBSET_FINITE THEN RES_TAC);; let IN_INFINITE_NOT_FINITE = prove_thm (`IN_INFINITE_NOT_FINITE`, "!s t. (INFINITE s /\ FINITE t) ==> ?x:*. x IN s /\ ~x IN t", CONV_TAC (ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN PURE_ONCE_REWRITE_TAC [DE_MORGAN_THM] THEN REWRITE_TAC [SYM(SPEC_ALL IMP_DISJ_THM)] THEN PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL SUBSET_DEF)] THEN PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL INFINITE_DEF)] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC INFINITE_SUBSET);; % --------------------------------------------------------------------- % % The next series of lemmas are used for proving that if UNIV:(*)set is % % INFINITE then :* satisfies an axiom of infinity. % % % % The function g:num->(*)set defines a series of sets: % % % % {}, {x1}, {x1,x2}, {x1,x2,x3},... % % % % and one then defines an f:*->* such that f(xi)=xi+1. % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Defining equations for g. % % --------------------------------------------------------------------- % let gdef = ["g 0 = ({}:(*)set)"; "!n. g(SUC n) = (@x:*.~ x IN (g n)) INSERT (g n)"];; % --------------------------------------------------------------------- % % Lemma: g n is finite for all n. % % --------------------------------------------------------------------- % let g_finite = TAC_PROOF ((gdef, "!n:num. FINITE (g n:(*)set)"), INDUCT_TAC THEN ASM_REWRITE_TAC[FINITE_EMPTY;FINITE_INSERT]);; % --------------------------------------------------------------------- % % Lemma: g n is contained in g (n+i) for all i. % % --------------------------------------------------------------------- % let g_subset = TAC_PROOF ((gdef, "!n. !x:*. x IN (g n) ==> !i. x IN (g (n+i))"), REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC [ADD_CLAUSES;IN_INSERT]);; % --------------------------------------------------------------------- % % Lemma: if x is in g(n) then {x} = g(n+1)-g(n) for some n. % % --------------------------------------------------------------------- % let lemma = TAC_PROOF(([], "((A \/ B) /\ ~B) = (A /\ ~B)"), BOOL_CASES_TAC "B:bool" THEN REWRITE_TAC[]);; let g_cases = TAC_PROOF ((gdef, "(!s. FINITE s ==> ?x:*. ~(x IN s)) ==> !x:*. (?n. x IN (g n)) ==> (?m. (x IN (g (SUC m))) /\ ~(x IN (g m)))"), DISCH_TAC THEN GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN MP_TAC o CONV_RULE EXISTS_LEAST_CONV) THEN REPEAT_TCL STRIP_THM_THEN SUBST1_TAC (SPEC "n:num" num_CASES) THEN ASM_REWRITE_TAC [NOT_IN_EMPTY;IN_INSERT] THEN STRIP_TAC THENL [REWRITE_TAC [lemma] THEN EXISTS_TAC "n':num" THEN CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN FIRST_ASSUM (\th g. SUBST1_TAC th g) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC g_finite; REWRITE_TAC [lemma] THEN FIRST_ASSUM (\th g. MP_TAC (SPEC "n':num" th) g) THEN REWRITE_TAC [LESS_SUC_REFL] THEN DISCH_THEN IMP_RES_TAC]);; % --------------------------------------------------------------------- % % Lemma: @x.~(x IN {}) is an element of every g(n+1). % % --------------------------------------------------------------------- % let z_in_g1 = TAC_PROOF ((gdef, "(@x:*.~x IN {}) IN (g (SUC 0))"), ASM_REWRITE_TAC [NOT_IN_EMPTY;IN_INSERT]);; let z_in_gn = TAC_PROOF ((gdef, "!n:num. (@x:*.~x IN {}) IN (g (SUC n))"), PURE_ONCE_REWRITE_TAC [ADD1] THEN PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN MATCH_MP_TAC g_subset THEN REWRITE_TAC [num_CONV "1";z_in_g1]);; % --------------------------------------------------------------------- % % Lemma: @x.~(x IN g n) is an element of g(n+1). % % --------------------------------------------------------------------- % let in_lemma = TAC_PROOF ((gdef, "!n:num. (@x:*. ~(x IN (g n))) IN (g(SUC n))"), ASM_REWRITE_TAC [IN_INSERT]);; % --------------------------------------------------------------------- % % Lemma: the x added to g(n+1) is not in g(n) % % --------------------------------------------------------------------- % let not_in_lemma = TAC_PROOF ((gdef, "(!s. FINITE s ==> ?x:*. ~(x IN s)) ==> !i. !n. ~(@x:*. ~(x IN (g (n+i)))) IN g n"), DISCH_TAC THEN INDUCT_TAC THENL [ASM_REWRITE_TAC [ADD_CLAUSES] THEN GEN_TAC THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC g_finite; PURE_ONCE_REWRITE_TAC [ADD_CLAUSES] THEN PURE_ONCE_REWRITE_TAC [SYM(el 3 (CONJUNCTS ADD_CLAUSES))] THEN GEN_TAC THEN FIRST_ASSUM (\th g. MP_TAC(SPEC "SUC n" th) g) THEN REWRITE_TAC (map ASSUME gdef) THEN REWRITE_TAC [IN_INSERT;DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN RES_TAC]);; % --------------------------------------------------------------------- % % Lemma: each value is added to a unique g(n). % % --------------------------------------------------------------------- % let less_lemma = TAC_PROOF (([], "!m n. ~(m = n) = ((m < n) \/ (n < m))"), REPEAT GEN_TAC THEN ASM_CASES_TAC "n < m" THEN ASM_REWRITE_TAC [] THENL [DISCH_THEN SUBST_ALL_TAC THEN IMP_RES_TAC LESS_REFL; IMP_RES_THEN MP_TAC NOT_LESS THEN REWRITE_TAC [LESS_OR_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL [IMP_RES_TAC LESS_NOT_EQ; MATCH_ACCEPT_TAC LESS_REFL]]);; let gn_unique = TAC_PROOF ((gdef, "(!s. FINITE s ==> ?x:*. ~(x IN s)) ==> !n:num. !m. ((@x:*.~ x IN (g n)) = @x:*.~(x IN (g m))) = (n=m)"), DISCH_TAC THEN REPEAT GEN_TAC THEN EQ_TAC THENL [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC [less_lemma] THEN DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN REWRITE_TAC [num_CONV "1";ADD_CLAUSES] THEN REWRITE_TAC [SYM(el 3 (CONJUNCTS ADD_CLAUSES))] THEN IMP_RES_TAC not_in_lemma THEN DISCH_TAC THENL [MP_TAC (SPEC "n:num" in_lemma) THEN EVERY_ASSUM (\th g. SUBST1_TAC th g ? ALL_TAC g) THEN DISCH_TAC THEN RES_TAC; MP_TAC (SPEC "m:num" in_lemma) THEN EVERY_ASSUM (\th g. SUBST1_TAC (SYM th) g ? ALL_TAC g) THEN DISCH_TAC THEN RES_TAC]; DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; % --------------------------------------------------------------------- % % Lemma: the value added to g(n) to get g(n+1) a unique. % % --------------------------------------------------------------------- % let x_unique = TAC_PROOF ((gdef, "!n. !x. !y:*. (~(x IN g n) /\ ~(y IN g n)) ==> (x IN g(SUC n)) ==> (y IN g(SUC n)) ==> (x = y)"), REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [IN_INSERT] THEN REPEAT (DISCH_THEN SUBST1_TAC) THEN REFL_TAC);; % --------------------------------------------------------------------- % % Now, show the existence of a non-onto one-one fuction. The required % % function is denoted by fdef. The theorem cases is: % % % % |- (?n. x IN (g n)) \/ (!n. ~x IN (g n)) % % % % and is used to do case splits on the condition of the conditional % % present in fdef. % % --------------------------------------------------------------------- % let fdef = "\x:*. (?n. (x IN (g n))) => (@y.~(y IN (g (SUC @n. x IN g(SUC n) /\ ~ x IN (g n))))) | x";; let cases = let thm = GEN "x:*" (SPEC "?n:num.(x:*) IN (g n)" EXCLUDED_MIDDLE) in CONV_RULE (ONCE_DEPTH_CONV NOT_EXISTS_CONV) thm;; let INF_IMP_INFINITY = TAC_PROOF (([],"(!s. FINITE s ==> ?x:*. ~(x IN s)) ==> (?f:*->*. (!x y. (f x = f y) ==> (x=y)) /\ ?y. !x. ~(f x = y))"), let xcases = SPEC "x:*" cases and ycases = SPEC "y:*" cases in let nv x = "SUC(@n. ^x IN (g(SUC n)) /\ ~^x IN (g n))" in STRIP_ASSUME_TAC (prove_rec_fn_exists num_Axiom (list_mk_conj gdef)) THEN STRIP_TAC THEN EXISTS_TAC fdef THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN DISJ_CASES_THEN (\th. REWRITE_TAC[th] THEN STRIP_ASSUME_TAC th) xcases THEN DISJ_CASES_THEN (\th. REWRITE_TAC[th] THEN STRIP_ASSUME_TAC th) ycases THENL [REWRITE_TAC [UNDISCH gn_unique;INV_SUC_EQ] THEN IMP_RES_THEN (IMP_RES_THEN(STRIP_ASSUME_TAC o SELECT_RULE)) g_cases THEN DISCH_THEN SUBST_ALL_TAC THEN IMP_RES_TAC x_unique; ASSUME_TAC (SPEC (nv "x:*") in_lemma) THEN DISCH_THEN (SUBST_ALL_TAC o SYM) THEN RES_TAC; ASSUME_TAC (SPEC (nv "y:*") in_lemma) THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC]; EXISTS_TAC "@x:*.~(x IN g 0)" THEN GEN_TAC THEN DISJ_CASES_THEN (\th. REWRITE_TAC[th] THEN ASSUME_TAC th) xcases THENL [REWRITE_TAC [UNDISCH gn_unique;NOT_SUC]; ASSUME_TAC (SPEC "n:num" z_in_gn) THEN FIRST_ASSUM (\th g. SUBST1_TAC th g) THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC]]);; % --------------------------------------------------------------------- % % We now also prove the converse, namely that if :* satisfies an axiom % % of infinity then UNIV:(*)set is INFINITE. % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % First, a version of the primitive recursion theorem % % --------------------------------------------------------------------- % let prth = prove_rec_fn_exists num_Axiom "(fn f x 0 = x) /\ (fn f x (SUC n) = (f:*->*)(fn f x n))";; let prmth = TAC_PROOF (([], "!x:*. !f. ?fn. (fn 0 = x) /\ !n. fn (SUC n) = f(fn n)"), REPEAT GEN_TAC THEN STRIP_ASSUME_TAC prth THEN EXISTS_TAC "fn (f:*->*) (x:*) : num->*" THEN ASM_REWRITE_TAC []);; % --------------------------------------------------------------------- % % Lemma: if f is one-to-one and not onto, there is a one-one f:num->*. % % --------------------------------------------------------------------- % let num_fn_thm = TAC_PROOF (([],"(?f:*->*. (!x y. (f x = f y) ==> (x=y)) /\ ?y. !x. ~(f x = y)) ==> (?fn:num->*. (!n m. (fn n = fn m) ==> (n=m)))"), STRIP_TAC THEN STRIP_ASSUME_TAC (SPECL ["y:*";"f:*->*"] prmth) THEN EXISTS_TAC "fn:num->*" THEN INDUCT_TAC THENL [CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]; INDUCT_TAC THEN ASM_REWRITE_TAC [INV_SUC_EQ] THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC]);; % --------------------------------------------------------------------- % % Lemma: every finite set of numbers has an upper bound. % % --------------------------------------------------------------------- % let finite_N_bounded = TAC_PROOF (([], "!s. FINITE s ==> ?m. !n. (n IN s) ==> n < m"), SET_INDUCT_TAC THENL [REWRITE_TAC [NOT_IN_EMPTY]; FIRST_ASSUM (\th g. CHOOSE_THEN ASSUME_TAC th g) THEN EXISTS_TAC "(SUC m) + e" THEN REWRITE_TAC [IN_INSERT] THEN REPEAT STRIP_TAC THENL [PURE_ONCE_REWRITE_TAC [ADD_SYM] THEN ASM_REWRITE_TAC [LESS_ADD_SUC]; RES_TAC THEN IMP_RES_TAC LESS_IMP_LESS_ADD THEN let [_;_;c1;c2] = CONJUNCTS ADD_CLAUSES in ASM_REWRITE_TAC [c1;SYM c2]]]);; % --------------------------------------------------------------------- % % Lemma: UNIV:(num)set is infinite. % % --------------------------------------------------------------------- % let N_lemma = TAC_PROOF (([], "INFINITE(UNIV:(num)set)"), REWRITE_TAC [INFINITE_DEF] THEN STRIP_TAC THEN IMP_RES_THEN MP_TAC finite_N_bounded THEN REWRITE_TAC [IN_UNIV] THEN CONV_TAC NOT_EXISTS_CONV THEN GEN_TAC THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC "SUC m" THEN REWRITE_TAC [NOT_LESS;LESS_OR_EQ;LESS_SUC_REFL]);; % --------------------------------------------------------------------- % % Lemma: if s is finite, f:num->* is one-one, then ?n. f(n) not in s % % --------------------------------------------------------------------- % let main_lemma = TAC_PROOF (([], "!s:(*)set. FINITE s ==> !f:num->*. (!n m. (f n = f m) ==> (n=m)) ==> ?n. ~(f n IN s)"), REPEAT STRIP_TAC THEN ASSUME_TAC N_lemma THEN IMP_RES_TAC IMAGE_11_INFINITE THEN IMP_RES_THEN (TRY o IMP_RES_THEN MP_TAC) IN_INFINITE_NOT_FINITE THEN REWRITE_TAC [IN_IMAGE;IN_UNIV] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x':num" THEN EVERY_ASSUM (\th g. SUBST1_TAC (SYM th) g ? ALL_TAC g) THEN FIRST_ASSUM ACCEPT_TAC);; % --------------------------------------------------------------------- % % Now show that we can always choose an element not in a finite set. % % --------------------------------------------------------------------- % let INFINITY_IMP_INF = TAC_PROOF (([],"(?f:*->*. (!x y. (f x = f y) ==> (x=y)) /\ ?y. !x. ~(f x = y)) ==> (!s. FINITE s ==> ?x:*. ~(x IN s))"), DISCH_THEN (STRIP_ASSUME_TAC o MATCH_MP num_fn_thm) THEN GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC main_lemma THEN EXISTS_TAC "(fn:num->*) n" THEN FIRST_ASSUM ACCEPT_TAC);; % --------------------------------------------------------------------- % % Finally, we can prove the desired theorem. % % --------------------------------------------------------------------- % let INFINITE_UNIV = prove_thm (`INFINITE_UNIV`, "INFINITE (UNIV:(*)set) = (?f:*->*. (!x y. (f x = f y) ==> (x = y)) /\ (?y. !x. ~(f x = y)))", PURE_ONCE_REWRITE_TAC [NOT_IN_FINITE] THEN ACCEPT_TAC (IMP_ANTISYM_RULE INF_IMP_INFINITY INFINITY_IMP_INF));; let FINITE_PSUBSET_INFINITE = prove_thm (`FINITE_PSUBSET_INFINITE`, "!s. INFINITE (s:(*)set) = !t. FINITE (t:(*)set) ==> ((t SUBSET s) ==> (t PSUBSET s))", PURE_REWRITE_TAC [INFINITE_DEF;PSUBSET_DEF] THEN GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THENL [FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM (\th g. SUBST_ALL_TAC th g ? NO_TAC g) THEN RES_TAC]; REPEAT STRIP_TAC THEN RES_TAC THEN ASSUME_TAC (SPEC "s:(*)set" SUBSET_REFL) THEN ASSUME_TAC (REFL "s:(*)set") THEN RES_TAC]);; let FINITE_PSUBSET_UNIV = prove_thm (`FINITE_PSUBSET_UNIV`, "INFINITE (UNIV:(*)set) = !s:(*)set. FINITE s ==> s PSUBSET UNIV", PURE_ONCE_REWRITE_TAC [FINITE_PSUBSET_INFINITE] THEN REWRITE_TAC [PSUBSET_DEF;SUBSET_UNIV]);; let INFINITE_DIFF_FINITE = prove_thm (`INFINITE_DIFF_FINITE`, "!s t. (INFINITE s /\ FINITE t) ==> ~(s DIFF t = ({}:(*)set))", REPEAT GEN_TAC THEN STRIP_TAC THEN IMP_RES_TAC IN_INFINITE_NOT_FINITE THEN REWRITE_TAC [EXTENSION;IN_DIFF;NOT_IN_EMPTY] THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]);; let FINITE_ISO_NUM = prove_thm (`FINITE_ISO_NUM`, "!s:(*)set. FINITE s ==> ?f. (!n m. (n < CARD s /\ m < CARD s) ==> (f n = f m) ==> (n = m)) /\ (s = {f n | n < CARD s})", SET_INDUCT_TAC THENL [PURE_ONCE_REWRITE_TAC [EXTENSION] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REWRITE_TAC [CARD_EMPTY;NOT_LESS_0;NOT_IN_EMPTY]; FIRST_ASSUM (\th g. CHOOSE_THEN STRIP_ASSUME_TAC th g) THEN PURE_ONCE_REWRITE_TAC [UNDISCH (SPEC "s:(*)set" CARD_INSERT)] THEN FILTER_ASM_REWRITE_TAC is_neg [] THEN PURE_ONCE_REWRITE_TAC [LESS_THM] THEN EXISTS_TAC "\n. n < (CARD (s:(*)set)) => f n | (e:*)" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONJ_TAC THENL [REPEAT GEN_TAC THEN let ttac th g = SUBST_ALL_TAC th g ? ASSUME_TAC th g in DISCH_THEN (REPEAT_TCL STRIP_THM_THEN ttac) THENL [REPEAT STRIP_TAC THEN REFL_TAC; let is_less t = (fst(strip_comb t) = "<") ? false in FILTER_ASM_REWRITE_TAC is_less [LESS_REFL] THEN FIRST_ASSUM (\th g. MP_TAC (assert (is_eq o concl) th) g) THEN PURE_ONCE_REWRITE_TAC [EXTENSION] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC; let is_less t = (fst(strip_comb t) = "<") ? false in FILTER_ASM_REWRITE_TAC is_less [LESS_REFL] THEN FIRST_ASSUM (\th g. MP_TAC (assert (is_eq o concl) th) g) THEN PURE_ONCE_REWRITE_TAC [EXTENSION] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_TAC; let is_less t = (fst(strip_comb t) = "<") ? false in FILTER_ASM_REWRITE_TAC is_less [LESS_REFL] THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC]; FIRST_ASSUM (\th g. (MP_TAC (assert(is_eq o concl) th)) g) THEN PURE_REWRITE_TAC [EXTENSION;IN_INSERT] THEN CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN DISCH_THEN (\th. PURE_ONCE_REWRITE_TAC [th]) THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [EXISTS_TAC "CARD (s:(*)set)" THEN REWRITE_TAC [LESS_REFL] THEN FIRST_ASSUM ACCEPT_TAC; EXISTS_TAC "n:num" THEN FILTER_ASM_REWRITE_TAC (\t. not(lhs t) = "s:(*)set" ? true) []; SUBST1_TAC (ASSUME "x:* = (n < CARD (s:(*)set) => f n | e)") THEN SUBST1_TAC (ASSUME "n = CARD (s:(*)set)") THEN REWRITE_TAC [LESS_REFL]; SUBST1_TAC (ASSUME "x:* = (n < CARD (s:(*)set) => f n | e)") THEN DISJ2_TAC THEN EXISTS_TAC "n:num" THEN REWRITE_TAC [ASSUME "n < CARD (s:(*)set)"]]]]);; quit();; % Needed for Common Lisp % hol88-2.02.19940316/Library/finite_sets/0000750000212700021270000000000005533117176015653 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/Manual/0000750000212700021270000000000005535604225017066 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/Manual/entries-intro.tex0000640000212700021270000000033005147526712022412 0ustar cammcammThis chapter provides documentation on all the \ML\ functions that are made available in \HOL\ when the \ml{finite\_sets} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/finite_sets/Manual/finite_sets.log0000640000212700021270000000425105535604274022114 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:08 **finite_sets.tex (finite_sets.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file finite_sets.idx (finite_sets.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) (title.tex [1 ] [2]) (finite_sets.toc [3 ]) \tf@toc=\write4 [4] (description.tex Chapter 1. [1 ] [2] [3] [4] [5] LaTeX Warning: Reference `abst' on page 6 undefined on input line 334. LaTeX Warning: Reference `abst' on page 6 undefined on input line 351. [6] [7] [8] [9] [10] [11] [12] [13] [14] [15] LaTeX Warning: Reference `abst' on page 16 undefined on input line 1129. [16] [17]) [18] (entries.tex Chapter 2. (entries-intro.tex) [19 ] [20] [21] [22] [23] [24] [25] [26]) [27] (theorems.tex [28 ] Chapter 3. (theorems-intro.tex) [29] [30] [31] [32] [33] [34] [35] [36] [37] [38]) [39] (references.tex [40 ]) [41] (index.tex [42 ] [43] [44]) (finite_sets.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) ) Here is how much of TeX's memory you used: 479 strings out of 11977 4040 string characters out of 87025 41862 words of memory out of 262141 2303 multiletter control sequences out of 9500 20116 words of font info for 77 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 18i,12n,19p,314b,580s stack positions out of 300i,100n,60p,3000b,4000s Output written on finite_sets.dvi (48 pages, 115272 bytes). hol88-2.02.19940316/Library/finite_sets/Manual/description.tex0000640000212700021270000014556305156667276022170 0ustar cammcamm\chapter{The finite{\und}sets Library} The \ml{finite\_sets} library contains a theory of sets based on a defined logical type \ml{(*)set}, values of which are finite collections or `sets' of elements of type \ml{*}. The library was originally written in May 1989 by P.\ J.\ Windley and Philippe Leveilley. It was completely rewritten by the present author for \HOL\ version 2.01 in early 1992. The aim of this revision was to make the \ml{finite\_sets} library closely parallel to the \HOL\ \ml{sets} and \ml{pred\_sets} libraries, with the same names for constants and theorems and, as far as possible, the same form of definitions for operations on sets. This consistency across the three set theory libraries allows proofs done in one library to be easily adapted to the others. It is also helpful to users who, for example, have to switch between set theory libraries for different projects. There is only one theory in the \ml{finite\_sets} library, namely the theory `\ml{finite\_sets}'. This contains all the definitions and theorems in the library. This document, adapted from the manual for the \ml{sets} library~\cite{melham}, explains the logical basis of this theory. The theory itself closely follows the finite set theory presented in chapter 10 of Manna and Waldinger's book~\cite{manna}. This document also explains the theorem-proving support provided by the \ml{finite\_sets} library, which includes conversions evaluating various operations on finite sets described by enumeration of their elements. The library also provides parser and pretty-printer support for certain terms that denote finite sets. \section{The type definition}\index{definition!of (*)set@of {\ptt (*)set}|(} The \ml{finite\_sets} library is based on a polymorphic type of sets \ml{(*)set}, values of which unordered finite collections of values of the base type \ml{*}. The representing type for the definition of \ml{(*)set} is the type of predicates {\small\verb!*->bool!}; the values of type \ml{(*)set} correspond to precisely those predicates that are true of a finite number of values of type \ml{*}. The set of all such predicates is defined inductively in terms of representations of the empty set and the operation of inserting an element into an already existing set. The empty set is represented by the constant false predicate {\small\verb!\x.F!}. The insertion operation is represented by the function that maps a value \ml{x:*} and a predicate \ml{s} representing a set to the predicate {\small\verb!\e. (e = x) \/ s e!}, which represents of the set obtained by adding {\small\verb!x!} to the set represented by {\small\verb!s!}. A predicate {\small\verb!s:*->bool!} then represents a finite set iff it is in the intersection of all classes of predicates that contain the representation of empty and are closed under the representation of the insertion operation. Hence {\small\verb!s:*->bool!} represents a finite set if and only if it can be obtained by applying a finite sequence of insert operations to the empty set. This characterization of the finite sets is expressed formally in the \ml{finite\_sets} theory by the constant \ml{IS\_SET\_REP}, which is defined the following constant specification: \begin{hol} \index{definition!of IS\_SET\_REP@of {\ptt IS\_SET\_REP}} \index{IS\_SET\_REP@{\ptt IS\_SET\_REP}} \begin{verbatim} IS_SET_REP |- IS_SET_REP(\x. F) /\ (!s. IS_SET_REP s ==> (!x. IS_SET_REP(\y. (y = x) \/ s y))) /\ (!P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. IS_SET_REP s ==> P s)) \end{verbatim}\end{hol} \noindent The specification has three conjuncts, which constitute an {\it inductive definition\/} (see~\cite{ind-defs}) of the class of all finite set representations. The first conjunct states that the constant false predicate {\small\verb!\x.F!} is included in the class of predicates that represent finite sets. The second states that the class of predicates that represent finite sets is closed under the element insertion operation. And the third states that \ml{IS\_SET\_REP} is true of precisely the smallest such class of predicates. Using this definition of the class of finite sets, the type \ml{(*)set} is defined formally in the library by the type definition: \begin{hol} \index{set\_TY\_DEF@{\ptt set\_TY\_DEF}} \begin{verbatim} set_TY_DEF |- ?rep:(*)set->(*->bool). TYPE_DEFINITION IS_SET_REP rep \end{verbatim}\end{hol} \noindent This definitional axiom asserts the existence of a bijection \ml{rep} between the type {\small\verb!(*)set!} and the class of all predicates on \ml{*} that represent finite sets. The\index{naming conventions!for definitions|(} theorem \ml{set\_TY\_DEF} is named according to the general convention that definitions in the \ml{finite\_sets} library are given names ending in `{\small\verb!_DEF!}'.\index{naming conventions!for definitions|)}% \index{definition!of (*)set@of {\ptt (*)set}|)} \section{Abstract characterization of the type {\tt (*)set}}\index{axioms for (*)set@axioms for {\ptt (*)set}|(} The \ml{finite\_sets} library contains an abstract characterization of finite sets derived by formal proof from the type definition for {\small\verb!(*)set!}. This characterizes finite sets in terms of three constants: \ml{EMPTY}, which denotes the empty set; \ml{INSERT}, which is the insertion operation by which non-empty sets are constructed; and the membership relation \ml{IN}. These basic constants are introduced simultaneously by the following constant specification: \begin{hol} \index{definition!of IN@of {\ptt IN}} \index{definition!of EMPTY@of {\ptt EMPTY}} \index{definition!of INSERT@of {\ptt INSERT}} \index{FINITE\_SET\_DEF@{\ptt FINITE\_SET\_DEF}} \begin{verbatim} FINITE_SET_DEF |- (!x. ~x IN EMPTY) /\ (!x y s. x IN (y INSERT s) = (x = y) \/ x IN s) /\ (!x s. x INSERT (x INSERT s) = x INSERT s) /\ (!x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)) /\ (!P. P EMPTY /\ (!s. P s ==> (!e. P(e INSERT s))) ==> (!s. P s)) \end{verbatim}\end{hol} \noindent The five conjuncts of this theorem constitute a derived `axiomatization' for finite sets; once this theorem has been proved, it provides a complete basis for all further reasoning about sets. In particular, users of the library should never have to appeal to the type definition for {\small\verb!(*)set!}. The library theory \ml{finite\_sets} itself is developed entirely on the basis of these `axioms' of set theory. The first two conjuncts of \ml{FINITE\_SET\_DEF} specify the membership relation \ml{IN} for empty and non-empty sets. The next two conjuncts state that sets do not contain multiple instances of the same element and that the elements of a set are not ordered. The final conjunct is an induction\index{induction} theorem for finite sets. It states that if a property is true of the empty set and is preserved by the insertion operation, then it holds of all sets. It follows from this theorem that every finite set is either empty or can be built up from the empty set by a finite number of insertion operations. For consistency with the other set libraries, the first four conjuncts of \ml{FINITE\_SET\_DEF} are stored as separate theorems in the \ml{finite\_sets} library. They are given the names shown below. \begin{hol} \index{NOT\_IN\_EMPTY@{\ptt NOT\_IN\_EMPTY}} \index{IN\_INSERT@{\ptt IN\_INSERT}} \index{INSERT\_INSERT@{\ptt INSERT\_INSERT}} \index{INSERT\_COMM@{\ptt INSERT\_COMM}} \begin{verbatim} NOT_IN_EMPTY = |- !x. ~x IN {} IN_INSERT = |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s INSERT_INSERT = |- !x s. x INSERT (x INSERT s) = x INSERT s INSERT_COMM = |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) \end{verbatim}\end{hol} \noindent The\index{induction|(} induction property is also saved as a separate theorem, but in a slightly stronger form than that in which it appears as part of \ml{FINITE\_SET\_DEF}. This theorem is: \begin{hol} \index{SET\_INDUCT@{\ptt SET\_INDUCT}} \begin{verbatim} SET_INDUCT |- !P. P EMPTY /\ (!s. P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> !s. P s \end{verbatim}\end{hol} \noindent The `step' case of this stronger induction theorem requires one to show only that the property \ml{P} is preserved by the operation of inserting an element not already in a set \ml{s} for which \ml{P s} is assumed to hold.\index{induction|)} The \ml{finite\_sets} library contains many pre-proved theorems the constants about \ml{IN}, \ml{EMPTY}, and \ml{INSERT}. These include the fundamental set equality theorem: \begin{hol} \index{EXTENSION@{\ptt EXTENSION}} \begin{verbatim} EXTENSION = |- !s t. (s = t) = (!x. x IN s = x IN t) \end{verbatim}\end{hol} \noindent \ml{EXTENSION} states that two sets are equal exactly when they have the same elements, which corresponds to what is usually called the {\it axiom of extension\/}\index{axiom of extension} for sets. For a complete list of the other built-in theorems about \ml{IN}, \ml{EMPTY}, and \ml{INSERT}, see chapter~\ref{theorems}.\index{axioms for (*)set@axioms for {\ptt (*)set}|)} \section{The set induction tactic}\index{induction|(} The library contains\index{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(} \index{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(} an induction tactic called \ml{SET\_INDUCT\_TAC} which made available when the library is loaded. When applied to a goal of the form {\small\verb!"!$s$\verb!. !$P$\verb!"!}, this tactic reduces it to proving that the property of sets expressed by {\small\verb!\!$s$\verb!.!$P$} holds of the empty set and is preserved by the insertion of an element into an arbitrary finite set. Since every finite set can be built up from the empty set by repeated insertion of values, these subgoals imply that this property holds of all finite sets. The following session illustrates the use of the tactic \ml{SET\_INDUCT\_TAC} for proving the fundamental theorem \ml{EXTENSION}. We first set up a goal for the `hard' direction of the equivalence stated by this theorem: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #g "!s t. (!x:*. x IN s = x IN t) ==> (s = t)";; "!s t. (!x. x IN s = x IN t) ==> (s = t)" () : void \end{verbatim}\end{session} \noindent Expanding with \ml{SET\_INDUCT\_TAC} yields: \begin{session}\begin{verbatim} #expand SET_INDUCT_TAC;; OK.. 2 subgoals "!t. (!x. x IN (e INSERT s) = x IN t) ==> (e INSERT s = t)" [ "!t. (!x. x IN s = x IN t) ==> (s = t)" ] [ "~e IN s" ] "!t. (!x. x IN {} = x IN t) ==> ({} = t)" () : void \end{verbatim}\end{session} \noindent The resulting subgoals are reasonably easy to prove, given several other basic theorems about membership, the empty set and insertion. (The \HOL\ proof closely follows the proof in~\cite{manna}.) Note that \ml{SET\_INDUCT\_TAC} is based on the stronger induction theorem discussed above, so it may be assumed in the step case that the value \ml{e} being inserted into the set \ml{s} is not already an element of \ml{s}.\index{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}% \index{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}% \index{induction|)} \subsection{Parser and pretty-printer support}\label{finite} The \ml{finite\_sets} library provides special parser and pretty-printer support for finite sets described by enumeration of their elements. This notation is introduced by a call made when the library is loaded to the built-in \ML\ function \ml{define\_finite\_set\_syntax}% \index{define\_finite\_set\_syntax@{\ptt define\_finite\_set\_syntax}} (see~\cite{description} for details of this function). This has the effect of extending the \HOL\ parser so that a quotation of the form {\small\verb!"{!\tt$t_1$,$t_2$,\dots,$t_n$\verb!}"!} parses to the following set built up from \ml{EMPTY} by repeatedly using the function \ml{INSERT}: \begin{hol}\begin{alltt} INSERT \m{t\sb{1}} (INSERT \m{t\sb{2}} \dots (INSERT \m{t\sb{n}} EMPTY)\dots) \end{alltt}\end{hol} \noindent Note that the quotation {\small\verb!"{}"!} just parses to the constant \ml{EMPTY}. When the \ml{print\_set}\index{print\_set@{\ptt print\_set} (flag)} flag is \ml{true}, the \HOL\ pretty-printer for terms inverts this transformation. Users should note that care must be taken with regard to the precedence of comma in a context {\small\verb!"{!\dots\verb!}"!}, as the following session illustrates: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #set_flag(`print_set`,false);; true : bool #"{1,2,3,4}";; "1 INSERT (2 INSERT (3 INSERT (4 INSERT EMPTY)))" : term #"{(1,2),(3,4)}";; "(1,2) INSERT ((3,4) INSERT EMPTY)" : term #"{((1,2),(3,4))}";; "((1,2),3,4) INSERT EMPTY" : term \end{verbatim}\end{session} \noindent Different grouping by means of enclosing parentheses has given sets with four elements (each a number), two elements (each of which is a pair), and one element (a pair of pairs) respectively. \section{Set inclusion} The infix functions \ml{SUBSET} and \ml{PSUBSET} denote the binary relations of set inclusion and proper set inclusion, respectively. These are defined formally in the obvious way: \begin{hol} \index{definition!of SUBSET@of {\ptt SUBSET}} \index{SUBSET\_DEF@{\ptt SUBSET\_DEF}} \index{definition!of PSUBSET@of {\ptt PSUBSET}} \index{PSUBSET\_DEF@{\ptt PSUBSET\_DEF}} \begin{verbatim} SUBSET_DEF |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) PSUBSET_DEF |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) \end{verbatim}\end{hol} \noindent That is, \ml{s} is a subset of \ml{t} if every element of \ml{s} is also an element of \ml{t}; and \ml{s} is a proper subset of \ml{t} if it is a subset of \ml{t} but not equal to \ml{t}. Various pre-proved theorems about the subset and proper subset relations are supplied by the \ml{sets} library. For example, the fact that \ml{SUBSET} is a partial order is stated by the three built-in theorems shown below. \begin{hol} \index{SUBSET\_TRANS@{\ptt SUBSET\_TRANS}} \index{SUBSET\_REFL@{\ptt SUBSET\_REFL}} \index{SUBSET\_ANTISYM@{\ptt SUBSET\_ANTISYM}} \begin{verbatim} SUBSET_REFL |- !s. s SUBSET s SUBSET_TRANS |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u SUBSET_ANTISYM |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) \end{verbatim}\end{hol} \noindent Also provided are built-in theorems about the relationship between set inclusion and other constants or operations on sets. For example, there are the following facts about set inclusion and the empty and universal sets: \begin{hol} \index{EMPTY\_SUBSET@{\ptt EMPTY\_SUBSET}} \index{SUBSET\_UNIV@{\ptt SUBSET\_UNIV}} \index{NOT\_PSUBSET\_EMPTY@{\ptt NOT\_PSUBSET\_EMPTY}} \index{NOT\_UNIV\_PSUBSET@{\ptt NOT\_UNIV\_PSUBSET}} \begin{verbatim} EMPTY_SUBSET |- !s. {} SUBSET s SUBSET_UNIV |- !s. s SUBSET UNIV NOT_PSUBSET_EMPTY |- !s. ~s PSUBSET {} NOT_UNIV_PSUBSET |- !s. ~UNIV PSUBSET s \end{verbatim}\end{hol} \noindent As\index{naming conventions!for theorems generally|(} these examples illustrate, the names of theorems in the \ml{sets} library are generally constructed from the names of the constants they contain. Furthermore, the ordering of elements in the name of a theorem attempts to reflect the content of the theorem itself.\index{naming conventions!for theorems generally|)} \section{Union, intersection, and set difference} The binary operations of union, intersection and set difference are all defined using the set abstraction notation introduced above in section~\ref{abst}. The formal definitions are: \begin{hol} \index{definition!of UNION@of {\ptt UNION}} \index{UNION\_DEF@{\ptt UNION\_DEF}} \index{definition!of INTER@of {\ptt INTER}} \index{INTER\_DEF@{\ptt INTER\_DEF}} \index{definition!of DIFF@of {\ptt DIFF}} \index{DIFF\_DEF@{\ptt DIFF\_DEF}} \begin{verbatim} UNION_DEF |- !s t. s UNION t = {x | x IN s \/ x IN t} INTER_DEF |- !s t. s INTER t = {x | x IN s /\ x IN t} DIFF_DEF |- !s t. s DIFF t = {x | x IN s /\ ~x IN t} \end{verbatim}\end{hol} \noindent These definitions illustrate the practical utility of the scheme for variable binding in set abstractions discussed above in section~\ref{abst}. An abstraction {\small\verb!"{!$E$\verb! | !$P$\verb!}"!} binds only the variables that occur in both {\small $E$} and {\small $P$}, and the variables \ml{s} and \ml{t} in the set abstractions shown above may therefore be made parameters to the sets\pagebreak[3] constructed by them. Using \ml{SET\_EQ\_CONV}, it is trivial to derive the following membership conditions for \ml{UNION}, \ml{INTER} and \ml{DIFF} from the definitions given above. As\index{naming conventions!for membership conditions|(} a general rule, theorems stating membership conditions of the kind illustrated by these examples are given names of the form {\small\verb!IN_!$\langle\hbox{\it constant\/}\rangle$} ending in the name of the operation used to construct the set in question.\index{naming conventions!for membership conditions|)} \begin{hol} \index{IN\_UNION@{\ptt IN\_UNION}} \index{IN\_INTER@{\ptt IN\_INTER}} \index{IN\_DIFF@{\ptt IN\_DIFF}} \begin{verbatim} IN_UNION |- !s t x. x IN (s UNION t) = x IN s \/ x IN t IN_INTER |- !s t x. x IN (s INTER t) = x IN s /\ x IN t IN_DIFF |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t \end{verbatim}\end{hol} \noindent These theorems, which are saved in the library under the names indicated above, may in practice be used as the defining properties of union, intersection and set difference; users should almost never have to appeal directly to the definitions of these operations. Other built-in theorems about \ml{UNION}, \ml{INTER} and \ml{DIFF} may be found in chapter~\ref{theorems}. \section{Disjoint sets} Two sets are {\it disjoint\/} if they have no elements in common. This concept is formalized in the \ml{sets} library by the constant \ml{DISJOINT}, the definition of which is: \begin{hol} \index{definition!of DISJOINT@of {\ptt DISJOINT}} \index{DISJOINT\_DEF@{\ptt DISJOINT\_DEF}} \begin{verbatim} DISJOINT_DEF |- !s t. DISJOINT s t = (s INTER t = {}) \end{verbatim}\end{hol} \noindent At present, there are relatively few pre-proved theorems about the \ml{DISJOINT} relation in the library. But see chapter~\ref{theorems} for the few theorems about \ml{DISJOINT} that are in fact available in the \ml{sets} library. \section{Insertion and deletion of an element} To aid in the construction of particular sets of values (especially finite sets) the library contains definitions of two constants \ml{INSERT} and \ml{DELETE}. These denote the operations of augmenting a set with a given value and removing a value from a set, respectively. The formal definitions of these operations are: \begin{hol} \index{definition!of INSERT@of {\ptt INSERT}} \index{INSERT\_DEF@{\ptt INSERT\_DEF}} \index{definition!of DELETE@of {\ptt DELETE}} \index{DELETE\_DEF@{\ptt DELETE\_DEF}} \begin{verbatim} INSERT_DEF |- !x s. x INSERT s = {y | (y = x) \/ y IN s} DELETE_DEF |- !s x. s DELETE x = s DIFF (INSERT x EMPTY) \end{verbatim}\end{hol} \noindent The elements of the set denoted by {\small\verb!x INSERT s!} are all the elements of the set \ml{s} together with the value \ml{x}, which may or may not be an element of \ml{s} itself. The set denoted by {\small\verb!s DELETE x!} contains all the elements of \ml{s} except the value \ml{x}. {\samepage The membership conditions for sets constructed using \ml{INSERT} and \ml{DELETE} are given by the following pre-proved theorems: \begin{hol} \index{IN\_INSERT@{\ptt IN\_INSERT}} \index{IN\_DELETE@{\ptt IN\_DELETE}} \begin{verbatim} IN_INSERT |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s IN_DELETE |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) \end{verbatim}\end{hol} \noindent In addition, the library} contains a substantial collection of theorems about the relationship between the operations \ml{INSERT} and \ml{DELETE} and other relations and operations on sets. Chapter~\ref{theorems} gives a complete list of these theorems. \subsection{Conversions for enumerated finite sets} The \ml{sets} library provides a collection of optimized conversions for computing the results of operations and predicates on finite sets specified by enumeration of their elements. All these conversions, the current implementations of which are somewhat experimental, are designed to work only for finite sets of the form {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!}. The sections that follow describe most of these conversions; the remainder are discussed in later sections of this manual. \subsubsection{Membership}\label{inconv} The\index{IN\_CONV@{\ptt IN\_CONV}|(}% \index{conversions!IN\_CONV@{\ptt IN\_CONV}|(} most basic conversion for finite sets is a decision procedure for membership called \ml{IN\_CONV}. In general, a way of deciding equality of elements is needed in order to determine whether a given value is an element of a particular finite set. The function \begin{hol}\begin{verbatim} IN_CONV : conv -> conv \end{verbatim}\end{hol} \noindent must therefore be supplied with a conversion that implements a decision procedure for equality of set elements. It is assumed that this conversion will map equations {\small\tt"$e_1$ = $e_2$"} between elements of a base type \ml{ty} to the theorem {\small\tt |- ($e_1$ = $e_2$) = T} or to the theorem {\small\tt |- ($e_1$ = $e_2$) = F}, as appropriate. If \ml{conv} is an equality conversion of the kind described above, then the function returned by \ml{IN\_CONV conv} is a conversion that decides membership in finite sets of values of the base type \ml{ty}. In particular, a call: \begin{hol}\begin{alltt} IN\_CONV conv "\m{t} IN \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb" \end{alltt}\end{hol} \noindent returns the theorem \begin{hol}\begin{alltt} |- \m{t} IN \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb = T \end{alltt}\end{hol} \noindent if the term $t$ is alpha-equivalent to some term $t_i$ or if the supplied conversion \ml{conv} proves {\tt |- ($t$ = $t_i$) = T} for some $i$ where $1 \leq i \leq n$. If, on the other hand \ml{conv} proves the theorem {\tt |- ($t$ = $t_i$) = F} for all $i$ where $1 \leq i \leq n$, then the result is the theorem \begin{hol}\begin{alltt} |- \m{t} IN \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb = F \end{alltt}\end{hol} \noindent In all other cases, the call to \ml{IN\_CONV} shown above will fail. The following session shows how \ml{IN\_CONV} can be used in practice. \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #IN_CONV num_EQ_CONV "1 IN {2,1,3}";; |- 1 IN {2,1,3} = T #IN_CONV num_EQ_CONV "4 IN {2,1,3}";; |- 4 IN {2,1,3} = F \end{verbatim}\end{session} \noindent The built-in conversion \ml{num\_EQ\_CONV} is used here to decide equality of the natural numbers involved in the membership assertions\pagebreak[3] being proved. An example in which \ml{IN\_CONV} fails is the following: \begin{session}\begin{verbatim} #IN_CONV num_EQ_CONV "x IN {1,2,3}";; evaluation failed IN_CONV #num_EQ_CONV "x = 1";; evaluation failed num_EQ_CONV \end{verbatim}\end{session} \noindent Failure occurs in this case because the term \ml{x} is a variable, and \ml{num\_EQ\_CONV} therefore cannot determine if it is equal to any of the set elements \ml{1}, \ml{2} or \ml{3}. Note, however, that the supplied conversion is not required to prove anything if the value being tested for membership happens to be syntactically identical to an element of the given set: \begin{session}\begin{verbatim} #IN_CONV NO_CONV "x IN {1,x,3}";; |- x IN {1,x,3} = T \end{verbatim}\end{session} \noindent In this case, the supplied conversion, namely \ml{NO\_CONV}, always fails; but the call to \ml{IN\_CONV} nonetheless succeeds and returns the appropriate result.\index{IN\_CONV@{\ptt IN\_CONV}|)}% \index{conversions!IN\_CONV@{\ptt IN\_CONV}|)} \subsubsection{Union} The\index{UNION\_CONV@{\ptt UNION\_CONV}|(}% \index{conversions!UNION\_CONV@{\ptt UNION\_CONV}|(} \ml{sets} library contains a conversion \begin{hol}\begin{verbatim} UNION_CONV : conv -> conv \end{verbatim}\end{hol} \noindent that can be used to compute the union of two finite sets. The first argument to \ml{UNION\_CONV} (i.e.\ the conversion argument) is expected to be an equality conversion of the same kind required as an argument by \ml{IN\_CONV} (see section~\ref{inconv}). As will be seen below, this conversion is used by \ml{UNION\_CONV} to simplify the set that it computes as the result of taking the union of two finite sets. Given an equality conversion \ml{conv}, the function \ml{UNION\_CONV} returns a conversion that computes the union of a finite set {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} and another set {\small$s$}. The second set {\small$s$} in fact need not be finite. Ignoring, for the moment, the possible simplification done using the supplied conversion \ml{conv}, a call: \begin{hol}\begin{alltt} UNION\_CONV conv "\lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb UNION \m{s}" \end{alltt}\end{hol} \noindent just returns the theorem \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb UNION \m{s} = \m{t\sb{1}} INSERT (\m{\dots} (\m{t\sb{n}} INSERT \m{s})\m{\dots}) \end{alltt}\end{hol} \noindent That is, \ml{UNION\_CONV} computes the required union as a repeated insertion of values into the set {\small$s$}.\pagebreak[3] When {\small$s$} is a finite set of the form {\small\verb!"{!\tt$u_1$,\dots,$u_m$\verb!}"!}, the {\samepage resulting theorem will have the form shown below. \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb UNION \lb\m{u\sb{1}},\dots,\m{u\sb{m}}\rb = \lb\m{t\sb{1}},\m{\dots},\m{t\sb{n}},\m{u\sb{1}},\m{\dots},\m{u\sb{m}}\rb \end{alltt}\end{hol} \noindent When computing} theorems of this form (i.e.\ when the second set of the union is a finite set {\small\verb!"{!\tt$u_1$,\dots,$u_m$\verb!}"!}) the function \ml{UNION\_CONV} attempts to remove redundant elements in the resulting set using the supplied equality conversion \ml{conv}. In particular, if \ml{conv} is able to prove that some element {\small$t_i$} of {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} is equal to any element {\small$u_j$} of {\small\verb!"{!\tt$u_1$,\dots,$u_m$\verb!}"!}, that is if the conversion \ml{conv} maps the term {\small\verb!"!$t_i$\verb! = !$u_j$\verb!"!} to the theorem {\small\verb!|- (!$t_i$\verb! = !$u_j$\verb!) = T!}, then the resulting theorem will be \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots\m{t\sb{i}},\dots,\m{t\sb{n}}\rb UNION \lb\m{u\sb{1}},\dots,\m{u\sb{j}},\dots,\m{u\sb{m}}\rb = \lb\m{t\sb{1}},\m{\dots},\m{t\sb{n}},\m{u\sb{1}},\dots,\m{u\sb{j}},\dots,\m{u\sb{m}}\rb \end{alltt}\end{hol} \noindent That is, the redundant term \m{t_i} will be removed from the initial sequence of elements in the resulting finite set. The function \ml{UNION\_CONV} also checks for and eliminates alpha-equivalent elements. Some examples of \ml{UNION\_CONV} in use are shown in the following \HOL\ session: \begin{session}\begin{verbatim} #UNION_CONV NO_CONV "{1,2,3} UNION {4,5,6}";; |- {1,2,3} UNION {4,5,6} = {1,2,3,4,5,6} #UNION_CONV NO_CONV "{1,2,3} UNION {3,2,SUC 0}";; |- {1,2,3} UNION {3,2,SUC 0} = {1,3,2,SUC 0} \end{verbatim}\end{session} \noindent The supplied equality conversion in these examples is \ml{NO\_CONV}, and only the elements of the first set {\small\verb!{1,2,3}!} that are redundant by virtue of being alpha-equivalent to elements of the second set are eliminated from the resulting set. An example in which the equality conversion is actually used is: \begin{session}\begin{verbatim} #UNION_CONV num_EQ_CONV "{1,2,3} UNION {3,2,SUC 0}";; |- {1,2,3} UNION {3,2,SUC 0} = {3,2,SUC 0} \end{verbatim}\end{session} \noindent In this case, \ml{num\_EQ\_CONV} is used to prove that {\small\verb!1!} is equal to {\small\verb!SUC 0!}, so that the resulting union is the set {\small\verb!"{3,2,SUC 0}"!}, rather than {\small\verb!"{1,3,2,SUC 0}!"}.\index{UNION\_CONV@{\ptt UNION\_CONV}|)}% \index{conversions!UNION\_CONV@{\ptt UNION\_CONV}|)} \subsubsection{Insertion} The\index{INSERT\_CONV@{\ptt INSERT\_CONV}|(}% \index{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|(} conversion \ml{INSERT\_CONV} performs the following reduction on finite sets: \begin{hol}\begin{alltt} {\normalsize\rm reduce}\quad"\m{t} INSERT \lb\m{t\sb{1}},\dots,\m{t\sb{i}},\dots,\m{t\sb{n}}\rb"\quad\m{\normalsize\rm to}\quad"\lb\m{t\sb{1}},\dots,\m{t\sb{i}},\dots,\m{t\sb{n}}\rb" \end{alltt}\end{hol} \noindent if a supplied equality conversion can prove {\small\verb!|- (!$t$\verb! = !$t_i$\verb!) = T!}. Since the enumerated set notation {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} is just a parser-supported abbreviation (see section~\ref{finite}), this is equivalent to reducing the set {\small\verb!"{!\tt$t$,$t_1$,\dots,$t_i$,\dots,$t_n$\verb!}"!} to {\small\verb!"{!\tt$t_1$,\dots,$t_i$,\dots,$t_n$\verb!}"!} when the terms {\small$t$} and {\small$t_i$} are provably equal.\pagebreak[3] More specifically, if for some {\small$t_i$} in {\small\verb!{!$t_1$\verb!,!\dots\verb!,!$t_n$\verb!}!}, the terms {\small$t$} and {\small$t_i$} are alpha-equivalent, of if the conversion \ml{conv} maps {\small\verb!"!$t$\verb! = !$t_i$\verb!"!} to the theorem {\small\verb!|- (!$t$\verb! = !$t_i$\verb!) = T!}, then the call: \begin{hol}\begin{alltt} INSERT\_CONV conv "\m{t} INSERT \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb";; \end{alltt}\end{hol} \noindent will return the theorem: \begin{hol}\begin{alltt} |- \m{t} INSERT \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb = \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb \end{alltt}\end{hol} Here is an example of \ml{INSERT\_CONV} in use: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #INSERT_CONV num_EQ_CONV "(SUC 2) INSERT {0,1,2,3}";; |- {SUC 2,0,1,2,3} = {0,1,2,3} \end{verbatim}\end{session} When applied repeatedly, \ml{INSERT\_CONV} can be used to reduce finite sets by eliminating as many redundant occurrences of elements as possible. An easy to program, but slow-running, way of doing this is to use \ml{DEPTH\_CONV}: \begin{session}\begin{verbatim} #DEPTH_CONV (INSERT_CONV num_EQ_CONV) "{1,3,x,SUC 1,SUC(SUC 1),2,1,3,x}";; |- {1,3,x,SUC 1,SUC(SUC 1),2,1,3,x} = {2,1,3,x} \end{verbatim}\end{session} \noindent For a faster alternative to this method, see the reference entry for \ml{INSERT\_CONV} in chapter~\ref{entries}.\index{INSERT\_CONV@{\ptt INSERT\_CONV}|)}% \index{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|)} \subsubsection{Deletion} The\index{DELETE\_CONV@{\ptt DELETE\_CONV}|(}% \index{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|(} conversion \ml{DELETE\_CONV} reduces terms of the form {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!} DELETE !$t$\verb!"!} by deleting all elements provably equal to {\small$t$} from the set {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!}. Like \ml{IN\_CONV} and \ml{INSERT\_CONV}, the function \ml{DELETE\_CONV} takes a conversion for deciding equality of set elements as an argument. If \ml{conv} is such a conversion, the call: \begin{hol}\begin{alltt} DELETE\_CONV conv "\lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb DELETE \m{t}";; \end{alltt}\end{hol} \noindent will return the theorem: \begin{hol}\begin{alltt} |- \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb DELETE \m{t} = \lb\m{t\sb{i}},\dots,\m{t\sb{j}}\rb \end{alltt}\end{hol} \noindent where the resulting set {\small\verb!{!\tt$t_i$,\dots,$t_j$\verb!}!} is the set of all values {\small$t_k$} in the original set {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!} for which \ml{conv} proves {\tt |- ($t_k$ = $t$) = F}, and where for all {\small$t_k$} in {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!} but not in {\small\verb!{!\tt$t_i$,\dots,$t_j$\verb!}!}, either {\small$t_k$} is alpha-equivalent to {\small$t$} or \ml{conv} proves {\tt |- ($t_k$ = $t$) = T}. Note that the conversion \ml{conv} must prove either equality or inequality for every element of the original set that is not simply alpha-equivalent to the deleted value. The following session shows \ml{DELETE\_CONV} in use: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #DELETE_CONV num_EQ_CONV "{0,1,2,3} DELETE (SUC 1)";; |- {0,1,2,3} DELETE (SUC 1) = {0,1,3} \end{verbatim}\end{session}% \index{DELETE\_CONV@{\ptt DELETE\_CONV}|)}% \index{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|)} \section{Singleton sets} A {\it singleton\/} set is a set that contains precisely one element. In the \ml{sets} library, the property of being a singleton set is expressed by the definition: \begin{hol} \index{definition!of SING@of {\ptt SING}} \index{SING\_DEF@{\ptt SING\_DEF}} \begin{verbatim} SING_DEF |- !s. SING s = (?x. s = {x}) \end{verbatim}\end{hol} \noindent The library contains several built-in theorems about singleton sets. These are sometimes expressed in terms of the predicate \ml{SING}, as for example in the theorem \begin{hol} \index{SING@{\ptt SING}} \begin{verbatim} SING |- !x. SING{x} \end{verbatim}\end{hol} \noindent But properties of singleton sets are more usually formulated as theorems about sets of the form `{\small\verb"{x}"}'. For example, the built-in theorems about singleton sets include: \begin{hol} \index{SING@{\ptt SING}} \begin{verbatim} NOT_SING_EMPTY |- !x. ~({x} = {}) IN_SING |- !x y. x IN {y} = (x = y) EQUAL_SING |- !x y. ({x} = {y}) = (x = y) \end{verbatim}\end{hol} \noindent A\index{naming conventions!for theorems about singletons|(} general convention is that theorems about singleton sets are given names that contain the element `\ml{SING}', regardless of whether or not they actually contain the predicate \ml{SING}.\index{naming conventions!for theorems about singletons|)} \section{The {\tt CHOICE} and {\tt REST} functions} The \ml{sets} library contains the definition of a functions \ml{CHOICE} which can be used to select an arbitrary element from a non-empty set. The function \ml{CHOICE} is defined formally by the following constant specification: \begin{hol} \index{definition!of CHOICE@of {\ptt CHOICE}} \index{CHOICE\_DEF@{\ptt CHOICE\_DEF}} \begin{verbatim} CHOICE_DEF |- !s. ~(s = {}) ==> (CHOICE s) IN s \end{verbatim}\end{hol} \noindent This theorem alone is the defining property for the constant \ml{CHOICE}, which is therefore an only partially specified function from sets to values. Note, in particular, that there is no information given by this definition about the result of applying \ml{CHOICE} to an empty set. The library also contains a function \ml{REST}, which is defined in terms of the \ml{CHOICE} function as follows \begin{hol} \index{definition!of REST@of {\ptt REST}} \index{REST\_DEF@{\ptt REST\_DEF}} \begin{verbatim} REST_DEF |- !s. REST s = s DELETE (CHOICE s) \end{verbatim}\end{hol} \noindent For any non-empty set \ml{s}, the set \ml{REST s} comprises all those elements of \ml{s} except the value selected from \ml{s} by \ml{CHOICE}. The library contains various built-in theorems about the functions \ml{CHOICE} and \ml{REST}; for a full list of these theorems, see chapter~\ref{theorems}. \section{Image of a function on a set} The {\it image\/} of a function {\small\verb!f:*->**!} on a set {\small\verb!s:(*)set!} is the set of values {\small\verb!f(x)!} for all \ml{x} in \ml{s}. In the \ml{sets} library, the image of a function on a set is defined in terms of the obvious set abstraction: \begin{hol} \index{definition!of IMAGE@of {\ptt IMAGE}} \index{IMAGE\_DEF@{\ptt IMAGE\_DEF}} \begin{verbatim} IMAGE_DEF |- !f s. IMAGE f s = {f x | x IN s} \end{verbatim}\end{hol} \noindent Using \ml{SET\_SPEC\_CONV}, is is trivial to prove from this definition the following membership condition for sets constructed using \ml{IMAGE}: \begin{hol} \index{IN\_IMAGE@{\ptt IN\_IMAGE}} \begin{verbatim} IN_IMAGE |- !y s f. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) \end{verbatim}\end{hol} \noindent The \ml{sets} library contains various theorems about \ml{IMAGE} in addition to this membership theorem. These include, for example, theorems about the image of a function on sets constructed by the operations of union and intersection. For a full list of theorems about \ml{IMAGE}, see chapter~\ref{theorems}. \subsection{Theorem-proving support} The\index{IMAGE\_CONV@{\ptt IMAGE\_CONV}|(}% \index{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|(} \ml{sets} library contains a conversion for computing the image of a function {\small\verb!f!} on a finite set {\small\verb!{!\tt$t_1$,\dots,$t_n$\verb!}!}. The function \begin{hol}\begin{verbatim} IMAGE_CONV : conv -> conv -> conv \end{verbatim}\end{hol} \noindent is parameterized by two conversions. The first conversion is expected to compute the result of applying the function {\small\verb!f!} to each element {\small$t_1$}, \dots, {\small $t_n$}. The second parameter is an equality conversion which is used to simplify the resulting image set by removing redundant occurrences of its elements. The following session shows a simple example of the use of \ml{IMAGE\_CONV} on terms of the form {\small\tt\verb!"IMAGE (\x.x+2) {!$t_1$,\dots,$t_n$\verb!}"!}. We first define a conversion that evaluates the result of applying the function {\small\verb!(\x.x+2)!} to a term {\small$t$}. \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #let AP_CONV = BETA_CONV THENC (TRY_CONV ADD_CONV);; AP_CONV = - : conv #AP_CONV "(\n.n+2) 7";; |- (\n. n + 2)7 = 9 \end{verbatim}\end{session} \noindent This conversion, together with the function \ml{IMAGE\_CONV}, gives a conversion for computing the image of {\small\verb!(\x.x+2)!} on a finite set of numerical values. \begin{session}\begin{verbatim} #IMAGE_CONV AP_CONV NO_CONV "IMAGE (\x.x+2) {1,2,3,4}";; |- IMAGE(\x. x + 2){1,2,3,4} = {3,4,5,6} #IMAGE_CONV AP_CONV NO_CONV "IMAGE (\x.x+2) {n,1,n}";; |- IMAGE(\x. x + 2){n,1,n} = {3,n + 2} \end{verbatim}\end{session} \noindent In this case, the second parameter supplied to \ml{IMAGE\_CONV} is the conversion \ml{NO\_CONV}. This means that no reduction of the resulting image set is done, beyond the elimination of elements that are provably redundant by virtue of being alpha-equivalent to some other element (as in the second example above). The following session illustrates the use of the second parameter to \ml{IMAGE\_CONV}. \begin{session}\begin{verbatim} #IMAGE_CONV BETA_CONV NO_CONV "IMAGE (\x. SUC x) {1,SUC 0,2,0}";; |- IMAGE(\x. SUC x){1,SUC 0,2,0} = {SUC 1,SUC(SUC 0),SUC 2,SUC 0} #IMAGE_CONV BETA_CONV num_EQ_CONV "IMAGE (\x. SUC x) {1,SUC 0,2,0}";; |- IMAGE(\x. SUC x){1,SUC 0,2,0} = {SUC(SUC 0),SUC 2,SUC 0} \end{verbatim}\end{session} \noindent In the first evaluation, just applying \ml{BETA\_CONV} to the application of {\small\verb!(\x. SUC x)!} to each element has resulted in an image set containing both {\small\verb!SUC 1!} and {\small\verb!SUC(SUC 0)!}. In the second example, \ml{num\_EQ\_CONV} is used to prove these values equal, and therefore to simplify the resulting set by eliminating one of them from it. For more detail about \ml{IMAGE\_CONV}, see the reference entry for this conversion in chapter~\ref{entries}.\index{IMAGE\_CONV@{\ptt IMAGE\_CONV}|)}% \index{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|)} \section{Mappings between sets} The \ml{sets} library contains a few basic definitions and theorems having to do with mappings between sets. A function \ml{f:*->**} is an {\it injective\/} (one-to-one) mapping from a set \ml{s:(*)set} to a set \ml{t:(**)set} if it takes distinct elements of \ml{s} to distinct element of \ml{t}: \begin{hol} \index{definition!of INJ@of {\ptt INJ}} \index{INJ\_DEF@{\ptt INJ\_DEF}} \begin{verbatim} INJ_DEF = |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) \end{verbatim}\end{hol} \noindent Likewise, a function \ml{f:*->**} is a {\it surjective\/} (onto) mapping from \ml{s} to \ml{t} if for every element \ml{x} of \ml{t} there is some element \ml{y} of \ml{s} for which {\small\verb!f y = x!}: \begin{hol} \index{definition!of SURJ@of {\ptt SURJ}} \index{SURJ\_DEF@{\ptt SURJ\_DEF}} \begin{verbatim} SURJ_DEF = |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) \end{verbatim}\end{hol} \noindent Finally, a function \ml{f:*->**} is a {\it bijection\/} from \ml{s} to \ml{t} if it is both injective and surjective: \begin{hol} \index{definition!of BIJ@of {\ptt BIJ}} \index{BIJ\_DEF@{\ptt BIJ\_DEF}} \begin{verbatim} BIJ_DEF = |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t \end{verbatim}\end{hol} There are a few pre-proved theorems about the predicates \ml{INJ}, \ml{SURJ}, and \ml{BIJ} available in the library; see chapter~\ref{theorems} for a full list of these theorems. The library also contains constant specifications for two functions \ml{LINV} and \ml{RINV}, which yield left and right inverses to injective and surjective mappings respectively. These functions are defined by: \begin{hol} \index{definition!of LINV@of {\ptt LINV}} \index{LINV\_DEF@{\ptt LINV\_DEF}} \index{definition!of RINV@of {\ptt RINV}} \index{RINV\_DEF@{\ptt RINV\_DEF}} \begin{verbatim} LINV_DEF = |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) RINV_DEF = |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) \end{verbatim}\end{hol} \noindent There are, at present, no additional built-in theorems about these two functions. Furthermore, the definitions of \ml{LINV} and \ml{RINV} shown above should be regarded as only provisional; they may be changed in future versions. \section{Finite and infinite sets} The \ml{sets} library includes the definition of a predicate called \ml{FINITE}, which is true of finite sets and false of infinite ones. The definition of this constant is shown below. \begin{hol} \index{definition!of FINITE@of {\ptt FINITE}} \index{FINITE\_DEF@{\ptt FINITE\_DEF}} \begin{verbatim} FINITE_DEF |- !s. FINITE s = (!P. P{} /\ (!s'. P s' ==> (!e. P(e INSERT s'))) ==> P s) \end{verbatim}\end{hol} \noindent That is, a set \ml{s} is finite precisely when it is in the smallest class of sets that contains the empty set and is closed under the \ml{INSERT} operation. This inductive definition makes \ml{FINITE} true of just those sets that can be constructed from the empty set by a finite sequence of applications of the \ml{INSERT} operation. The \ml{sets} library contains various built-in theorems that follow from the definition of \ml{FINITE} given above. Among these are the two fundamental theorems shown below: \begin{hol} \index{FINITE\_EMPTY@{\ptt FINITE\_EMPTY}} \index{FINITE\_INSERT@{\ptt FINITE\_INSERT}} \begin{verbatim} FINITE_EMPTY |- FINITE{} FINITE_INSERT |- !x s. FINITE(x INSERT s) = FINITE s \end{verbatim}\end{hol} \noindent These state that the empty set is indeed finite and insertion constructs finite sets only from other finite sets. See chapter~\ref{theorems} for other built-in theorems about finite sets. The above definition of \ml{FINITE} formalizes the notion of a finite set in logic, and it therefore also determines the form of definition for the complementary notion of an infinite set. In the \ml{sets} library, the predicate \ml{INFINITE} is defined as follows: \begin{hol} \index{definition!of INFINITE@of {\ptt INFINITE}} \index{INFINITE\_DEF@{\ptt INFINITE\_DEF}} \begin{verbatim} INFINITE_DEF |- !s. INFINITE s = ~FINITE s \end{verbatim}\end{hol} \noindent There are a few consequences of this definition stored in the \ml{sets} library. The following theorem, for example, states that the image of an injective function on an infinite set is infinite: \begin{hol} \index{IMAGE\_11\_INFINITE@{\ptt IMAGE\_11\_INFINITE}} \begin{verbatim} IMAGE_11_INFINITE |- !f. (!x y. (f x = f y) ==> (x = y)) ==> (!s. INFINITE s ==> INFINITE(IMAGE f s)) \end{verbatim}\end{hol} \noindent Other built-in theorems about \ml{INFINITE} can be found in chapter~\ref{theorems}. \subsection{Theorem-proving support} There are two \ML\ functions in the \ml{sets} library for reasoning about propositions that involve the finiteness predicate \ml{FINITE}. The\index{FINITE\_CONV@{\ptt FINITE\_CONV}|(} \index{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|(} first of these is a conversion \ml{FINITE\_CONV} which automatically proves that sets of the form {\small\verb!"{!\tt$t_1$,\dots,$t_n$\verb!}"!} are finite. Evaluating \begin{hol}\begin{alltt} FINITE\_CONV "FINITE \lb\m{t\sb{1}},\dots,\m{t\sb{n}}\rb";; \end{alltt}\end{hol} \noindent yields the theorem {\small\verb!|- FINITE {!\tt$t_1$,\dots,$t_n$\verb!} = T!}.% \index{FINITE\_CONV@{\ptt FINITE\_CONV}|)}% \index{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|)} \section{Cardinality of finite sets} The {\it cardinality\/} of a finite set is the number of elements it contains. In the \ml{sets} library, this is formalized by a constant \ml{CARD} defined by means of the following constant specification: \begin{hol} \index{definition!of CARD@of {\ptt CARD}} \index{CARD\_DEF@{\ptt CARD\_DEF}} \begin{verbatim} CARD_DEF |- (CARD{} = 0) /\ (!s. FINITE s ==> (!x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)))) \end{verbatim}\end{hol} \noindent This theorem is the sole defining property of \ml{CARD}. Because the equation in the second clause holds only under the assumption that \ml{s} is finite, this form of definition allows nothing significant to be deduced about the cardinality `\ml{CARD s}' of an {\it infinite\/} set \ml{s}. The built-in theorems about cardinality are all restricted to finite sets only, either implicitly as in the theorem: \begin{hol} \index{CARD\_SING@{\ptt CARD\_SING}} \begin{verbatim} CARD_SING |- !x. CARD{x} = 1 \end{verbatim}\end{hol} \noindent or explicitly, as in: \begin{hol} \index{FINITE\_ISO\_NUM@{\ptt FINITE\_ISO\_NUM}} \begin{verbatim} FINITE_ISO_NUM |- !s:(*)set. FINITE s ==> (?f:num->*. (!n m. n < (CARD s) /\ m < (CARD s) ==> (f n = f m) ==> (n = m)) /\ (s = {f n | n < (CARD s)})) \end{verbatim}\end{hol} \noindent This second theorem states that the elements of a finite set can always be put into a one-to-one correspondence with the natural numbers less than the set's cardinality---i.e. the elements of a finite set \ml{s} can be numbered \ml{0}, \ml{1}, \dots, {\small\verb!(CARD s)-1!}. Other theorems involving the cardinality function \ml{CARD} can be found in chapter~\ref{theorems}. \section{Using the library}\label{using} The \ml{finite\_sets} library is loaded into a user's \HOL\ session using the builtin \ML\ function \ml{load\_library} (see the \HOL\ manual for a general description of library loading). The first action in the load sequence is to update the internal \HOL\ search paths. A pathname to the library is added to the search path so that theorems may be autoloaded from the library theory \ml{finite\_sets}; and the \HOL\ help search path is updated with a pathname to online help files for the \ML\ functions in the library. After the search paths are updated, the actions taken by the load sequence for depend on the current state of the \HOL\ session. If the system is in draft mode, the library theory \ml{finite\_sets} is added as a new parent to the current theory. If the system is not in draft mode, but the current theory is an ancestor of the \ml{finite\_sets} theory in the library (e.g.\ the user is in a fresh \HOL\ session) then \ml{finite\_sets} is made the current theory. In both cases, the \ML\ functions provided by the library are loaded into \HOL\, and all the theorems in the library (including definitions) are set up to be autoloaded on demand. The parser and pretty-printer for the notation described above in sections~\ref{abst} and~\ref{finite} are then activated, and the \ML\ functions provided by the library for reasoning about sets are loaded. The \ml{finite\_sets} library is then fully loaded into the user's \HOL\ session. \subsection{Example session} The following session shows how \ml{finite\_sets} may be loaded using \ml{load\_library}. Suppose, beginning in a fresh \HOL\ session, the user wishes to create a theory \ml{foo} whose parents include the theory \ml{finite\_sets} in the library. This may be done as follows: \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #new_theory `foo`;; () : void #load_library `finite_sets`;; \(\vdots\) Library finite_sets loaded. () : void \end{alltt}\end{session} \noindent Loading the library while drafting the theory \ml{foo} makes the library theory \ml{finite\_sets} into a parent of \ml{foo}. The same effect could have been achieved (in a fresh session) by first loading the library and then creating \ml{foo}: \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #load_library `finite_sets`;; \(\vdots\) Library finite_sets loaded. () : void #new_theory `foo`;; () : void \end{alltt}\end{session} \noindent The theory \ml{finite\_sets} is first made the current theory of the new session. It then automatically becomes a parent of \ml{foo} when this theory is created by \ml{new\_theory}. Now, suppose that \ml{foo} has been created as shown above, and the user does some work in this theory, quits \HOL, and in a later session wishes to load the theory \ml{foo}. This must be done by {\it first\/} loading the \ml{finite\_sets} library and {\it then\/} loading the theory \ml{foo}. \setcounter{sessioncount}{1} \begin{session}\begin{alltt} #load_library `finite_sets`;; \(\vdots\) Library finite_sets loaded. () : void #load_theory `foo`;; Theory foo loaded () : void \end{alltt}\end{session} \noindent This sequence of actions ensures that the system can find the parent theory \ml{finite\_sets} when it comes to load \ml{foo}, since loading the library updates the search path. \subsection{The {\tt load\_finite\_sets} function}% \index{load\_finite\_sets@{\ptt load\_finite\_sets}|(} The \ml{finite\_sets} library may in many cases simply be loaded into the system as illustrated by the examples given above. There are, however, certain situations in which the library cannot be fully loaded at the time when the \ml{load\_library} is used. This occurs when the system is not in draft mode and the current theory is not an ancestor of the theory \ml{finite\_sets}. In this case, loading the library can (and will) update the search paths. But the theory \ml{finite\_sets} can neither be made into a parent of the current theory nor be made the current theory. This means that autoloading from the library can not at this stage be activated; and the \ML\ code in the library can not be loaded into \HOL, since it requires access to some of the theorems in the library. In the situation described above---when the system is not in draft mode and the current theory is not an ancestor of the theory \ml{finite\_sets}---the library load sequence defines an \ML\ function called \ml{load\_finite\_sets} in the current \HOL\ session. If at a future point in the session the \ml{finite\_sets} theory (now accessible via the search path) becomes an ancestor of the current theory, this function can then be used to complete loading of the library. Evaluating {\small\verb!load_finite_sets()!} in such a context loads the \ML\ functions of the \ml{finite\_sets} library into \HOL\ and activates autoloading from its theory files. It also activates the parser and pretty-printer support for set abstractions and finite sets. The function \ml{load\_finite\_sets} fails if the theory \ml{finite\_sets} is not an ancestor of the current \HOL\ theory. Note that the function \ml{load\_finite\_sets} is defined upon loading the \ml{finite\_sets} library only if the library theory \ml{finite\_sets} at the point of loading the library can neither be made into a new parent (i.e.\ the system is not in draft mode) nor be made the current theory.\index{load\_finite\_sets@{\ptt load\_finite\_sets}|)} hol88-2.02.19940316/Library/finite_sets/Manual/title.tex0000640000212700021270000000364205304703657020742 0ustar cammcamm% ===================================================================== % % Standard titlepage for finite_sets library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL finite{\und}sets Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf T.\ F.\ Melham \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \LARGE\bf DRAFT \end{center} \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf February 1992 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ T.\ F.\ Melham 1992 \end{center} \newpage hol88-2.02.19940316/Library/finite_sets/Manual/finite_sets.idx0000640000212700021270000003305705535604274022125 0ustar cammcamm\indexentry{definition!of (*)set@of {\ptt (*)set}|(}{1} \indexentry{definition!of IS\_SET\_REP@of {\ptt IS\_SET\_REP}}{2} \indexentry{IS\_SET\_REP@{\ptt IS\_SET\_REP}}{2} \indexentry{set\_TY\_DEF@{\ptt set\_TY\_DEF}}{2} \indexentry{naming conventions!for definitions|(}{2} \indexentry{naming conventions!for definitions|)}{2} \indexentry{definition!of (*)set@of {\ptt (*)set}|)}{2} \indexentry{axioms for (*)set@axioms for {\ptt (*)set}|(}{2} \indexentry{definition!of IN@of {\ptt IN}}{2} \indexentry{definition!of EMPTY@of {\ptt EMPTY}}{2} \indexentry{definition!of INSERT@of {\ptt INSERT}}{2} \indexentry{FINITE\_SET\_DEF@{\ptt FINITE\_SET\_DEF}}{2} \indexentry{induction}{3} \indexentry{NOT\_IN\_EMPTY@{\ptt NOT\_IN\_EMPTY}}{3} \indexentry{IN\_INSERT@{\ptt IN\_INSERT}}{3} \indexentry{INSERT\_INSERT@{\ptt INSERT\_INSERT}}{3} \indexentry{INSERT\_COMM@{\ptt INSERT\_COMM}}{3} \indexentry{induction|(}{3} \indexentry{SET\_INDUCT@{\ptt SET\_INDUCT}}{3} \indexentry{induction|)}{3} \indexentry{EXTENSION@{\ptt EXTENSION}}{3} \indexentry{axiom of extension}{3} \indexentry{axioms for (*)set@axioms for {\ptt (*)set}|)}{3} \indexentry{induction|(}{3} \indexentry{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(}{3} \indexentry{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|(}{3} \indexentry{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}{4} \indexentry{tactics!SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}|)}{4} \indexentry{induction|)}{4} \indexentry{define\_finite\_set\_syntax@{\ptt define\_finite\_set\_syntax}}{4} \indexentry{print\_set@{\ptt print\_set} (flag)}{5} \indexentry{definition!of SUBSET@of {\ptt SUBSET}}{5} \indexentry{SUBSET\_DEF@{\ptt SUBSET\_DEF}}{5} \indexentry{definition!of PSUBSET@of {\ptt PSUBSET}}{5} \indexentry{PSUBSET\_DEF@{\ptt PSUBSET\_DEF}}{5} \indexentry{SUBSET\_TRANS@{\ptt SUBSET\_TRANS}}{5} \indexentry{SUBSET\_REFL@{\ptt SUBSET\_REFL}}{5} \indexentry{SUBSET\_ANTISYM@{\ptt SUBSET\_ANTISYM}}{5} \indexentry{EMPTY\_SUBSET@{\ptt EMPTY\_SUBSET}}{5} \indexentry{SUBSET\_UNIV@{\ptt SUBSET\_UNIV}}{5} \indexentry{NOT\_PSUBSET\_EMPTY@{\ptt NOT\_PSUBSET\_EMPTY}}{5} \indexentry{NOT\_UNIV\_PSUBSET@{\ptt NOT\_UNIV\_PSUBSET}}{5} \indexentry{naming conventions!for theorems generally|(}{6} \indexentry{naming conventions!for theorems generally|)}{6} \indexentry{definition!of UNION@of {\ptt UNION}}{6} \indexentry{UNION\_DEF@{\ptt UNION\_DEF}}{6} \indexentry{definition!of INTER@of {\ptt INTER}}{6} \indexentry{INTER\_DEF@{\ptt INTER\_DEF}}{6} \indexentry{definition!of DIFF@of {\ptt DIFF}}{6} \indexentry{DIFF\_DEF@{\ptt DIFF\_DEF}}{6} \indexentry{naming conventions!for membership conditions|(}{6} \indexentry{naming conventions!for membership conditions|)}{6} \indexentry{IN\_UNION@{\ptt IN\_UNION}}{6} \indexentry{IN\_INTER@{\ptt IN\_INTER}}{6} \indexentry{IN\_DIFF@{\ptt IN\_DIFF}}{6} \indexentry{definition!of DISJOINT@of {\ptt DISJOINT}}{6} \indexentry{DISJOINT\_DEF@{\ptt DISJOINT\_DEF}}{6} \indexentry{definition!of INSERT@of {\ptt INSERT}}{7} \indexentry{INSERT\_DEF@{\ptt INSERT\_DEF}}{7} \indexentry{definition!of DELETE@of {\ptt DELETE}}{7} \indexentry{DELETE\_DEF@{\ptt DELETE\_DEF}}{7} \indexentry{IN\_INSERT@{\ptt IN\_INSERT}}{7} \indexentry{IN\_DELETE@{\ptt IN\_DELETE}}{7} \indexentry{IN\_CONV@{\ptt IN\_CONV}|(}{7} \indexentry{conversions!IN\_CONV@{\ptt IN\_CONV}|(}{7} \indexentry{IN\_CONV@{\ptt IN\_CONV}|)}{8} \indexentry{conversions!IN\_CONV@{\ptt IN\_CONV}|)}{8} \indexentry{UNION\_CONV@{\ptt UNION\_CONV}|(}{9} \indexentry{conversions!UNION\_CONV@{\ptt UNION\_CONV}|(}{9} \indexentry{UNION\_CONV@{\ptt UNION\_CONV}|)}{10} \indexentry{conversions!UNION\_CONV@{\ptt UNION\_CONV}|)}{10} \indexentry{INSERT\_CONV@{\ptt INSERT\_CONV}|(}{10} \indexentry{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|(}{10} \indexentry{INSERT\_CONV@{\ptt INSERT\_CONV}|)}{10} \indexentry{conversions!INSERT\_CONV@{\ptt INSERT\_CONV}|)}{10} \indexentry{DELETE\_CONV@{\ptt DELETE\_CONV}|(}{11} \indexentry{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|(}{11} \indexentry{DELETE\_CONV@{\ptt DELETE\_CONV}|)}{11} \indexentry{conversions!DELETE\_CONV@{\ptt DELETE\_CONV}|)}{11} \indexentry{definition!of SING@of {\ptt SING}}{11} \indexentry{SING\_DEF@{\ptt SING\_DEF}}{11} \indexentry{SING@{\ptt SING}}{11} \indexentry{SING@{\ptt SING}}{11} \indexentry{naming conventions!for theorems about singletons|(}{11} \indexentry{naming conventions!for theorems about singletons|)}{11} \indexentry{definition!of CHOICE@of {\ptt CHOICE}}{12} \indexentry{CHOICE\_DEF@{\ptt CHOICE\_DEF}}{12} \indexentry{definition!of REST@of {\ptt REST}}{12} \indexentry{REST\_DEF@{\ptt REST\_DEF}}{12} \indexentry{definition!of IMAGE@of {\ptt IMAGE}}{12} \indexentry{IMAGE\_DEF@{\ptt IMAGE\_DEF}}{12} \indexentry{IN\_IMAGE@{\ptt IN\_IMAGE}}{12} \indexentry{IMAGE\_CONV@{\ptt IMAGE\_CONV}|(}{13} \indexentry{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|(}{13} \indexentry{IMAGE\_CONV@{\ptt IMAGE\_CONV}|)}{13} \indexentry{conversions!IMAGE\_CONV@{\ptt IMAGE\_CONV}|)}{13} \indexentry{definition!of INJ@of {\ptt INJ}}{14} \indexentry{INJ\_DEF@{\ptt INJ\_DEF}}{14} \indexentry{definition!of SURJ@of {\ptt SURJ}}{14} \indexentry{SURJ\_DEF@{\ptt SURJ\_DEF}}{14} \indexentry{definition!of BIJ@of {\ptt BIJ}}{14} \indexentry{BIJ\_DEF@{\ptt BIJ\_DEF}}{14} \indexentry{definition!of LINV@of {\ptt LINV}}{14} \indexentry{LINV\_DEF@{\ptt LINV\_DEF}}{14} \indexentry{definition!of RINV@of {\ptt RINV}}{14} \indexentry{RINV\_DEF@{\ptt RINV\_DEF}}{14} \indexentry{definition!of FINITE@of {\ptt FINITE}}{15} \indexentry{FINITE\_DEF@{\ptt FINITE\_DEF}}{15} \indexentry{FINITE\_EMPTY@{\ptt FINITE\_EMPTY}}{15} \indexentry{FINITE\_INSERT@{\ptt FINITE\_INSERT}}{15} \indexentry{definition!of INFINITE@of {\ptt INFINITE}}{15} \indexentry{INFINITE\_DEF@{\ptt INFINITE\_DEF}}{15} \indexentry{IMAGE\_11\_INFINITE@{\ptt IMAGE\_11\_INFINITE}}{15} \indexentry{FINITE\_CONV@{\ptt FINITE\_CONV}|(}{15} \indexentry{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|(}{15} \indexentry{FINITE\_CONV@{\ptt FINITE\_CONV}|)}{15} \indexentry{conversions!FINITE\_CONV@{\ptt FINITE\_CONV}|)}{15} \indexentry{definition!of CARD@of {\ptt CARD}}{16} \indexentry{CARD\_DEF@{\ptt CARD\_DEF}}{16} \indexentry{CARD\_SING@{\ptt CARD\_SING}}{16} \indexentry{FINITE\_ISO\_NUM@{\ptt FINITE\_ISO\_NUM}}{16} \indexentry{load\_finite\_sets@{\ptt load\_finite\_sets}|(}{18} \indexentry{load\_finite\_sets@{\ptt load\_finite\_sets}|)}{18} \indexentry{DELETE\_CONV@{\ptt DELETE\_CONV}}{19} \indexentry{IMAGE\_CONV@{\ptt IMAGE\_CONV}}{20} \indexentry{INSERT\_CONV@{\ptt INSERT\_CONV}}{22} \indexentry{IN\_CONV@{\ptt IN\_CONV}}{24} \indexentry{SET\_INDUCT\_TAC@{\ptt SET\_INDUCT\_TAC}}{25} \indexentry{UNION\_CONV@{\ptt UNION\_CONV}}{26} \indexentry{FINITE\_SET\_DEF@{\ptt FINITE\_SET\_DEF}}{29} \indexentry{IS\_SET\_REP@{\ptt IS\_SET\_REP}}{29} \indexentry{set\_TY\_DEF@{\ptt set\_TY\_DEF}}{29} \indexentry{ABSORPTION@{\ptt ABSORPTION}}{29} \indexentry{COMPONENT@{\ptt COMPONENT}}{30} \indexentry{DECOMPOSITION@{\ptt DECOMPOSITION}}{30} \indexentry{EXTENSION@{\ptt EXTENSION}}{30} \indexentry{INSERT\_COMM@{\ptt INSERT\_COMM}}{30} \indexentry{INSERT\_INSERT@{\ptt INSERT\_INSERT}}{30} \indexentry{IN\_INSERT@{\ptt IN\_INSERT}}{30} \indexentry{MEMBER\_NOT\_EMPTY@{\ptt MEMBER\_NOT\_EMPTY}}{30} \indexentry{NOT\_EMPTY\_INSERT@{\ptt NOT\_EMPTY\_INSERT}}{30} \indexentry{NOT\_EQUAL\_SETS@{\ptt NOT\_EQUAL\_SETS}}{30} \indexentry{NOT\_INSERT\_EMPTY@{\ptt NOT\_INSERT\_EMPTY}}{30} \indexentry{NOT\_IN\_EMPTY@{\ptt NOT\_IN\_EMPTY}}{30} \indexentry{NUM\_SET\_WOP@{\ptt NUM\_SET\_WOP}}{30} \indexentry{SET\_CASES@{\ptt SET\_CASES}}{30} \indexentry{SET\_INDUCT@{\ptt SET\_INDUCT}}{30} \indexentry{SET\_MINIMUM@{\ptt SET\_MINIMUM}}{30} \indexentry{EMPTY\_SUBSET@{\ptt EMPTY\_SUBSET}}{31} \indexentry{INSERT\_SUBSET@{\ptt INSERT\_SUBSET}}{31} \indexentry{NOT\_PSUBSET\_EMPTY@{\ptt NOT\_PSUBSET\_EMPTY}}{31} \indexentry{PSUBSET\_DEF@{\ptt PSUBSET\_DEF}}{31} \indexentry{PSUBSET\_INSERT\_SUBSET@{\ptt PSUBSET\_INSERT\_SUBSET}}{31} \indexentry{PSUBSET\_IRREFL@{\ptt PSUBSET\_IRREFL}}{31} \indexentry{PSUBSET\_MEMBER@{\ptt PSUBSET\_MEMBER}}{31} \indexentry{PSUBSET\_TRANS@{\ptt PSUBSET\_TRANS}}{31} \indexentry{SUBSET\_ANTISYM@{\ptt SUBSET\_ANTISYM}}{31} \indexentry{SUBSET\_DEF@{\ptt SUBSET\_DEF}}{31} \indexentry{SUBSET\_EMPTY@{\ptt SUBSET\_EMPTY}}{31} \indexentry{SUBSET\_INSERT@{\ptt SUBSET\_INSERT}}{31} \indexentry{SUBSET\_REFL@{\ptt SUBSET\_REFL}}{31} \indexentry{SUBSET\_TRANS@{\ptt SUBSET\_TRANS}}{31} \indexentry{DELETE\_INTER@{\ptt DELETE\_INTER}}{32} \indexentry{EMPTY\_UNION@{\ptt EMPTY\_UNION}}{32} \indexentry{INSERT\_INTER@{\ptt INSERT\_INTER}}{32} \indexentry{INSERT\_UNION@{\ptt INSERT\_UNION}}{32} \indexentry{INSERT\_UNION\_EQ@{\ptt INSERT\_UNION\_EQ}}{32} \indexentry{INTER\_ASSOC@{\ptt INTER\_ASSOC}}{32} \indexentry{INTER\_COMM@{\ptt INTER\_COMM}}{32} \indexentry{INTER\_EMPTY@{\ptt INTER\_EMPTY}}{32} \indexentry{INTER\_IDEMPOT@{\ptt INTER\_IDEMPOT}}{32} \indexentry{INTER\_OVER\_UNION@{\ptt INTER\_OVER\_UNION}}{32} \indexentry{INTER\_SUBSET@{\ptt INTER\_SUBSET}}{32} \indexentry{IN\_INTER@{\ptt IN\_INTER}}{32} \indexentry{IN\_UNION@{\ptt IN\_UNION}}{32} \indexentry{SUBSET\_INTER\_ABSORPTION@{\ptt SUBSET\_INTER\_ABSORPTION}}{32} \indexentry{SUBSET\_UNION@{\ptt SUBSET\_UNION}}{33} \indexentry{SUBSET\_UNION\_ABSORPTION@{\ptt SUBSET\_UNION\_ABSORPTION}}{33} \indexentry{UNION\_ASSOC@{\ptt UNION\_ASSOC}}{33} \indexentry{UNION\_COMM@{\ptt UNION\_COMM}}{33} \indexentry{UNION\_EMPTY@{\ptt UNION\_EMPTY}}{33} \indexentry{UNION\_IDEMPOT@{\ptt UNION\_IDEMPOT}}{33} \indexentry{UNION\_OVER\_INTER@{\ptt UNION\_OVER\_INTER}}{33} \indexentry{DIFF\_DIFF@{\ptt DIFF\_DIFF}}{33} \indexentry{DIFF\_EMPTY@{\ptt DIFF\_EMPTY}}{33} \indexentry{DIFF\_EQ\_EMPTY@{\ptt DIFF\_EQ\_EMPTY}}{33} \indexentry{EMPTY\_DIFF@{\ptt EMPTY\_DIFF}}{33} \indexentry{IN\_DIFF@{\ptt IN\_DIFF}}{33} \indexentry{DELETE\_COMM@{\ptt DELETE\_COMM}}{33} \indexentry{DELETE\_DEF@{\ptt DELETE\_DEF}}{34} \indexentry{DELETE\_DELETE@{\ptt DELETE\_DELETE}}{34} \indexentry{DELETE\_INSERT@{\ptt DELETE\_INSERT}}{34} \indexentry{DELETE\_NON\_ELEMENT@{\ptt DELETE\_NON\_ELEMENT}}{34} \indexentry{DELETE\_SUBSET@{\ptt DELETE\_SUBSET}}{34} \indexentry{DIFF\_INSERT@{\ptt DIFF\_INSERT}}{34} \indexentry{EMPTY\_DELETE@{\ptt EMPTY\_DELETE}}{34} \indexentry{INSERT\_DELETE@{\ptt INSERT\_DELETE}}{34} \indexentry{IN\_DELETE@{\ptt IN\_DELETE}}{34} \indexentry{IN\_DELETE\_EQ@{\ptt IN\_DELETE\_EQ}}{34} \indexentry{SUBSET\_DELETE@{\ptt SUBSET\_DELETE}}{34} \indexentry{SUBSET\_INSERT\_DELETE@{\ptt SUBSET\_INSERT\_DELETE}}{34} \indexentry{DISJOINT\_DEF@{\ptt DISJOINT\_DEF}}{34} \indexentry{DISJOINT\_DELETE\_SYM@{\ptt DISJOINT\_DELETE\_SYM}}{35} \indexentry{DISJOINT\_EMPTY@{\ptt DISJOINT\_EMPTY}}{35} \indexentry{DISJOINT\_EMPTY\_REFL@{\ptt DISJOINT\_EMPTY\_REFL}}{35} \indexentry{DISJOINT\_INSERT@{\ptt DISJOINT\_INSERT}}{35} \indexentry{DISJOINT\_SYM@{\ptt DISJOINT\_SYM}}{35} \indexentry{DISJOINT\_UNION@{\ptt DISJOINT\_UNION}}{35} \indexentry{IN\_DISJOINT@{\ptt IN\_DISJOINT}}{35} \indexentry{CHOICE\_DEF@{\ptt CHOICE\_DEF}}{35} \indexentry{CHOICE\_INSERT\_REST@{\ptt CHOICE\_INSERT\_REST}}{35} \indexentry{CHOICE\_NOT\_IN\_REST@{\ptt CHOICE\_NOT\_IN\_REST}}{35} \indexentry{CHOICE\_SING@{\ptt CHOICE\_SING}}{35} \indexentry{REST\_DEF@{\ptt REST\_DEF}}{35} \indexentry{REST\_PSUBSET@{\ptt REST\_PSUBSET}}{35} \indexentry{REST\_SING@{\ptt REST\_SING}}{35} \indexentry{REST\_SUBSET@{\ptt REST\_SUBSET}}{36} \indexentry{SING\_IFF\_EMPTY\_REST@{\ptt SING\_IFF\_EMPTY\_REST}}{36} \indexentry{IMAGE\_COMPOSE@{\ptt IMAGE\_COMPOSE}}{36} \indexentry{IMAGE\_DELETE@{\ptt IMAGE\_DELETE}}{36} \indexentry{IMAGE\_EMPTY@{\ptt IMAGE\_EMPTY}}{36} \indexentry{IMAGE\_EQ\_EMPTY@{\ptt IMAGE\_EQ\_EMPTY}}{36} \indexentry{IMAGE\_ID@{\ptt IMAGE\_ID}}{36} \indexentry{IMAGE\_IN@{\ptt IMAGE\_IN}}{36} \indexentry{IMAGE\_INSERT@{\ptt IMAGE\_INSERT}}{36} \indexentry{IMAGE\_INTER@{\ptt IMAGE\_INTER}}{36} \indexentry{IMAGE\_SUBSET@{\ptt IMAGE\_SUBSET}}{36} \indexentry{IMAGE\_UNION@{\ptt IMAGE\_UNION}}{36} \indexentry{IN\_IMAGE@{\ptt IN\_IMAGE}}{36} \indexentry{BIJ\_COMPOSE@{\ptt BIJ\_COMPOSE}}{37} \indexentry{BIJ\_DEF@{\ptt BIJ\_DEF}}{37} \indexentry{BIJ\_EMPTY@{\ptt BIJ\_EMPTY}}{37} \indexentry{BIJ\_ID@{\ptt BIJ\_ID}}{37} \indexentry{IMAGE\_SURJ@{\ptt IMAGE\_SURJ}}{37} \indexentry{INJ\_COMPOSE@{\ptt INJ\_COMPOSE}}{37} \indexentry{INJ\_DEF@{\ptt INJ\_DEF}}{37} \indexentry{INJ\_EMPTY@{\ptt INJ\_EMPTY}}{37} \indexentry{INJ\_ID@{\ptt INJ\_ID}}{37} \indexentry{LINV\_DEF@{\ptt LINV\_DEF}}{37} \indexentry{RINV\_DEF@{\ptt RINV\_DEF}}{37} \indexentry{SURJ\_COMPOSE@{\ptt SURJ\_COMPOSE}}{37} \indexentry{SURJ\_DEF@{\ptt SURJ\_DEF}}{37} \indexentry{SURJ\_EMPTY@{\ptt SURJ\_EMPTY}}{38} \indexentry{SURJ\_ID@{\ptt SURJ\_ID}}{38} \indexentry{DELETE\_EQ\_SING@{\ptt DELETE\_EQ\_SING}}{38} \indexentry{DISJOINT\_SING\_EMPTY@{\ptt DISJOINT\_SING\_EMPTY}}{38} \indexentry{EQUAL\_SING@{\ptt EQUAL\_SING}}{38} \indexentry{INSERT\_SING\_UNION@{\ptt INSERT\_SING\_UNION}}{38} \indexentry{IN\_SING@{\ptt IN\_SING}}{38} \indexentry{NOT\_EMPTY\_SING@{\ptt NOT\_EMPTY\_SING}}{38} \indexentry{NOT\_SING\_EMPTY@{\ptt NOT\_SING\_EMPTY}}{38} \indexentry{SING@{\ptt SING}}{38} \indexentry{SING\_DEF@{\ptt SING\_DEF}}{38} \indexentry{SING\_DELETE@{\ptt SING\_DELETE}}{38} \indexentry{CARD\_DEF@{\ptt CARD\_DEF}}{38} \indexentry{CARD\_DELETE@{\ptt CARD\_DELETE}}{39} \indexentry{CARD\_DIFF@{\ptt CARD\_DIFF}}{39} \indexentry{CARD\_EMPTY@{\ptt CARD\_EMPTY}}{39} \indexentry{CARD\_EQ\_0@{\ptt CARD\_EQ\_0}}{39} \indexentry{CARD\_INSERT@{\ptt CARD\_INSERT}}{39} \indexentry{CARD\_INTER\_LESS\_EQ@{\ptt CARD\_INTER\_LESS\_EQ}}{39} \indexentry{CARD\_PSUBSET@{\ptt CARD\_PSUBSET}}{39} \indexentry{CARD\_SING@{\ptt CARD\_SING}}{39} \indexentry{CARD\_SUBSET@{\ptt CARD\_SUBSET}}{39} \indexentry{CARD\_UNION@{\ptt CARD\_UNION}}{39} \indexentry{LESS\_CARD\_DIFF@{\ptt LESS\_CARD\_DIFF}}{39} \indexentry{SING\_IFF\_CARD1@{\ptt SING\_IFF\_CARD1}}{39} hol88-2.02.19940316/Library/finite_sets/Manual/index.tex0000640000212700021270000001573505535604227020735 0ustar cammcamm\begin{theindex} \item {\ptt ABSORPTION}, 29 \item axiom of extension, 3 \item axioms for {\ptt (*)set}, 2--3 \indexspace \item {\ptt BIJ\_COMPOSE}, 37 \item {\ptt BIJ\_DEF}, 14, 37 \item {\ptt BIJ\_EMPTY}, 37 \item {\ptt BIJ\_ID}, 37 \indexspace \item {\ptt CARD\_DEF}, 16, 38 \item {\ptt CARD\_DELETE}, 39 \item {\ptt CARD\_DIFF}, 39 \item {\ptt CARD\_EMPTY}, 39 \item {\ptt CARD\_EQ\_0}, 39 \item {\ptt CARD\_INSERT}, 39 \item {\ptt CARD\_INTER\_LESS\_EQ}, 39 \item {\ptt CARD\_PSUBSET}, 39 \item {\ptt CARD\_SING}, 16, 39 \item {\ptt CARD\_SUBSET}, 39 \item {\ptt CARD\_UNION}, 39 \item {\ptt CHOICE\_DEF}, 12, 35 \item {\ptt CHOICE\_INSERT\_REST}, 35 \item {\ptt CHOICE\_NOT\_IN\_REST}, 35 \item {\ptt CHOICE\_SING}, 35 \item {\ptt COMPONENT}, 30 \item conversions \subitem {\ptt DELETE\_CONV}, 11 \subitem {\ptt FINITE\_CONV}, 15 \subitem {\ptt IMAGE\_CONV}, 13 \subitem {\ptt IN\_CONV}, 7--8 \subitem {\ptt INSERT\_CONV}, 10 \subitem {\ptt UNION\_CONV}, 9--10 \indexspace \item {\ptt DECOMPOSITION}, 30 \item {\ptt define\_finite\_set\_syntax}, 4 \item definition \subitem of {\ptt (*)set}, 1--2 \subitem of {\ptt BIJ}, 14 \subitem of {\ptt CARD}, 16 \subitem of {\ptt CHOICE}, 12 \subitem of {\ptt DELETE}, 7 \subitem of {\ptt DIFF}, 6 \subitem of {\ptt DISJOINT}, 6 \subitem of {\ptt EMPTY}, 2 \subitem of {\ptt FINITE}, 15 \subitem of {\ptt IMAGE}, 12 \subitem of {\ptt IN}, 2 \subitem of {\ptt INFINITE}, 15 \subitem of {\ptt INJ}, 14 \subitem of {\ptt INSERT}, 2, 7 \subitem of {\ptt INTER}, 6 \subitem of {\ptt IS\_SET\_REP}, 2 \subitem of {\ptt LINV}, 14 \subitem of {\ptt PSUBSET}, 5 \subitem of {\ptt REST}, 12 \subitem of {\ptt RINV}, 14 \subitem of {\ptt SING}, 11 \subitem of {\ptt SUBSET}, 5 \subitem of {\ptt SURJ}, 14 \subitem of {\ptt UNION}, 6 \item {\ptt DELETE\_COMM}, 33 \item {\ptt DELETE\_CONV}, 11, 19 \item {\ptt DELETE\_DEF}, 7, 34 \item {\ptt DELETE\_DELETE}, 34 \item {\ptt DELETE\_EQ\_SING}, 38 \item {\ptt DELETE\_INSERT}, 34 \item {\ptt DELETE\_INTER}, 32 \item {\ptt DELETE\_NON\_ELEMENT}, 34 \item {\ptt DELETE\_SUBSET}, 34 \item {\ptt DIFF\_DEF}, 6 \item {\ptt DIFF\_DIFF}, 33 \item {\ptt DIFF\_EMPTY}, 33 \item {\ptt DIFF\_EQ\_EMPTY}, 33 \item {\ptt DIFF\_INSERT}, 34 \item {\ptt DISJOINT\_DEF}, 6, 34 \item {\ptt DISJOINT\_DELETE\_SYM}, 35 \item {\ptt DISJOINT\_EMPTY}, 35 \item {\ptt DISJOINT\_EMPTY\_REFL}, 35 \item {\ptt DISJOINT\_INSERT}, 35 \item {\ptt DISJOINT\_SING\_EMPTY}, 38 \item {\ptt DISJOINT\_SYM}, 35 \item {\ptt DISJOINT\_UNION}, 35 \indexspace \item {\ptt EMPTY\_DELETE}, 34 \item {\ptt EMPTY\_DIFF}, 33 \item {\ptt EMPTY\_SUBSET}, 5, 31 \item {\ptt EMPTY\_UNION}, 32 \item {\ptt EQUAL\_SING}, 38 \item {\ptt EXTENSION}, 3, 30 \indexspace \item {\ptt FINITE\_CONV}, 15 \item {\ptt FINITE\_DEF}, 15 \item {\ptt FINITE\_EMPTY}, 15 \item {\ptt FINITE\_INSERT}, 15 \item {\ptt FINITE\_ISO\_NUM}, 16 \item {\ptt FINITE\_SET\_DEF}, 2, 29 \indexspace \item {\ptt IMAGE\_11\_INFINITE}, 15 \item {\ptt IMAGE\_COMPOSE}, 36 \item {\ptt IMAGE\_CONV}, 13, 20 \item {\ptt IMAGE\_DEF}, 12 \item {\ptt IMAGE\_DELETE}, 36 \item {\ptt IMAGE\_EMPTY}, 36 \item {\ptt IMAGE\_EQ\_EMPTY}, 36 \item {\ptt IMAGE\_ID}, 36 \item {\ptt IMAGE\_IN}, 36 \item {\ptt IMAGE\_INSERT}, 36 \item {\ptt IMAGE\_INTER}, 36 \item {\ptt IMAGE\_SUBSET}, 36 \item {\ptt IMAGE\_SURJ}, 37 \item {\ptt IMAGE\_UNION}, 36 \item {\ptt IN\_CONV}, 7--8, 24 \item {\ptt IN\_DELETE}, 7, 34 \item {\ptt IN\_DELETE\_EQ}, 34 \item {\ptt IN\_DIFF}, 6, 33 \item {\ptt IN\_DISJOINT}, 35 \item {\ptt IN\_IMAGE}, 12, 36 \item {\ptt IN\_INSERT}, 3, 7, 30 \item {\ptt IN\_INTER}, 6, 32 \item {\ptt IN\_SING}, 38 \item {\ptt IN\_UNION}, 6, 32 \item induction, 3--4 \item {\ptt INFINITE\_DEF}, 15 \item {\ptt INJ\_COMPOSE}, 37 \item {\ptt INJ\_DEF}, 14, 37 \item {\ptt INJ\_EMPTY}, 37 \item {\ptt INJ\_ID}, 37 \item {\ptt INSERT\_COMM}, 3, 30 \item {\ptt INSERT\_CONV}, 10, 22 \item {\ptt INSERT\_DEF}, 7 \item {\ptt INSERT\_DELETE}, 34 \item {\ptt INSERT\_INSERT}, 3, 30 \item {\ptt INSERT\_INTER}, 32 \item {\ptt INSERT\_SING\_UNION}, 38 \item {\ptt INSERT\_SUBSET}, 31 \item {\ptt INSERT\_UNION}, 32 \item {\ptt INSERT\_UNION\_EQ}, 32 \item {\ptt INTER\_ASSOC}, 32 \item {\ptt INTER\_COMM}, 32 \item {\ptt INTER\_DEF}, 6 \item {\ptt INTER\_EMPTY}, 32 \item {\ptt INTER\_IDEMPOT}, 32 \item {\ptt INTER\_OVER\_UNION}, 32 \item {\ptt INTER\_SUBSET}, 32 \item {\ptt IS\_SET\_REP}, 2, 29 \indexspace \item {\ptt LESS\_CARD\_DIFF}, 39 \item {\ptt LINV\_DEF}, 14, 37 \item {\ptt load\_finite\_sets}, 18 \indexspace \item {\ptt MEMBER\_NOT\_EMPTY}, 30 \indexspace \item naming conventions \subitem for definitions, 2 \subitem for membership conditions, 6 \subitem for theorems about singletons, 11 \subitem for theorems generally, 6 \item {\ptt NOT\_EMPTY\_INSERT}, 30 \item {\ptt NOT\_EMPTY\_SING}, 38 \item {\ptt NOT\_EQUAL\_SETS}, 30 \item {\ptt NOT\_IN\_EMPTY}, 3, 30 \item {\ptt NOT\_INSERT\_EMPTY}, 30 \item {\ptt NOT\_PSUBSET\_EMPTY}, 5, 31 \item {\ptt NOT\_SING\_EMPTY}, 38 \item {\ptt NOT\_UNIV\_PSUBSET}, 5 \item {\ptt NUM\_SET\_WOP}, 30 \indexspace \item {\ptt print\_set} (flag), 5 \item {\ptt PSUBSET\_DEF}, 5, 31 \item {\ptt PSUBSET\_INSERT\_SUBSET}, 31 \item {\ptt PSUBSET\_IRREFL}, 31 \item {\ptt PSUBSET\_MEMBER}, 31 \item {\ptt PSUBSET\_TRANS}, 31 \indexspace \item {\ptt REST\_DEF}, 12, 35 \item {\ptt REST\_PSUBSET}, 35 \item {\ptt REST\_SING}, 35 \item {\ptt REST\_SUBSET}, 36 \item {\ptt RINV\_DEF}, 14, 37 \indexspace \item {\ptt SET\_CASES}, 30 \item {\ptt SET\_INDUCT}, 3, 30 \item {\ptt SET\_INDUCT\_TAC}, 3--4, 25 \item {\ptt SET\_MINIMUM}, 30 \item {\ptt set\_TY\_DEF}, 2, 29 \item {\ptt SING}, 11, 38 \item {\ptt SING\_DEF}, 11, 38 \item {\ptt SING\_DELETE}, 38 \item {\ptt SING\_IFF\_CARD1}, 39 \item {\ptt SING\_IFF\_EMPTY\_REST}, 36 \item {\ptt SUBSET\_ANTISYM}, 5, 31 \item {\ptt SUBSET\_DEF}, 5, 31 \item {\ptt SUBSET\_DELETE}, 34 \item {\ptt SUBSET\_EMPTY}, 31 \item {\ptt SUBSET\_INSERT}, 31 \item {\ptt SUBSET\_INSERT\_DELETE}, 34 \item {\ptt SUBSET\_INTER\_ABSORPTION}, 32 \item {\ptt SUBSET\_REFL}, 5, 31 \item {\ptt SUBSET\_TRANS}, 5, 31 \item {\ptt SUBSET\_UNION}, 33 \item {\ptt SUBSET\_UNION\_ABSORPTION}, 33 \item {\ptt SUBSET\_UNIV}, 5 \item {\ptt SURJ\_COMPOSE}, 37 \item {\ptt SURJ\_DEF}, 14, 37 \item {\ptt SURJ\_EMPTY}, 38 \item {\ptt SURJ\_ID}, 38 \indexspace \item tactics \subitem {\ptt SET\_INDUCT\_TAC}, 3--4 \indexspace \item {\ptt UNION\_ASSOC}, 33 \item {\ptt UNION\_COMM}, 33 \item {\ptt UNION\_CONV}, 9--10, 26 \item {\ptt UNION\_DEF}, 6 \item {\ptt UNION\_EMPTY}, 33 \item {\ptt UNION\_IDEMPOT}, 33 \item {\ptt UNION\_OVER\_INTER}, 33 \end{theindex} hol88-2.02.19940316/Library/finite_sets/Manual/finite_sets.aux0000640000212700021270000000021205535604274022121 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{theorems.aux} \@input{references.aux} \@input{index.aux} hol88-2.02.19940316/Library/finite_sets/Manual/title.aux0000640000212700021270000000077305535604233020735 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/finite_sets/Manual/references.tex0000640000212700021270000000134505156667175021751 0ustar cammcamm\begin{thebibliography}{99} \bibitem{manna} % OK Z.\ Manna and R.\ Waldinger, {\it The Logical Basis for Computer Programming: Volume 1, Deductive Reasoning}, Addison-Wesley, 1985. \bibitem{melham} % OK T.\ F.\ Melham, {\it The HOL sets library}, University of Cambridge Computer Laboratory, October 1991. \bibitem{ind-defs} % OK T.\ Melham, `A Package for Inductive Relation Definitions in HOL', to appear in the Proceedings of the 1991 International Tutorial and Workshop on the HOL Theorem Proving System, 27--30 August 1991, Davis California (IEEE Computer Society Press). \bibitem{description} % OK University of Cambridge Computer Laboratory, {\it The HOL System: DESCRIPTION}, revised edition, July 1991. \end{thebibliography} hol88-2.02.19940316/Library/finite_sets/Manual/finite_sets.dvi0000640000212700021270000034111005535604274022113 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1008‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘D§³óHò"VáG cmbx10ëHThe– ‰‹HOL“ nite‘¨™‰•iŽ‘ t(sets“LibraryŽŸI­Û’ÃÔÊó7ò"Vff cmbx10âT.–…F.“MelhamŽ Æáé’Ë~ÊóIò"V½p cmbx10ëIDRAFTŽ ½áé‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’ÌfF‘þàebruary‘€1992ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’˜Nþž£hó+X«Q cmr12ÖcŽŽŽ’”ëmó-!",š cmsy10Ø ŽŽŽŽ’¤ÖÖT.–ê¨F.“Melham“1992ŽŽŽŒ‹ ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸdÅëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFºÆÛ1Ž‘ŸôThe–€ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“Library’(›²1ŽŽ¤cI‘ŸôÖ1.1Ž‘,¦JThe–ê¨t¬rypSŽe“de nition‘­‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ß ý‹Ð!‘ü‘ßÖ3.8Ž‘˜5The–ê¨ÜCHOICE“Öand“ÜREST“Öfunctions‘†‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ35ŽŽ¤‘ü‘ß3.9Ž‘˜5Image–ê¨of“a“function“on“a“set‘=U‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ36ŽŽ¡‘ü‘ß3.10Ž‘˜5Mappings›ê¨bSŽet•¬rw“een˜sets‘ÁE‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ37ŽŽ¡‘ü‘ß3.11Ž‘˜5Singleton‘ê¨sets‘&H‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ38ŽŽ¡‘ü‘ß3.12Ž‘˜5Cardinalit¬ry–ê¨of“sets‘ \‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ38ŽŽ¤¿ø‘êñëÛReferences’z’e41ŽŽ¡‘êñëIndex’˜n|42ŽŽŽŽŒ‹!¼ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸÙeëHThe– ‰‹ nite‘¨™‰•iŽ‘ t(sets“LibraryŽŸÖx‰Ç>|Ÿ:çÖThe‘¬yó(ßêúÓfinite_setsŽ‘GºBÖlibrary–>úis“based“on“a“pšSŽolymorphic“t¬ryp˜e“of“sets“Ó(*)setŽ‘&¼öÖ,‘Tv‘ÿXäalues“of“whic¬rhŽ¡unordered–¸^ nite“collections“of“v‘ÿXäalues“of“the“base“tš¬rypSŽe“Ó*Ž‘ xÖ.‘¢The“represen˜ting“t˜ypSŽe“for“theŽ¡de nition–øFof“Ó(*)setŽ‘(nˆÖis“the“tš¬rypSŽe“of“predicates“Ó*->boolÖ;‘Ithe“v‘ÿXäalues“of“t˜ypšSŽe“Ó(*)setŽ‘(nˆÖcorresp˜ondŽ¡to–ê¨precisely“those“predicates“that“are“true“of“a“ nite“n•¬rum“bšSŽer–ê¨of“v‘ÿXäalues“of“t¬ryp˜e“Ó*Ž‘ ªRÖ.Ž¦‘ aThe–YGset“of“all“sucš¬rh“predicates“is“de ned“inductiv˜ely“in“terms“of“represen˜tations“of“theŽ¡emptš¬ry–åYset“and“the“opSŽeration“of“inserting“an“elemen˜t“in˜to“an“already“existing“set.‘(òTheŽ¡emptš¬ry–Wset“is“represen˜ted“b˜y“the“constan˜t“false“predicate“Ó\x.FÖ.“The“insertion“opSŽeration“isŽ¡represen•¬rted›„!b“y˜the˜function˜that˜maps˜a˜v‘ÿXäalue˜Óx:*Ž‘G@Öand˜a˜predicate˜ÓsŽ‘ÇìÖrepresen“ting˜a˜setŽ¡to–…Õthe“predicate“Ó\e.–¿ª(e“=“x)“\/“s“eÖ,‘™ÿwhic•¬rh›…Õrepresen“ts˜of˜the˜set˜obtained˜b“y˜adding˜Óx˜ÖtoŽ¡the–´àset“represenš¬rted“b˜y“ÓsÖ.‘&óA‘´Òpredicate“Ós:*->bool“Öthen“represen˜ts“a“ nite“set“i “it“is“in“theŽ¡inš¬rtersection–Bof“all“classes“of“predicates“that“con˜tain“the“represen˜tation“of“empt˜y“and“areŽŽŸ$ý’óŸÛ1ŽŽŒ‹( ÌU ýFÓŸú™š‘êñëÛ2’ð4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖclosed–Üçunder“the“represenš¬rtation“of“the“insertion“opSŽeration.‘4JHence“Ós:*->bool“Örepresen˜ts“aŽ¤‘êñë nite–&set“if“and“only“if“it“can“bšSŽe“obtained“b¬ry“applying“a“ nite“sequence“of“insert“op˜erationsŽ¡‘êñëto–ê¨the“empt¬ry“set.Ž¡‘öSzThis–ãŸc¬rharacterization“of“the“ nite“sets“is“expressed“formally“in“the“Ófinite_setsŽ‘GŒÖtheoryŽ¡‘êñëbš¬ry–ê¨the“constan˜t“ÓIS_SET_REPŽ‘=gLÖ,“whic˜h“is“de ned“the“follo˜wing“constan˜t“spSŽeci cation:ŽŸ<<Ÿ!\Ÿ½õQ‘0éÓIS_SET_REPŽ¤ ‘0é|-–¿ªIS_SET_REP(\x.“F)“/\Ž¡‘oç(!s.–¿ªIS_SET_REP“s“==>“(!x.“IS_SET_REP(\y.“(y“=“x)“\/“s“y)))“/\Ž¡‘oç(!P.Ž¡‘ï;P(\x.–¿ªF)“/\“(!t.“P“t“==>“(!x.“P(\y.“(y“=“x)“\/“t“y)))“==>Ž¡‘ï;(!s.–¿ªIS_SET_REP“s“==>“P“s))ŽŽŽŽŽŽŽŸ<­ç‘êñëÖThe–}7spSŽeci cation“has“three“conjuncts,‘“whic¬rh“constitute“an“ó.›»ˆ@ cmti12Ùinductive‘Îœde nition‘bçÖ(see“[3Ž‘ßü])“ofŽ¡‘êñëthe–ÃÕclass“of“all“ nite“set“represenš¬rtations.‘+ïThe“ rst“conjunct“states“that“the“constan˜t“falseŽ¡‘êñëpredicate–¤-Ó\x.F‘¤Öis“included“in“the“class“of“predicates“that“represen¬rt“ nite“sets.‘!bThe“secondŽ¡‘êñëstates–´ithat“the“class“of“predicates“that“represenš¬rt“ nite“sets“is“closed“under“the“elemen˜tŽ¡‘êñëinsertion–ylopSŽeration.‘!And“the“third“states“that“ÓIS_SET_REPŽ‘@o|Öis“true“of“precisely“the“smallestŽ¡‘êñësuc¬rh–ê¨class“of“predicates.Ž¡‘öSzUsing–©³this“de nition“of“the“class“of“ nite“sets,‘Ùvthe“t¬rypSŽe“Ó(*)setŽ‘+ÑbÖis“de ned“formally“inŽ¡‘êñëthe–ê¨library“bš¬ry“the“t˜ypSŽe“de nition:Ž¤ø7ŸŸý‘‘0éÓset_TY_DEF‘>þ|-–¿ª?rep:(*)set->(*->bool).“TYPE_DEFINITION“IS_SET_REP“repŽŽŽŽŽŽŽ¡‘êñëÖThis–Lède nitional“axiom“asserts“the“existence“of“a“bijection“ÓrepŽ‘ØÎÖbšSŽet•¬rw“een–Lèthe“t¬ryp˜e“Ó(*)setŽ¤‘êñëÖand–°^the“class“of“all“predicates“on“Ó*Ž‘ fÖthat“represen¬rt“ nite“sets.‘ŠThe“theorem“Óset_TY_DEFŽŽ¡‘êñëÖis–$named“according“to“the“general“con•¬rv“en“tion–$that“de nitions“in“the“Ófinite_setsŽ‘GD–ÖlibraryŽ¡‘êñëare–ê¨giv¬ren“names“ending“in“`Ó_DEFÖ'.ŽŸ(U‘êñëç1.2Ž‘5oAbstract–Ÿ¼c›ÿr°haracterization“of“the“t˜yp‘Oe“óJßê“(!e.“P(e“INSERT“s)))“==>“(!s.“P“s))ŽŽŽŽŽŽŽŽŽŒ‹5… ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €The–€set“induction“tactic’eõ3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖThe–ñã vš¬re“conjuncts“of“this“theorem“constitute“a“deriv˜ed“`axiomatization'“for“ nite“sets;Ž¤‘Çaonce–ÿËthis“theorem“has“bSŽeen“pro•¬rv“ed,‘it›ÿËpro“vides˜a˜complete˜basis˜for˜all˜further˜reasoningŽ¡‘ÇaabSŽout–×sets.‘þBIn“particular,‘;users“of“the“library“should“nevš¬rer“ha˜v˜e“to“appSŽeal“to“the“t˜ypSŽeŽ¡‘Çade nition–Uøfor“Ó(*)setÖ.‘zÐThe“library“theory“Ófinite_setsŽ‘Gè>Öitself“is“devš¬relopSŽed“en˜tirely“on“theŽ¡‘Çabasis–ê¨of“these“`axioms'“of“set“theory‘ÿV.Ž¡‘(ðThe–# rst“t•¬rw“o–#conjuncts“of“ÓFINITE_SET_DEFŽ‘V‰’ÖspšSŽecify“the“mem¬rb˜ership“relation“ÓINŽ‘šÖfor“empt¬ryŽ¡‘Çaand–nanon-emptš¬ry“sets.‘ Ä The“next“t˜w˜o“conjuncts“state“that“sets“do“not“con˜tain“m˜ultipleŽ¡‘Çainstances–F—of“the“same“elemenš¬rt“and“that“the“elemen˜ts“of“a“set“are“not“ordered.‘L¬The“ nalŽ¡‘Çaconjunct–Þxis“an“induction“theorem“for“ nite“sets.‘4ÐIt“states“that“if“a“propSŽert¬ry“is“true“of“theŽ¡‘Çaemptš¬ry–àÑset“and“is“preserv˜ed“b˜y“the“insertion“opSŽeration,‘âÉthen“it“holds“of“all“sets.‘5˜It“follo˜wsŽ¡‘Çafrom–°¯this“theorem“that“evš¬rery“ nite“set“is“either“empt˜y“or“can“bSŽe“built“up“from“the“empt˜yŽ¡‘Çaset–ê¨bš¬ry“a“ nite“n˜um˜bšSŽer“of“insertion“op˜erations.Ž¡‘(ðF‘ÿVor–™consistency“with“the“other“set“libraries,‘ Õthe“ rst“four“conjuncts“of“ÓFINITE_SET_DEFŽŽ¡‘ÇaÖare–Ï_stored“as“separate“theorems“in“the“Ófinite_setsŽ‘HÛ Ölibrary‘ÿV.‘çThey“are“giv¬ren“the“namesŽ¡‘Çasho•¬rwn‘ê¨bSŽelo“w.ŽŸ+𠟃ŸÖ‘‘*_ÓNOT_IN_EMPTY‘ T=–¿ª|-“!x.“~x“IN“{}Ž¤ ‘*_IN_INSERT‘¾R=–¿ª|-“!x“y“s.“x“IN“(y“INSERT“s)“=“(x“=“y)“\/“x“IN“sŽ¡‘*_INSERT_INSERT–¿ª=“|-“!x“s.“x“INSERT“(x“INSERT“s)“=“x“INSERT“sŽ¡‘*_INSERT_COMM‘>þ=–¿ª|-“!x“y“s.“x“INSERT“(y“INSERT“s)“=“y“INSERT“(x“INSERT“s)ŽŽŽŽŽŽŽŸ.E]‘ÇaÖThe– Winduction“propSŽertš¬ry“is“also“sa˜v˜ed“as“a“separate“theorem,‘TÃbut“in“a“sligh˜tly“strongerŽ¡‘Çaform–ê¨than“that“in“whic¬rh“it“appSŽears“as“part“of“ÓFINITE_SET_DEFŽ‘TeôÖ.‘8àThis“theorem“is:ŽŸ åŸKˆŸòi‘*_ÓSET_INDUCTŽŸ ‘*_|-–¿ª!P.“P“EMPTY“/\“(!s.“P“s“==>“(!e.“~e“IN“s“==>“P(e“INSERT“s)))“==>“!s.“P“sŽŽŽŽŽŽŽŸ ä‘ÇaÖThe–6„`step'“case“of“this“stronger“induction“theorem“requires“one“to“sho¬rw“only“that“theŽ¡‘ÇapropSŽert•¬ry‘ŸØÓPŽ‘ ÿZÖis›ŸØpreserv“ed˜b“y˜the˜opSŽeration˜of˜inserting˜an˜elemen“t˜not˜already˜in˜a˜set˜ÓsŽ‘ ÿZÖforŽ¡‘Çawhic¬rh‘ê¨ÓP‘¿ªsŽ‘NÖis–ê¨assumed“to“hold.Ž¡‘(ðThe‘›}Ófinite_setsŽ‘HsHÖlibrary–›}conš¬rtains“man˜y“pre-pro˜v˜ed“theorems“the“constan˜ts“abSŽout“ÓINŽ‘ÑÖ,Ž¡‘ÇaÓEMPTYŽ‘/…³Ö,–ê¨and“ÓINSERTŽ‘&h¤Ö.‘8àThese“include“the“fundamenš¬rtal“set“equalit˜y“theorem:Ž¤lŸ@UŸÿi‘*_ÓEXTENSION–¿ª=“|-“!s“t.“(s“=“t)“=“(!x.“x“IN“s“=“x“IN“t)ŽŽŽŽŽŽŽ¡‘ÇaEXTENSIONŽ‘I­ÉÖstates–)nthat“t•¬rw“o–)nsets“are“equal“exactly“when“they“ha•¬rv“e–)nthe“same“elemen•¬rts,‘Pwhic“hŽ¤‘ÇacorrespSŽonds–Ó¸to“what“is“usually“called“the“Ùaxiom– of“extension‘¹hÖfor–Ó¸sets.‘1;F‘ÿVor“a“complete“listŽ¡‘Çaof–ê¨the“other“built-in“theorems“abSŽout“ÓINŽ‘iüÖ,“ÓEMPTYŽ‘ ¨úÖ,“and“ÓINSERTŽ‘&h¤Ö,“see“c¬rhapter“3.ŽŸ'Õ¶‘Çaç1.3Ž‘@ åThe–Ÿ¼set“induction“tacticŽŸâ#‘ÇaÖThe–ÑÃlibrary“conš¬rtains“an“induction“tactic“called“ÓSET_INDUCT_TACŽ‘VÒÖwhic˜h“made“a˜v‘ÿXäailable“whenŽ¡‘Çathe–`ölibrary“is“loaded.‘›ÊWhen“applied“to“a“goal“of“the“form“Ó"ó#  b> ó3 cmmi10ÎsÓ.‘¿ªÎP‘…VÓ"Ö,‘~‰this“tactic“reduces“itŽŽŽŒ‹B ÌU ýFÓŸú™š‘êñëÛ4’ð4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖto–:3proš¬rving“that“the“propSŽert˜y“of“sets“expressed“b˜y“Ó\ÎsÓ.ÎP‘¿‰Öholds“of“the“empt˜y“set“and“isŽ¤‘êñëpreserv•¬red›žçb“y˜the˜insertion˜of˜an˜elemen“t˜in“to˜an˜arbitrary˜ nite˜set.‘ Since˜ev“ery˜ nite˜setŽ¡‘êñëcan–èmbSŽe“built“up“from“the“emptš¬ry“set“b˜y“repSŽeated“insertion“of“v‘ÿXäalues,‘èßthese“subgoals“implyŽ¡‘êñëthat–ê¨this“propSŽert¬ry“holds“of“all“ nite“sets.ŽŸ¸0‘öSzThe–®ªfolloš¬rwing“session“illustrates“the“use“of“the“tactic“ÓSET_INDUCT_TACŽ‘YØ Öfor“pro˜ving“theŽ¡‘êñëfundamen¬rtal–ï=theorem“ÓEXTENSIONŽ‘8¬7Ö.‘FžW‘ÿVe“ rst“set“up“a“goal“for“the“`hard'“direction“of“theŽ¡‘êñëequiv‘ÿXäalence–ê¨stated“b¬ry“this“theorem:ŽŸ4jƒ‘êñëŸâµ‰ffÇ IŸ1€ùÌÍŸYœ„5Ú•ffŸÔ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±Ÿýóp®0J cmsl10È1ŽŽŽŽŸÿ@T‘ÌÍÓ#g–¿ª"!s“t.“(!x:*.“x“IN“s“=“x“IN“t)“==>“(s“=“t)";;ŽŸ ‘ÌÍ"!s–¿ªt.“(!x.“x“IN“s“=“x“IN“t)“==>“(s“=“t)"ŽŸ‘ÌÍ()–¿ª:“voidŽŽ’Æq°„5Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ3²R‘êñëÖExpanding–ê¨with“ÓSET_INDUCT_TACŽ‘XPœÖyields:ŽŸ[jƒ‘êñ럻µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#expand‘¿ªSET_INDUCT_TAC;;Ž¤ ‘ÌÍOK..Ž¡‘ÌÍ2‘¿ªsubgoalsŽ¡‘ÌÍ"!t.–¿ª(!x.“x“IN“(e“INSERT“s)“=“x“IN“t)“==>“(e“INSERT“s“=“t)"Ž¡‘Ëu[–¿ª"!t.“(!x.“x“IN“s“=“x“IN“t)“==>“(s“=“t)"“]Ž¡‘Ëu[–¿ª"~e“IN“s"“]Ž¤‘ÌÍ"!t.–¿ª(!x.“x“IN“{}“=“x“IN“t)“==>“({}“=“t)"Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸZ²R‘êñëÖThe–txresulting“subgoals“are“reasonably“easy“to“pro•¬rv“e,‘–ìgiv“en›txsev“eral˜other˜basic˜theoremsŽ¡‘êñëab•SŽout›Bmem¬rb“ership,‘d!the˜empt¬ry˜set˜and˜insertion.‘Ò(The˜ÍHOL˜Öpro“of˜closely˜follo¬rws˜the˜pro“ofŽ¡‘êñëin–VH[1Ž‘ßü].)‘{ÀNote“that“ÓSET_INDUCT_TACŽ‘Y'ÜÖis“based“on“the“stronger“induction“theorem“discussedŽ¡‘êñëabšSŽo•¬rv“e,‘éàso–é®it“ma¬ry“b˜e“assumed“in“the“step“case“that“the“v‘ÿXäalue“ÓeŽ‘ “Öb˜eing“inserted“in¬rto“the“setŽ¡‘êñëÓsŽ‘ôœ=Öis–ê¨not“already“an“elemen¬rt“of“ÓsŽ‘ ªRÖ.ŽŸ':|‘êñëâ1.3.1Ž‘‹lPšŠ=arser–…and“prett˜y-prin˜ter“suppuÂortŽŸ6‚‘êñëÖThe‘ÃÓfinite_setsŽ‘FÈÖlibrary–Ãproš¬rvides“spSŽecial“parser“and“prett˜y-prin˜ter“suppSŽort“for“ nite“setsŽ¡‘êñëdescribSŽed–Nóbš¬ry“en˜umeration“of“their“elemen˜ts.‘eÁThis“notation“is“in˜troSŽduced“b˜y“a“call“madeŽ¡‘êñëwhen––Þthe“library“is“loaded“to“the“built-in“ÍML“Öfunction“Ódefine_finite_set_syntaxŽ’‘%¬Ö(see“[4Ž‘ßü]Ž¡‘êñëfor–ª¾details“of“this“function).‘y"This“has“the“e ect“of“extending“the“ÍHOL“Öparser“so“that“aŽ¡‘êñëquotation–Ú¶of“the“form“Ó"{ÎtŸ¤zó |{Ycmr8¸1Ž–ÀÓ,ÎtŸ¤z¸2Ž“Ó,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤zó×2cmmi8¹nŽ‘¨PÓ}"–Ú¶Öparses“to“the“folloš¬rwing“set“built“up“from“ÓEMPTYŽ‘$s¾Öb˜yŽ¡‘êñërepSŽeatedly–ê¨using“the“function“ÓINSERTŽ‘&h¤Ö:ŽŸ"Á~Ÿ±ïŸþ34‘0éÓINSERT‘¿ª×tŸÌ̸1ŽŽ–}ŽÓ(INSERT‘¿ª×tŸÌ̸2ŽŽ“Î:–Ó1:“:ŽŽ‘(ÖÌÓ(INSERT‘¿ª×tŸÌ̹nŽŽ‘eÚÓEMPTY)Î:–Ó1:“:ŽŽ‘™”Ó)ŽŽŽŽŽŽŽŽŽŒ‹Oã ÌU ýFÓŸú™š‘ÇaÛ1.4.‘ €Set‘€inclusion’UÂe5Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖNote–†Ythat“the“quotation“Ó"{}"“Öjust“parses“to“the“constan¬rt“ÓEMPTYŽ‘ D«Ö.‘pWhen“the“Óprint_setŽ‘:É¬Ö agŽ¤‘Çais‘ê¨ÓtrueŽ‘éPÖ,–ê¨the“ÍHOL“Öprett•¬ry-prin“ter–ê¨for“terms“in•¬rv“erts–ê¨this“transformation.Ž¡‘(ðUsers–ñ should“note“that“care“mš¬rust“bSŽe“tak˜en“with“regard“to“the“precedence“of“comma“inŽ¡‘Çaa–ê¨conš¬rtext“Ó"{Î:–Ó1:“:ŽŽ‘™”Ó}"Ö,“as“the“follo˜wing“session“illustrates:Ž¤W°£‘ÇaŸ´D׉ffÇ I ¶ÌÍŸYœ„‘vRff ÿx༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#set_flag(`print_set`,false);;Ž¤ ‘ÌÍtrue–¿ª:“boolŽ©‘ÌÍ#"{1,2,3,4}";;Ž¡‘ÌÍ"1–¿ªINSERT“(2“INSERT“(3“INSERT“(4“INSERT“EMPTY)))"“:“termŽ¦‘ÌÍ#"{(1,2),(3,4)}";;Ž¡‘ÌÍ"(1,2)–¿ªINSERT“((3,4)“INSERT“EMPTY)"“:“termŽ¦‘ÌÍ#"{((1,2),(3,4))}";;Ž¡‘ÌÍ"((1,2),3,4)–¿ªINSERT“EMPTY"“:“termŽŽ’Æq°„‘vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖDi erenš¬rt–®grouping“b˜y“means“of“enclosing“paren˜theses“has“giv˜en“sets“with“four“elemen˜tsŽ¤‘Ça(eacš¬rh–|ôa“n˜um˜bSŽer),‘’åt˜w˜o“elemen˜ts“(eac˜h“of“whic˜h“is“a“pair),‘’åand“one“elemen˜t“(a“pair“of“pairs)Ž¡‘ÇarespSŽectiv¬rely‘ÿV.ŽŸ'ww‘Çaç1.4Ž‘@ åSet‘Ÿ¼inclusionŽŸâ#‘ÇaÖThe–dýin x“functions“ÓSUBSETŽ‘+GöÖand“ÓPSUBSETŽ‘1 Ödenote“the“binary“relations“of“set“inclusion“andŽ¡‘ÇapropšSŽer–ê¨set“inclusion,“resp˜ectivš¬rely‘ÿV.‘8àThese“are“de ned“formally“in“the“ob˜vious“w˜a˜y:Ž¤¹‘ŸÐáŸñõQ‘$FµÓSUBSET_DEF‘>þ|-–¿ª!s“t.“s“SUBSET“t“=“(!x.“x“IN“s“==>“x“IN“t)ŽŸ ‘$FµPSUBSET_DEF‘ T|-–¿ª!s“t.“s“PSUBSET“t“=“s“SUBSET“t“/\“~(s“=“t)ŽŽŽŽŽŽŽ¡‘ÇaÖThat– ƒis,‘ºÓsŽ‘ ÞçÖis“a“subset“of“ÓtŽ‘ Ö°Öif“evš¬rery“elemen˜t“of“ÓsŽ‘ Ö°Öis“also“an“elemen˜t“of“ÓtŽ‘ Ë-Ö;‘ðand“ÓsŽ‘ Ö°Öis“a“propSŽerŽ¤‘Çasubset–ê¨of“ÓtŽ› ”úÖif“it“is“a“subset“of“ÓtŽ˜Öbut“not“equal“to“ÓtŽ‘ ªRÖ.Ž¡‘(ðV‘ÿVarious›™¾pre-pro•¬rv“ed˜theorems˜ab•SŽout˜the˜subset˜and˜prop“er˜subset˜relations˜are˜suppliedŽ¡‘Çabš¬ry– Žthe“ÓsetsŽ‘ÄÖlibrary–ÿV.‘›’F“or– Žexample,‘Çthe“fact“that“ÓSUBSETŽ‘*•Öis“a“partial“order“is“stated“b˜y“theŽ¡‘Çathree–ê¨built-in“theorems“shoš¬rwn“bSŽelo˜w.ŽŸ!ä=ŸPáŸäõQ‘$FµÓSUBSET_REFL‘¾R|-–¿ª!s.“s“SUBSET“sŽ¤ ‘$FµSUBSET_TRANS‘þ¨|-–¿ª!s“t“u.“s“SUBSET“t“/\“t“SUBSET“u“==>“s“SUBSET“uŽ¡‘$FµSUBSET_ANTISYM‘ T|-–¿ª!s“t.“s“SUBSET“t“/\“t“SUBSET“s“==>“(s“=“t)ŽŽŽŽŽŽŽŸ$9‘‘ÇaÖAlso–©npro¬rvided“are“built-in“theorems“abšSŽout“the“relationship“b˜et•¬rw“een–©nset“inclusion“andŽ¡‘Çaother–£constanš¬rts“or“opSŽerations“on“sets.‘'ÐF‘ÿVor“example,‘¸áthere“are“the“follo˜wing“facts“abSŽoutŽ¡‘Çaset–ê¨inclusion“and“the“emptš¬ry“and“univ˜ersal“sets:ŽŸ*¹‘ŸÐáŸ×õQ‘$FµÓEMPTY_SUBSET‘(=¦|-–¿ª!s.“{}“SUBSET“sŽ¤ ‘$FµSUBSET_UNIV‘-ýP|-–¿ª!s.“s“SUBSET“UNIVŽ¡‘$FµNOT_PSUBSET_EMPTY‘ T|-–¿ª!s.“~s“PSUBSET“{}Ž¡‘$FµNOT_UNIV_PSUBSET‘>þ|-–¿ª!s.“~UNIV“PSUBSET“sŽŽŽŽŽŽŽŽŽŒ‹[ó ÌU ýFÓŸú™š‘êñëÛ6’ð4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖAs–fthese“examples“illustrate,‘Äèthe“names“of“theorems“in“the“ÓsetsŽ‘!ÊÆÖlibrary“are“generallyŽ¤‘êñëconstructed–³from“the“names“of“the“constanš¬rts“they“con˜tain.‘½F‘ÿVurthermore,‘!µthe“ordering“ofŽ¡‘êñëelemenš¬rts–ê¨in“the“name“of“a“theorem“attempts“to“re ect“the“con˜ten˜t“of“the“theorem“itself.ŽŸ($A‘êñëç1.5Ž‘5oUnion,–Ÿ¼in‘ÿr°tersection,“and“set“di erenceŽŸç‘êñëÖThe–{ºbinary“opSŽerations“of“union,‘Ÿþin¬rtersection“and“set“di erence“are“all“de ned“using“theŽ¡‘êñëset–ê¨abstraction“notation“in¬rtrošSŽduced“ab˜o•¬rv“e–ê¨in“section“Û??Ö.‘8àThe“formal“de nitions“are:ŽŸ&½ØŸPáŸäõQ‘üq?ÓUNION_DEF‘þ¨|-–¿ª!s“t.“s“UNION“t“=“{x“|“x“IN“s“\/“x“IN“t}Ž¤ ‘üq?INTER_DEF‘þ¨|-–¿ª!s“t.“s“INTER“t“=“{x“|“x“IN“s“/\“x“IN“t}Ž¡‘üq?DIFF_DEF‘¾R|-–¿ª!s“t.“s“DIFF“t“=“{x“|“x“IN“s“/\“~x“IN“t}ŽŽŽŽŽŽŽ©)Á‘êñëÖThese–Cbde nitions“illustrate“the“practical“utilitš¬ry“of“the“sc˜heme“for“v‘ÿXäariable“binding“in“setŽ¡‘êñëabstractions–discussed“abSŽo•¬rv“e–in“section“Û??Ö.‘¯An“abstraction“Ó"{ÎE‘a<Ó|‘¿ªÎP‘…VÓ}"“Öbinds“only“theŽ¡‘êñëv‘ÿXäariables–g that“ošSŽccur“in“b˜oth“ÎE‘Öand“ÎP‘…VÖ,‘†$and“the“v‘ÿXäariables“ÓsŽ›ÀÖand“ÓtŽ˜Öin“the“set“abstractionsŽ¡‘êñësho•¬rwn›ê¨abSŽo“v“e˜ma“y˜therefore˜bSŽe˜made˜parameters˜to˜the˜sets˜constructed˜b“y˜them.ŽŸk‘öSzUsing‘&ÆÓSET_EQ_CONVŽ‘BcÖ,‘Móit–&Æis“trivial“to“derivš¬re“the“follo˜wing“mem˜bSŽership“conditions“for“ÓUNIONŽ‘åÖ,Ž¡‘êñëÓINTERŽ‘ àäÖand‘0§ÓDIFFŽ‘!_öÖfrom–0§the“de nitions“givš¬ren“abSŽo˜v˜e.‘ ÜAs“a“general“rule,‘‚&theorems“statingŽ¡‘êñëmemš¬rbSŽership–5>conditions“of“the“kind“illustrated“b˜y“these“examples“are“giv˜en“names“of“theŽ¡‘êñëform–Ð!ÓIN_ó$!",š ó3 cmsy10Ïhó%ý': ó3 cmti10Ðc‘ÿp¹onstantŽ‘(ÆXÏi“Öending“in“the“name“of“the“opSŽeration“used“to“construct“the“set“inŽ¡‘êñëquestion.ŽŸ),ŸPáŸäõQ‘0éÓIN_UNION‘ T|-–¿ª!s“t“x.“x“IN“(s“UNION“t)“=“x“IN“s“\/“x“IN“tŽ¤ ‘0éIN_INTER‘ T|-–¿ª!s“t“x.“x“IN“(s“INTER“t)“=“x“IN“s“/\“x“IN“tŽ¡‘0éIN_DIFF‘>þ|-–¿ª!s“t“x.“x“IN“(s“DIFF“t)“=“x“IN“s“/\“~x“IN“tŽŽŽŽŽŽŽ¦‘êñëÖThese–Ëøtheorems,‘Òwhicš¬rh“are“sa˜v˜ed“in“the“library“under“the“names“indicated“abSŽo˜v˜e,‘Òma˜y“inŽ¡‘êñëpractice–ÒbšSŽe“used“as“the“de ning“prop˜erties“of“union,‘×ain¬rtersection“and“set“di erence;‘Ú˜usersŽ¡‘êñëshould–ï$almost“nevš¬rer“ha˜v˜e“to“appšSŽeal“directly“to“the“de nitions“of“these“op˜erations.‘FSOtherŽ¡‘êñëbuilt-in–ê¨theorems“abšSŽout“ÓUNIONŽ‘ ¨úÖ,“ÓINTERŽ‘$“¢Öand“ÓDIFFŽ‘ÓøÖma¬ry“b˜e“found“in“c¬rhapter“3.ŽŸ($A‘êñëç1.6Ž‘5oDisjoin‘ÿr°t‘Ÿ¼setsŽŸç‘êñëÖTwš¬ro–òcsets“are“Ùdisjoint‘§Öif“they“ha˜v˜e“no“elemen˜ts“in“common.‘PThis“concept“is“formalized“inŽ¡‘êñëthe‘ê¨ÓsetsŽ‘ÓøÖlibrary–ê¨bš¬ry“the“constan˜t“ÓDISJOINTŽ‘1çøÖ,“the“de nition“of“whic˜h“is:ŽŸ[ŸPáŸþõQ‘0éÓDISJOINT_DEF‘ T|-–¿ª!s“t.“DISJOINT“s“t“=“(s“INTER“t“=“{})ŽŽŽŽŽŽŽŸð‘êñëÖA•¬rt›ÛÖpresen“t,‘there˜are˜relativ“ely˜few˜pre-pro“v“ed˜theorems˜abSŽout˜the˜ÓDISJOINTŽ‘3´üÖrelation˜in˜theŽ¡‘êñëlibrary‘ÿV.‘6ñBut–äÜsee“cš¬rhapter“3“for“the“few“theorems“abSŽout“ÓDISJOINTŽ‘5ÇÖthat“are“in“fact“a˜v‘ÿXäailableŽ¡‘êñëin–ê¨the“ÓsetsŽ‘ÓøÖlibrary‘ÿV.ŽŽŽŒ‹gb ÌU ýFÓŸú™š‘ÇaÛ1.7.‘ €Insertion–€and“deletion“of“an“elemen t’Ê‹J7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç1.7Ž‘@ åInsertion–Ÿ¼and“deletion“of“an“elemen‘ÿr°tŽŸb ‘ÇaÖT‘ÿVo–ˆ?aid“in“the“construction“of“particular“sets“of“v‘ÿXäalues“(espSŽecially“ nite“sets)“the“libraryŽ¤‘Çaconš¬rtains– øde nitions“of“t˜w˜o“constan˜ts“ÓINSERTŽ‘*‘ìÖand“ÓDELETEŽ‘&‡ôÖ.‘–ÐThese“denote“the“opSŽerations“ofŽ¡‘Çaaugmenš¬rting–4Na“set“with“a“giv˜en“v‘ÿXäalue“and“remo˜ving“a“v‘ÿXäalue“from“a“set,‘F¸respSŽectiv˜ely‘ÿV.‘ÒTheŽ¡‘Çaformal–ê¨de nitions“of“these“opSŽerations“are:ŽŸ$wŸÐáŸñõQ‘*_ÓINSERT_DEF‘ T|-–¿ª!x“s.“x“INSERT“s“=“{y“|“(y“=“x)“\/“y“IN“s}ŽŸ ‘*_DELETE_DEF‘ T|-–¿ª!s“x.“s“DELETE“x“=“s“DIFF“(INSERT“x“EMPTY)ŽŽŽŽŽŽŽŸ$8‘ÇaÖThe–öuelemenš¬rts“of“the“set“denoted“b˜y“Óx–¿ªINSERT“s–öuÖare“all“the“elemen˜ts“of“the“set“ÓsŽ‘ ¬”ÖtogetherŽ¡‘Çawith–œÑthe“v‘ÿXäalue“ÓxŽ‘ \{Ö,‘É\whicš¬rh“ma˜y“or“ma˜y“not“bSŽe“an“elemen˜t“of“ÓsŽ‘ùLÖitself.‘O\The“set“denoted“b˜yŽ¡‘ÇaÓs–¿ªDELETE“x–ê¨Öconš¬rtains“all“the“elemen˜ts“of“ÓsŽ‘ ”úÖexcept“the“v‘ÿXäalue“ÓxŽ‘ ªRÖ.ŽŸ>ç‘(ðThe–íGmem¬rbSŽership“conditions“for“sets“constructed“using“ÓINSERTŽ›*XŠÖand“ÓDELETEŽ˜Öare“givš¬ren“b˜yŽ¡‘Çathe–ê¨folloš¬rwing“pre-pro˜v˜ed“theorems:ŽŸ%)&ŸƒŸð‘‘*_ÓIN_INSERT‘ T|-–¿ª!x“y“s.“x“IN“(y“INSERT“s)“=“(x“=“y)“\/“x“IN“sŽŸ ‘*_IN_DELETE‘ T|-–¿ª!s“x“y.“x“IN“(s“DELETE“y)“=“x“IN“s“/\“~(x“=“y)ŽŽŽŽŽŽŽŸ$ê?‘ÇaÖIn–Î!addition,‘ the“library“conš¬rtains“a“substan˜tial“collection“of“theorems“abSŽout“the“relationshipŽ¡‘ÇabšSŽet•¬rw“een–ýRthe“op˜erations“ÓINSERTŽ›,x Öand“ÓDELETEŽ˜Öand“other“relations“and“opSŽerations“on“sets.Ž¡‘ÇaChapter–ê¨3“giv¬res“a“complete“list“of“these“theorems.ŽŸ$NŽ‘Çaâ1.7.1Ž‘E`âCon•Š=v“ersions–…for“enŠ=umerated“ nite“setsŽ©?æ‘ÇaÖThe‘ÊKÓsetsŽ‘“>Ölibrary–ÊKproš¬rvides“a“collection“of“optimized“con˜v˜ersions“for“computing“the“resultsŽ¡‘Çaof–‹opšSŽerations“and“predicates“on“ nite“sets“sp˜eci ed“bš¬ry“en˜umeration“of“their“elemen˜ts.‘,AllŽ¡‘Çathese›èõcon•¬rv“ersions,‘éLthe˜curren“t˜implemen“tations˜of˜whic“h˜are˜somewhat˜expSŽerimen“tal,‘éLareŽ¡‘Çadesigned–YÄto“wš¬rork“only“for“ nite“sets“of“the“form“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"Ö.‘†3The“sections“that“follo˜wŽ¡‘ÇadescribSŽe–Rmost“of“these“con•¬rv“ersions;‘á§the–Rremainder“are“discussed“in“later“sections“of“thisŽ¡‘Çaman¬rual.ŽŸ"NŽ‘ÇaÛ1.7.1.1Ž‘F‡aMem b`ershipŽ¦‘ÇaÖThe–Àmost“basic“con•¬rv“ersion–Àfor“ nite“sets“is“a“decision“prošSŽcedure“for“mem¬rb˜ership“calledŽ¡‘ÇaÓIN_CONVŽ‘;Ö.‘ð5In–¨general,‘“convŽŽŽŽŽŽŽŸ¸N‘ÇaÖmš¬rust–Á&therefore“bSŽe“supplied“with“a“con˜v˜ersion“that“implemen˜ts“a“decision“proSŽcedure“forŽ¡‘Çaequalitš¬ry–âŠof“set“elemen˜ts.‘6+It“is“assumed“that“this“con˜v˜ersion“will“map“equations“Ó"ÎeŸ¤z¸1Ž‘ ®Ó=‘¿ªÎeŸ¤z¸2Ž‘ÀÓ"ŽŽŽŒ‹tX ÌU ýFÓŸú™š‘êñëÛ8’ð4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖbSŽet•¬rw“een›jÎelemen“ts˜of˜a˜base˜t“ypSŽe˜ÓtyŽ‘TðÖto˜the˜theorem˜Ó|-–¿ª(ÎeŸ¤z¸1Ž‘ ®Ó=“ÎeŸ¤z¸2Ž‘ÀÓ)“=“T‘j­Öor˜to˜the˜theoremŽ¤‘êñëÓ|-–¿ª(ÎeŸ¤z¸1Ž‘ ®Ó=“ÎeŸ¤z¸2Ž‘ÀÓ)“=“FÖ,–ê¨as“appropriate.Ž¡‘öSzIf‘.SÓconvŽ‘[NÖis–.San“equalitš¬ry“con˜v˜ersion“of“the“kind“describšSŽed“ab˜o•¬rv“e,‘Sþthen–.Sthe“function“returnedŽ¡‘êñëbš¬ry‘©ëÓIN_CONV‘¿ªconvŽ‘NOÎÖis–©ëa“con˜v˜ersion“that“decides“mem˜bSŽership“in“ nite“sets“of“v‘ÿXäalues“of“theŽ¡‘êñëbase–ê¨t¬rypSŽe“ÓtyŽ‘iüÖ.‘8àIn“particular,“a“call:Ž¤ŒŸ±ïŸþ34‘0éÓIN‘°—‰ffsŽ‘#™CONV–¿ªconv“"×tŽ‘ ýàÓIN“{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}"ŽŽŽŽŽŽŽ¡‘êñëÖreturns–ê¨the“theoremŽ¡Ÿ±ïŸþ34‘0éÓ|-‘¿ª×tŽ‘½ŠÓIN–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“=“TŽŽŽŽŽŽŽ¡‘êñëÖif–¶1the“term“×t“Öis“alpha-equiv‘ÿXäalenš¬rt“to“some“term“×tŸÌ̹iŽ‘ Öor“if“the“supplied“con˜v˜ersion“ÓconvŽ‘k Öpro˜v˜esŽ¤‘êñëÜ|-–,Í(×t“Ü=“×tŸÌ̹iŽ‘dÚÜ)“=“T‘*2Öfor–*„some“×i“Öwhere“1–uÂØ“×i“Ø“×nÖ.‘øtIf,‘z{on–*„the“other“hand“ÓconvŽ‘!S°Öpro•¬rv“es‘*„theŽ¡‘êñëtheorem›ê¨Ü|-–,Í(×t“Ü=“×tŸÌ̹iŽ‘dÚÜ)“=“F˜Öfor˜all˜×i˜Öwhere˜1–URØ“×i“Ø“×nÖ,˜then˜the˜result˜is˜the˜theoremŽ¤ŒŸ±ïŸþ34‘0éÓ|-‘¿ª×tŽ‘½ŠÓIN–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“=“FŽŽŽŽŽŽŽ¡‘êñëÖIn–ê¨all“other“cases,“the“call“to“ÓIN_CONVŽ‘0öÖshoš¬rwn“abSŽo˜v˜e“will“fail.Ž©‘öSzThe–ê¨folloš¬rwing“session“sho˜ws“ho˜w“ÓIN_CONVŽ‘0öÖcan“bSŽe“used“in“practice.Ž¤2o‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#IN_CONV–¿ªnum_EQ_CONV“"1“IN“{2,1,3}";;Ž¤ ‘ÌÍ|-–¿ª1“IN“{2,1,3}“=“TŽŸ‘ÌÍ#IN_CONV–¿ªnum_EQ_CONV“"4“IN“{2,1,3}";;Ž¡‘ÌÍ|-–¿ª4“IN“{2,1,3}“=“FŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖThe–øbuilt-in“con•¬rv“ersion‘øÓnum_EQ_CONVŽ‘E,|Öis–øused“here“to“decide“equalitš¬ry“of“the“natural“n˜um˜bSŽersŽ¦‘êñëin•¬rv“olv“ed–ê¨in“the“mem¬rbšSŽership“assertions“b˜eing“pro•¬rv“ed.Ž¦‘öSzAn–ê¨example“in“whicš¬rh“ÓIN_CONVŽ‘0öÖfails“is“the“follo˜wing:Ž¡‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#IN_CONV–¿ªnum_EQ_CONV“"x“IN“{1,2,3}";;Ž¤ ‘ÌÍevaluation‘¿ªfailed‘¾RIN_CONVŽŸ‘ÌÍ#num_EQ_CONV–¿ª"x“=“1";;Ž¡‘ÌÍevaluation‘¿ªfailed‘¾Rnum_EQ_CONVŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖF‘ÿVailure–É1ošSŽccurs“in“this“case“b˜ecause“the“term“ÓxŽ‘R Öis“a“v‘ÿXäariable,‘Ôand“Ónum_EQ_CONVŽ‘HΰÖthereforeŽ¦‘êñëcannot–DÄdetermine“if“it“is“equal“to“anš¬ry“of“the“set“elemen˜ts“Ó1Ž› nÖ,‘[KÓ2Ž‘_¹Öor“Ó3Ž˜Ö.‘G5Note,›[Kho•¬rw“ev“er,˜thatŽ¦‘êñëthe– supplied“con•¬rv“ersion– is“not“required“to“pro•¬rv“e› an“ything˜if˜the˜v‘ÿXäalue˜bSŽeing˜tested˜forŽ¦‘êñëmem¬rb•SŽership›ê¨happ“ens˜to˜b“e˜syn•¬rtactically˜iden“tical˜to˜an˜elemen“t˜of˜the˜giv“en˜set:Ž¤ÿo‘êñëŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#IN_CONV–¿ªNO_CONV“"x“IN“{1,x,3}";;ŽŸ ‘ÌÍ|-–¿ªx“IN“{1,x,3}“=“TŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖIn–7Òthis“case,›[—the“supplied“con•¬rv“ersion,˜namely‘7ÒÓNO_CONVŽ‘+uxÖ,˜alw“a“ys–7Òfails;‘sobut“the“call“to“ÓIN_CONVŽŽ¦‘êñëÖnonetheless–ê¨succeeds“and“returns“the“appropriate“result.ŽŽŽŒ‹ €§ ÌU ýFÓŸú™š‘ÇaÛ1.7.‘ €Insertion–€and“deletion“of“an“elemen t’Ê‹J9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Ça1.7.1.2Ž‘F‡aUnionŽŸn‘ÇaÖThe‘ê¨ÓsetsŽ‘ÓøÖlibrary–ê¨conš¬rtains“a“con˜v˜ersionŽ©­ŸÜŸþõQ‘*_ÓUNION_CONV–¿ª:“conv“->“convŽŽŽŽŽŽŽŸWo‘ÇaÖthat–éÚcan“bSŽe“used“to“compute“the“union“of“t•¬rw“o–éÚ nite“sets.‘ãFThe“ rst“argumen¬rt“to“ÓUNION_CONVŽŽ¤‘ÇaÖ(i.e.–vthe“con•¬rv“ersion›vargumen“t)˜is˜exp•SŽected˜to˜b“e˜an˜equalit•¬ry˜con“v“ersion˜of˜the˜same˜kindŽ¡‘Çarequired– ×as“an“argumenš¬rt“b˜y“ÓIN_CONVŽ‘2TÖ(see“section“1.7.1.1).‘ÛlAs“will“bšSŽe“seen“b˜elo¬rw,‘nbthisŽ¡‘Çacon•¬rv“ersion–nis“used“b¬ry“ÓUNION_CONVŽ‘C·€Öto“simplify“the“set“that“it“computes“as“the“result“ofŽ¡‘Çataking–ê¨the“union“of“t•¬rw“o–ê¨ nite“sets.ŽŸU¢‘(ðGivš¬ren–V`an“equalit˜y“con˜v˜ersion“ÓconvŽ‘UÖ,‘qNthe“function“ÓUNION_CONVŽ‘B)dÖreturns“a“con˜v˜ersion“thatŽ¡‘Çacomputes–y½the“union“of“a“ nite“set“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öand“another“set“ÎsÖ.‘æThe“second“set“Îs“ÖinŽ¡‘Çafact–68need“not“bSŽe“ nite.‘‘Ignoring,›Ifor“the“momen¬rt,˜the“pSŽossible“simpli cation“done“usingŽ¡‘Çathe–ê¨supplied“con•¬rv“ersion‘ê¨ÓconvŽ‘éPÖ,–ê¨a“call:Ž¦Ÿ±ïŸþ34‘*_ÓUNION‘°—‰ffsŽ‘#™CONV–¿ªconv“"{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“×sŽ‘ H‹Ó"ŽŽŽŽŽŽŽ¤Wo‘ÇaÖjust–ê¨returns“the“theoremŽ¦Ÿ±ïŸþ34‘*_Ó|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“×sŽ‘5Ó=“×tŸÌ̸1ŽŽ‘}ŽÓINSERT“(×:–ÿþ:“:ŽŽ‘ŠJÓ(×tŸÌ̹nŽŽ‘¦0ÓINSERT“×sŽ‘ H‹Ó)×:–ÿþ:“:ŽŽ‘ Ê Ó)ŽŽŽŽŽŽŽ¡‘ÇaÖThat–Ÿxis,‘̬ÓUNION_CONVŽ‘BèÈÖcomputes“the“required“union“as“a“repSŽeated“insertion“of“v‘ÿXäalues“in¬rtoŽ¤‘Çathe–²_set“ÎsÖ.‘When“Îs“Öis“a“ nite“set“of“the“form“Ó"{ÎuŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎuŸ¤z¹mŽ‘ÄÓ}"Ö,‘äMthe“resulting“theorem“willŽ¡‘Çaha•¬rv“e–ê¨the“form“shoš¬rwn“bSŽelo˜w.Ž¦Ÿ±ïŸþ34‘*_Ó|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ›™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“{×uŸÌ̸1ŽŽ‘ oÿÓ,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹mŽŽ›´¿Ó}“=“{×tŸÌ̸1ŽŽ‘þ:Ó,×:–ÿþ:“:ŽŽ– Ê Ó,×tŸÌ̹nŽŽ‘ æ†Ó,×uŸÌ̸1ŽŽ‘ oÿÓ,×:–ÿþ:“:ŽŽ“Ó,×uŸÌ̹mŽŽ˜Ó}ŽŽŽŽŽŽŽŸWo‘ÇaÖWhen–…computing“theorems“of“this“form“(i.e.“when“the“second“set“of“the“union“is“a“ nite“setŽ¡‘ÇaÓ"{ÎuŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎuŸ¤z¹mŽ‘ÄÓ}"Ö)–ƒÎthe“function“ÓUNION_CONVŽ‘B„@Öattempts“to“remo•¬rv“e›ƒÎredundan“t˜elemen“ts˜in˜theŽ¡‘Çaresulting–øšset“using“the“supplied“equalitš¬ry“con˜v˜ersion“ÓconvŽ‘÷BÖ.‘b¶In“particular,‘üif“ÓconvŽ‘ïÜÖis“able“toŽ¡‘Çapro•¬rv“e–úýthat“some“elemenš¬rt“ÎtŸ¤z¹iŽ‘_×Öof“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öis“equal“to“an˜y“elemen˜t“ÎuŸ¤z¹jŽ‘aÖof“Ó"{ÎuŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎuŸ¤z¹mŽ‘ÄÓ}"Ö,Ž¡‘Çathat–ªis“if“the“con•¬rv“ersion‘ªÓconvŽ‘9üÖmaps–ªthe“term“Ó"ÎtŸ¤z¹iŽ‘ $„Ó=›¿ªÎuŸ¤z¹jŽ‘f Ó"“Öto“the“theorem“Ó|-˜(ÎtŸ¤z¹iŽ‘ $„Ó=˜ÎuŸ¤z¹jŽ‘f Ó)˜=˜TÖ,Ž¡‘Çathen–ê¨the“resulting“theorem“will“bSŽeŽ¦Ÿy Ÿü¤û‘*_Ó|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”×tŸÌ̹iŽŽ‘<¤Ó,Î:–Ó1:“:ŽŽ›™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“UNION“{×uŸÌ̸1ŽŽ‘ oÿÓ,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹jŽŽ‘ Ó,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹mŽŽ‘´¿Ó}“=“{×tŸÌ̸1ŽŽ‘þ:Ó,×:–ÿþ:“:ŽŽ‘ Ê Ó,×tŸÌ̹nŽŽ‘ æ†Ó,×uŸÌ̸1ŽŽ‘ oÿÓ,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹jŽŽ‘ Ó,Î:–Ó1:“:ŽŽ˜Ó,×uŸÌ̹mŽŽ‘´¿Ó}ŽŽŽŽŽŽŽŸWo‘ÇaÖThat–mis,‘³the“redundanš¬rt“term“×tŸÌ̹iŽŽ‘}>Öwill“bSŽe“remo˜v˜ed“from“the“initial“sequence“of“elemen˜ts“inŽ¡‘Çathe–éVresulting“ nite“set.‘4ëThe“function“ÓUNION_CONVŽ‘COPÖalso“c•¬rhec“ks–éVfor“and“eliminates“alpha-Ž¡‘Çaequiv‘ÿXäalen•¬rt‘ê¨elemen“ts.ŽŸU¢‘(ðSome–ê¨examples“of“ÓUNION_CONVŽ‘AQôÖin“use“are“shoš¬rwn“in“the“follo˜wing“ÍHOL“Ösession:ŽŽŽŒ‹ Ž ÌU ýFÓŸú™š‘êñëÛ10’é¿4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý¤ñ°‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ4ŽŽŽŽŸÿ@T‘ÌÍÓ#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“{4,5,6}";;Ž¤ ‘ÌÍ|-–¿ª{1,2,3}“UNION“{4,5,6}“=“{1,2,3,4,5,6}ŽŸ‘ÌÍ#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“{3,2,SUC“0}";;Ž¡‘ÌÍ|-–¿ª{1,2,3}“UNION“{3,2,SUC“0}“=“{1,3,2,SUC“0}ŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽŸ0Öœ‘êñëÖThe–supplied“equalitš¬ry“con˜v˜ersion“in“these“examples“is“ÓNO_CONVŽ‘,\¹Ö,‘,.and“only“the“elemen˜ts“ofŽ¤‘êñëthe–J rst“set“Ó{1,2,3}“Öthat“are“redundanš¬rt“b˜y“virtue“of“bSŽeing“alpha-equiv‘ÿXäalen˜t“to“elemen˜tsŽ¡‘êñëof–™&the“second“set“are“eliminated“from“the“resulting“set.‘µAn“example“in“whicš¬rh“the“equalit˜yŽ¡‘êñëcon•¬rv“ersion–ê¨is“actually“used“is:Ž¤Vœ‘êñëŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ5ŽŽŽŽŸÿ@T‘ÌÍÓ#UNION_CONV–¿ªnum_EQ_CONV“"{1,2,3}“UNION“{3,2,SUC“0}";;ŽŸ ‘ÌÍ|-–¿ª{1,2,3}“UNION“{3,2,SUC“0}“=“{3,2,SUC“0}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖIn–2>this“case,‘D$Ónum_EQ_CONVŽ‘G²°Öis“used“to“pro•¬rv“e–2>that“Ó1“Öis“equal“to“ÓSUC‘¿ª0Ö,‘D$so“that“the“resultingŽ©‘êñëunion–ê¨is“the“set“Ó"{3,2,SUC›¿ª0}"Ö,“rather“than“Ó"{1,3,2,SUC˜0}Í"Ö.ŽŸ 1´‘êñëÛ1.7.1.3Ž‘±ëInsertionŽŸÀ‘êñëÖThe›ê¨con•¬rv“ersion˜ÓINSERT_CONVŽ‘GžÖpSŽerforms˜the˜follo“wing˜reduction˜on˜ nite˜sets:Ž¤_¹ŸDŸþ34‘‘reduce‘ UÓ"×tŽ‘ ýàÓINSERT‘¿ª{×tŸÌ̸1ŽŽ›þ:Ó,Î:–Ó1:“:ŽŽ–™”Ó,×tŸÌ̹iŽŽ‘£Ó,Î:–Ó1:“:ŽŽ“Ó,×tŸÌ̹nŽŽ‘ æ†Ó}"‘iýÖtoŽ‘%[Ó"{×tŸÌ̸1ŽŽ˜Ó,Î:–Ó1:“:ŽŽ“Ó,×tŸÌ̹iŽŽ‘£Ó,Î:–Ó1:“:ŽŽ“Ó,×tŸÌ̹nŽŽ‘ æ†Ó}"ŽŽŽŽŽŽŽ¡‘êñëÖif–o´a“supplied“equalitš¬ry“con˜v˜ersion“can“pro˜v˜e“Ó|-–¿ª(Ît“Ó=“ÎtŸ¤z¹iŽ‘dÚÓ)“=“TÖ.–o´Since“the“en˜umerated“setŽ¦‘êñënotation–pîÓ"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öis“just“a“parser-suppSŽorted“abbreviation“(see“section“1.3.1),‘ÒthisŽ¦‘êñëis– equiv‘ÿXäalen¬rt“to“reducing“the“set“Ó"{ÎtÓ,ÎtŸ¤z¸1Ž›ÀÓ,Î:–Ó1:“:ŽŽ–™”Ó,ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ“Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"– Öto“Ó"{ÎtŸ¤z¸1Ž˜Ó,Î:–Ó1:“:ŽŽ–™”Ó,ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ“Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"– Öwhen“theŽ¦‘êñëterms–ê¨Ît“Öand“ÎtŸ¤z¹iŽ‘O‚Öare“pro¬rv‘ÿXäably“equal.Ž¦‘öSzMore–/?spSŽeci cally‘ÿV,›@eif“for“some“ÎtŸ¤z¹iŽ‘”Öin“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ö,˜the“terms“Ît“Öand“ÎtŸ¤z¹iŽ‘”Öare“alpha-equiv‘ÿXäalen¬rt,Ž¦‘êñëof–ê¨if“the“con•¬rv“ersion‘ê¨ÓconvŽ‘ÓøÖmaps›ê¨Ó"Ît–¿ªÓ=“ÎtŸ¤z¹iŽ‘dÚÓ"˜Öto˜the˜theorem˜Ó|-“(Ît“Ó=“ÎtŸ¤z¹iŽ‘dÚÓ)“=“TÖ,˜then˜the˜call:Ž¡Ÿ±ïŸþ34‘0éÓINSERT‘°—‰ffsŽ‘#™CONV–¿ªconv“"×tŽ‘ ýàÓINSERT“{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}";;ŽŽŽŽŽŽŽ¡‘êñëÖwill–ê¨return“the“theorem:Ž¡Ÿ±ïŸþ34‘0éÓ|-‘¿ª×tŽ‘½ŠÓINSERT–¿ª{×tŸÌ̸1ŽŽ›þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“=“{×tŸÌ̸1ŽŽ˜Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}ŽŽŽŽŽŽŽ¡‘öSzÖHere–ê¨is“an“example“of“ÓINSERT_CONVŽ‘GžÖin“use:Ž¤Vœ‘êñëŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#INSERT_CONV–¿ªnum_EQ_CONV“"(SUC“2)“INSERT“{0,1,2,3}";;ŽŸ ‘ÌÍ|-–¿ª{SUC“2,0,1,2,3}“=“{0,1,2,3}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘öSzÖWhen–Ò™applied“repšSŽeatedly‘ÿV,‘×iÓINSERT_CONVŽ‘FæPÖcan“b˜e“used“to“reduce“ nite“sets“b¬ry“eliminatingŽ¦‘êñëas–iÞmanš¬ry“redundan˜t“oSŽccurrences“of“elemen˜ts“as“pSŽossible.‘¶An“easy“to“program,‘‰«but“slo˜w-Ž¦‘êñërunning,›ê¨w•¬ra“y˜of˜doing˜this˜is˜to˜use˜ÓDEPTH_CONVŽ‘=gLÖ:Ž¡‘êñëŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#DEPTH_CONV–¿ª(INSERT_CONV“num_EQ_CONV)“"{1,3,x,SUC“1,SUC(SUC“1),2,1,3,x}";;ŽŸ ‘ÌÍ|-–¿ª{1,3,x,SUC“1,SUC(SUC“1),2,1,3,x}“=“{2,1,3,x}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖF‘ÿVor–`a“faster“alternativš¬re“to“this“methoSŽd,‘àsee“the“reference“en˜try“for“ÓINSERT_CONVŽ‘DwÖin“c˜hapter“2.ŽŽŽŒ‹ œï ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Singleton‘€sets’HÆN11Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Ça1.7.1.4Ž‘F‡aDeletionŽŸÀ‘ÇaÖThe›2con•¬rv“ersion˜ÓDELETE_CONVŽ‘E |Öreduces˜terms˜of˜the˜form˜Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}–¿ªDELETE“ÎtÓ"˜Öb¬ry˜deletingŽ¤‘Çaall–æúelemenš¬rts“pro˜v‘ÿXäably“equal“to“Ît“Öfrom“the“set“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ö.‘7¦Lik˜e“ÓIN_CONVŽ‘0 šÖand“ÓINSERT_CONVŽ‘C#HÖ,Ž¡‘Çathe–Ÿfunction“ÓDELETE_CONVŽ‘HzPÖtakš¬res“a“con˜v˜ersion“for“deciding“equalit˜y“of“set“elemen˜ts“as“anŽ¡‘Çaargumen•¬rt.‘8àIf‘ê¨ÓconvŽ‘ÓøÖis›ê¨suc“h˜a˜con“v“ersion,˜the˜call:Ž¤OŸ±ïŸþ34‘*_ÓDELETE‘°—‰ffsŽ‘#™CONV–¿ªconv“"{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“DELETE“×tŽ‘ ýàÓ";;ŽŽŽŽŽŽŽ¡‘ÇaÖwill–ê¨return“the“theorem:Ž¡Ÿy Ÿü¤û‘*_Ó|-–¿ª{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ›™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}“DELETE“×tŽ‘½ŠÓ=“{×tŸÌ̹iŽŽ‘£Ó,Î:–Ó1:“:ŽŽ˜Ó,×tŸÌ̹jŽŽ‘¤@Ó}ŽŽŽŽŽŽŽ¡‘ÇaÖwhere–ÑWthe“resulting“set“Ó{ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ›™”Ó,ÎtŸ¤z¹jŽ‘f Ó}“Öis“the“set“of“all“v‘ÿXäalues“ÎtŸÈ®¹kŽ‘ôéÖin“the“original“set“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ˜Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ž¤‘ÇaÖfor– fwhicš¬rh“ÓconvŽ‘!tÖpro˜v˜es“Ü|-–,Í(×tŸÌ̹kŽ‘ P_Ü=“×tÜ)“=“FÖ,– fand“where“for“all“ÎtŸÈ®¹kŽ‘ -øÖin“Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}“Öbut“not“inŽ¡‘ÇaÓ{ÎtŸ¤z¹iŽ‘dÚÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹jŽ‘f Ó}Ö,‘XÕeither–BÌÎtŸÈ®¹kŽ‘ f^Öis“alpha-equiv‘ÿXäalenš¬rt“to“Ît“Öor“ÓconvŽ‘„@Öpro˜v˜es“Ü|-–,Í(×tŸÌ̹kŽ‘ P_Ü=“×tÜ)“=“TÖ.–BÌNote“thatŽ¡‘Çathe›Œcon•¬rv“ersion˜ÓconvŽ‘"æÖm“ust˜pro“v“e˜either˜equalit“y˜or˜inequalit“y˜for˜ev“ery˜elemen“t˜of˜theŽ¡‘Çaoriginal–ê¨set“that“is“not“simply“alpha-equiv›ÿXäalen¬rt“to“the“deleted“v˜alue.Ž¡‘(ðThe–ê¨folloš¬rwing“session“sho˜ws“ÓDELETE_CONVŽ‘GžÖin“use:ŽŸ Eã‘ÇaŸîÄ׉ffÇ IŸ¶ÌÍŸYœ„vRffŸí༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#DELETE_CONV–¿ªnum_EQ_CONV“"{0,1,2,3}“DELETE“(SUC“1)";;ŽŸ ‘ÌÍ|-–¿ª{0,1,2,3}“DELETE“(SUC“1)“=“{0,1,3}ŽŽ’Æq°„vRffŽŽŸÀ‰ffÇ IŽŽŽŸ5Í÷‘Çaç1.8Ž‘@ åSingleton‘Ÿ¼setsŽŸâ#‘ÇaÖA‘qÔÙsingleton‘WèÖset–r8is“a“set“that“conš¬rtains“precisely“one“elemen˜t.‘ Ï‘In“the“ÓsetsŽ‘!ãÖlibrary‘ÿV,‘ÔtheŽ¡‘ÇapropšSŽert¬ry–ê¨of“b˜eing“a“singleton“set“is“expressed“b¬ry“the“de nition:Ž¤OŸPáŸþõQ‘*_ÓSING_DEF‘>þ|-–¿ª!s.“SING“s“=“(?x.“s“=“{x})ŽŽŽŽŽŽŽ¡‘ÇaÖThe–ÊZlibrary“conš¬rtains“sev˜eral“built-in“theorems“abSŽout“singleton“sets.‘.These“are“sometimesŽ©‘Çaexpressed–ê¨in“terms“of“the“predicate“ÓSINGŽ‘éPÖ,“as“for“example“in“the“theoremŽ¡Ÿ@UŸÿi‘*_ÓSING‘>þ|-–¿ª!x.“SING{x}ŽŽŽŽŽŽŽ¡‘ÇaÖBut–ÈxpropšSŽerties“of“singleton“sets“are“more“usually“form¬rulated“as“theorems“ab˜out“sets“ofŽ¦‘Çathe–ê¨form“`Ó{x}Ö'.‘8àF‘ÿVor“example,“the“built-in“theorems“abSŽout“singleton“sets“include:Ž¤(ñŸŸã‘‘*_ÓNOT_SING_EMPTY‘ T|-–¿ª!x.“~({x}“=“{})Ž¤ ‘*_IN_SING‘3¼ú|-–¿ª!x“y.“x“IN“{y}“=“(x“=“y)Ž¡‘*_EQUAL_SING‘"}ü|-–¿ª!x“y.“({x}“=“{y})“=“(x“=“y)ŽŽŽŽŽŽŽ¡‘ÇaÖA‘îŸgeneral›î con•¬rv“en“tion˜is˜that˜theorems˜abSŽout˜singleton˜sets˜are˜giv“en˜names˜that˜con“tainŽ¦‘Çathe–¬¤elemenš¬rt“`ÓSINGŽ‘þ¨Ö',‘¹ regardless“of“whether“or“not“they“actually“con˜tain“the“predicate“ÓSINGŽ‘«LÖ.ŽŽŽŒ‹ ¬´ ÌU ýFÓŸú™š‘êñëÛ12’é¿4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.9Ž‘5oThe–Ÿ¼ëJCHOICE“çand“ëJREST“çfunctionsŽŸ”ð‘êñëÖThe‘ÓÓsetsŽ‘ NÖlibrary–Óconš¬rtains“the“de nition“of“a“functions“ÓCHOICEŽ‘)Ÿ¢Öwhic˜h“can“bSŽe“used“to“selectŽ¤‘êñëan–^arbitrary“elemenš¬rt“from“a“non-empt˜y“set.‘“9The“function“ÓCHOICEŽ‘+:2Öis“de ned“formally“b˜yŽ¡‘êñëthe–ê¨folloš¬rwing“constan˜t“spSŽeci cation:Ž©#®¶ŸPáŸþõQ‘0éÓCHOICE_DEF‘>þ|-–¿ª!s.“~(s“=“{})“==>“(CHOICE“s)“IN“sŽŽŽŽŽŽŽŸ"Øß‘êñëÖThis–m{theorem“alone“is“the“de ning“propSŽertš¬ry“for“the“constan˜t“ÓCHOICEŽ‘%ëwÖ,‘†„whic˜h“is“therefore“anŽ¡‘êñëonly– partially“spSŽeci ed“function“from“sets“to“v‘ÿXäalues.‘‚Note,› 'in“particular,˜that“there“is“noŽ¡‘êñëinformation–Õìgivš¬ren“b˜y“this“de nition“abSŽout“the“result“of“applying“ÓCHOICEŽ‘*)ÔÖto“an“empt˜y“set.ŽŸÕבöSzThe–´library“also“conš¬rtains“a“function“ÓRESTŽ‘²¯Ö,‘&^whic˜h“is“de ned“in“terms“of“the“ÓCHOICEŽŽ¡‘êñëÖfunction–ê¨as“follo¬rwsŽ¦ŸPáŸþõQ‘0éÓREST_DEF‘>þ|-–¿ª!s.“REST“s“=“s“DELETE“(CHOICE“s)ŽŽŽŽŽŽŽŸ"Øß‘êñëÖF‘ÿVor–B…anš¬ry“non-empt˜y“set“ÓsŽ‘ /Ö,‘d&the“set“ÓREST‘¿ªsŽ‘)Öcomprises“all“those“elemen˜ts“of“ÓsŽ‘ D´Öexcept“the“v‘ÿXäalueŽ¡‘êñëselected–ê¨from“ÓsŽ‘ ”úÖb¬ry“ÓCHOICEŽ‘&h¤Ö.ŽŸÕבöSzThe–TGlibrary“con¬rtains“v‘ÿXäarious“built-in“theorems“abSŽout“the“functions“ÓCHOICEŽ‘)&ŠÖand“ÓRESTŽ‘RïÖ;‘†hforŽ¡‘êñëa–ê¨full“list“of“these“theorems,“see“c¬rhapter“3.ŽŸ-<‘êñëç1.10Ž‘"% Image–Ÿ¼of“a“function“on“a“setŽŸ”ð‘êñëÖThe–ºtÙimage‘ $Öof“a“function“Óf:*->**“Öon“a“set“Ós:(*)set“Öis“the“set“of“v‘ÿXäalues“Óf(x)“Öfor“all“ÓxŽ‘ 4’Öin“ÓsŽ‘ zÖ.Ž¡‘êñëIn–²€the“ÓsetsŽ‘c¨Ölibrary‘ÿV,‘½»the“image“of“a“function“on“a“set“is“de ned“in“terms“of“the“ob¬rvious“setŽ¡‘êñëabstraction:Ž¦ŸPáŸþõQ‘0éÓIMAGE_DEF‘>þ|-–¿ª!f“s.“IMAGE“f“s“=“{f“x“|“x“IN“s}ŽŽŽŽŽŽŽŸ"Øß‘êñëÖUsing‘þÓSET_SPEC_CONVŽ‘N¹´Ö,‘ìis–þis“trivial“to“pro•¬rv“e–þfrom“this“de nition“the“folloš¬rwing“mem˜bSŽershipŽ¡‘êñëcondition–ê¨for“sets“constructed“using“ÓIMAGEŽ‘ ¨úÖ:Ž¦ŸŸý‘‘0éÓIN_IMAGE‘>þ|-–¿ª!y“s“f.“y“IN“(IMAGE“f“s)“=“(?x.“(y“=“f“x)“/\“x“IN“s)ŽŽŽŽŽŽŽŸ"Øß‘êñëÖThe‘9>ÓsetsŽ‘q$Ölibrary–9>conš¬rtains“v‘ÿXäarious“theorems“abSŽout“ÓIMAGEŽ‘%0ÎÖin“addition“to“this“mem˜bSŽershipŽ¡‘êñëtheorem.‘’These–cinclude,›OÑfor“example,˜theorems“abSŽout“the“image“of“a“function“on“setsŽ¡‘êñëconstructed–´5bš¬ry“the“opSŽerations“of“union“and“in˜tersection.‘&ºF‘ÿVor“a“full“list“of“theorems“abSŽoutŽ¡‘êñëÓIMAGEŽ‘°=Ö,–ê¨see“c¬rhapter“3.ŽŽŽŒ‹ ¹» ÌU ýFÓŸú™š‘ÇaÛ1.10.‘ €Image–€of“a“function“on“a“set’íbe13Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaâ1.10.1Ž‘M¨ŒTheorem-proŠ=ving‘…suppuÂortŽŸÀ‘ÇaÖThe‘d¦ÓsetsŽ‘ÇôÖlibrary–d¦conš¬rtains“a“con˜v˜ersion“for“computing“the“image“of“a“function“Óf“Öon“a“ niteŽ©‘Çaset–ê¨Ó{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}Ö.‘8àThe“functionŽ¤HIŸÜŸþõQ‘*_ÓIMAGE_CONV–¿ª:“conv“->“conv“->“convŽŽŽŽŽŽŽ¡‘ÇaÖis–*•parameterized“bš¬ry“t˜w˜o“con˜v˜ersions.‘ø¦The“ rst“con˜v˜ersion“is“expSŽected“to“compute“theŽ¦‘Çaresult–ñ±of“applying“the“function“Óf“Öto“eacš¬rh“elemen˜t“ÎtŸ¤z¸1Ž‘ÀÖ,‘3t×:–ÿþ:“:ŽŽ‘þÖ,‘3tÎtŸ¤z¹nŽ‘¨PÖ.‘MüThe“second“parameter“isŽ¦‘Çaan––¿equalitš¬ry“con˜v˜ersion“whic˜h“is“used“to“simplify“the“resulting“image“set“b˜y“remo˜vingŽ¦‘Çaredundanš¬rt–ê¨oSŽccurrences“of“its“elemen˜ts.Ž¦‘(ðThe–ÄËfolloš¬rwing“session“sho˜ws“a“simple“example“of“the“use“of“ÓIMAGE_CONVŽ‘A:Öon“terms“of“theŽ¦‘Çaform›^Ó"IMAGE–¿ª(\x.x+2)“{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"Ö.‘ W‘ÿVe˜ rst˜de ne˜a˜con•¬rv“ersion˜that˜ev‘ÿXäaluates˜the˜resultŽ¦‘Çaof–ê¨applying“the“function“Ó(\x.x+2)“Öto“a“term“ÎtÖ.ŽŸ1qN‘ÇaŸÛ’µ‰ffÇ IŸ>€ùÌÍŸYœ„BÚ•ffŸÇ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªAP_CONV“=“BETA_CONV“THENC“(TRY_CONV“ADD_CONV);;Ž¤ ‘ÌÍAP_CONV–¿ª=“-“:“convŽŸ‘ÌÍ#AP_CONV–¿ª"(\n.n+2)“7";;Ž¡‘ÌÍ|-–¿ª(\n.“n“+“2)7“=“9ŽŽ’Æq°„BÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ1qM‘ÇaÖThis›‹con•¬rv“ersion,–ž/together˜with˜the˜function˜ÓIMAGE_CONVŽ‘=µÖ,“giv•¬res˜a˜con“v“ersion˜for˜computingŽ¦‘Çathe–ê¨image“of“Ó(\x.x+2)“Öon“a“ nite“set“of“n¬rumerical“v‘ÿXäalues.Ž¤1¿,‘ÇaŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#IMAGE_CONV–¿ªAP_CONV“NO_CONV“"IMAGE“(\x.x+2)“{1,2,3,4}";;Ž¤ ‘ÌÍ|-–¿ªIMAGE(\x.“x“+“2){1,2,3,4}“=“{3,4,5,6}ŽŸ‘ÌÍ#IMAGE_CONV–¿ªAP_CONV“NO_CONV“"IMAGE“(\x.x+2)“{n,1,n}";;Ž¡‘ÌÍ|-–¿ªIMAGE(\x.“x“+“2){n,1,n}“=“{3,n“+“2}ŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖIn–EWthis“case,‘fgthe“second“parameter“supplied“to“ÓIMAGE_CONVŽ‘@RÖis“the“con•¬rv“ersion‘EWÓNO_CONVŽ‘+‚ýÖ.‘ÅThisŽ¦‘Çameans– ÿthat“no“reduction“of“the“resulting“image“set“is“done,‘QÕbSŽey¬rond“the“elimination“ofŽ¦‘Çaelemenš¬rts–:that“are“pro˜v‘ÿXäably“redundan˜t“b˜y“virtue“of“bSŽeing“alpha-equiv‘ÿXäalen˜t“to“some“otherŽ¦‘Çaelemenš¬rt–ê¨(as“in“the“second“example“abSŽo˜v˜e).Ž¦‘(ðThe–ê¨follo¬rwing“session“illustrates“the“use“of“the“second“parameter“to“ÓIMAGE_CONVŽ‘=gLÖ.Ž¡‘ÇaŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#IMAGE_CONV–¿ªBETA_CONV“NO_CONV“"IMAGE“(\x.“SUC“x)“{1,SUC“0,2,0}";;Ž¤ ‘ÌÍ|-–¿ªIMAGE(\x.“SUC“x){1,SUC“0,2,0}“=“{SUC“1,SUC(SUC“0),SUC“2,SUC“0}ŽŸ‘ÌÍ#IMAGE_CONV–¿ªBETA_CONV“num_EQ_CONV“"IMAGE“(\x.“SUC“x)“{1,SUC“0,2,0}";;Ž¡‘ÌÍ|-–¿ªIMAGE(\x.“SUC“x){1,SUC“0,2,0}“=“{SUC(SUC“0),SUC“2,SUC“0}ŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽ¡‘ÇaÖIn–ªbthe“ rst“ev‘ÿXäaluation,‘·=just“applying“ÓBETA_CONVŽ‘;¾Öto“the“application“of“Ó(\x.–¿ªSUC“x)–ªbÖto“eac¬rhŽ¦‘Çaelemenš¬rt–whas“resulted“in“an“image“set“con˜taining“bSŽoth“ÓSUC›¿ª1“Öand“ÓSUC(SUC˜0)Ö.‘ñzIn“the“secondŽ¦‘Çaexample,‘Ónum_EQ_CONVŽ‘HR¾Öis–yaused“to“pro•¬rv“e–yathese“v‘ÿXäalues“equal,‘and“therefore“to“simplify“theŽ¦‘Çaresulting–?èset“b¬ry“eliminating“one“of“them“from“it.‘8ŸF‘ÿVor“more“detail“abSŽout“ÓIMAGE_CONVŽ‘=¼ŒÖ,‘U7seeŽ¦‘Çathe–ê¨reference“enš¬rtry“for“this“con˜v˜ersion“in“c˜hapter“2.ŽŽŽŒ‹Ä  ÌU ýFÓŸú™š‘êñëÛ14’é¿4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.11Ž‘"% Mappings›Ÿ¼b‘Oet–ÿr°w“een˜setsŽ©¶S‘êñëÖThe‘Ú9ÓsetsŽ‘³Ölibrary–Ú9conš¬rtains“a“few“basic“de nitions“and“theorems“ha˜ving“to“do“with“mappingsŽ¤‘êñëbSŽet•¬rw“een–å£sets.‘áÞA‘å`function“Óf:*->**Ž‘.ìÖis“an“Ùinje‘ÿffctive‘ËSÖ(one-to-one)“mapping“from“a“set“Ós:(*)setŽŽ¡‘êñëÖto–ê¨a“set“Ót:(**)setŽ‘;’JÖif“it“takš¬res“distinct“elemen˜ts“of“ÓsŽ‘ ”úÖto“distinct“elemen˜t“of“ÓtŽ‘ ªRÖ:ŽŸ8>ŸŽ4ŸÉ‘‘0éÓINJ_DEF‘¿ª=Ž¤ ‘0é|-–¿ª!f“s“t.Ž¡‘/‘INJ–¿ªf“s“t“=Ž¡‘/‘(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘/‘(!x–¿ªy.“x“IN“s“/\“y“IN“s“==>“(f“x“=“f“y)“==>“(x“=“y))ŽŽŽŽŽŽŽŸ9ÂL‘êñëÖLikš¬rewise,‘1a–—function“Óf:*->**Ž‘.BÔÖis“a“Ùsurje‘ÿffctive‘èGÖ(on˜to)“mapping“from“ÓsŽ› ÄØÖto“ÓtŽ˜Öif“for“evš¬rery“elemen˜tŽ¡‘êñëÓxŽ‘ôœ=Öof‘ê¨ÓtŽ› ”úÖthere–ê¨is“some“elemen¬rt“ÓyŽ˜Öof“ÓsŽ˜Öfor“whic¬rh“Óf–¿ªy“=“xÖ:ŽŸ9™–ŸŽ4ŸÉ‘‘0éÓSURJ_DEF‘¿ª=Ž¤ ‘0é|-–¿ª!f“s“t.Ž¡‘/‘SURJ–¿ªf“s“t“=Ž¡‘/‘(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘/‘(!x.–¿ªx“IN“t“==>“(?y.“y“IN“s“/\“(f“y“=“x)))ŽŽŽŽŽŽŽŸ9 ‘êñëÖFinally‘ÿV,‘ÚÀa–ÖÇfunction“Óf:*->**Ž‘/ë4Öis“a“Ùbije‘ÿffction‘¼wÖfrom“ÓsŽ› m8Öto“ÓtŽ˜Öif“it“is“bSŽoth“injectivš¬re“and“surjectiv˜e:ŽŸ BÖŸPáŸþõQ‘0éÓBIJ_DEF–¿ª=“|-“!f“s“t.“BIJ“f“s“t“=“INJ“f“s“t“/\“SURJ“f“s“tŽŽŽŽŽŽŽŸÚ|‘öSzÖThere–ÅŠare“a“few“pre-pro•¬rv“ed–ÅŠtheorems“abSŽout“the“predicates“ÓINJŽ‘ˆÖ,‘Ì÷ÓSURJŽ‘ËŸÖ,‘Ì÷and“ÓBIJŽ‘ÊÖa¬rv‘ÿXäailableŽ¡‘êñëin–ê¨the“library;“see“c¬rhapter“3“for“a“full“list“of“these“theorems.ŽŸh[‘öSzThe–F–library“also“conš¬rtains“constan˜t“spSŽeci cations“for“t˜w˜o“functions“ÓLINVŽ‘‹ÔÖand“ÓRINVŽ‘E>Ö,‘ggwhic˜hŽ¡‘êñëyield–Ê*left“and“righš¬rt“in˜v˜erses“to“injectiv˜e“and“surjectiv˜e“mappings“respSŽectiv˜ely‘ÿV.‘ ×eTheseŽ¡‘êñëfunctions–ê¨are“de ned“b¬ry:ŽŸ%§ŸÐáŸñõQ‘0éÓLINV_DEF–¿ª=“|-“!f“s“t.“INJ“f“s“t“==>“(!x.“x“IN“s“==>“(LINV“f“s(f“x)“=“x))ŽŸ ‘0éRINV_DEF–¿ª=“|-“!f“s“t.“SURJ“f“s“t“==>“(!x.“x“IN“t“==>“(f(RINV“f“s“x)“=“x))ŽŽŽŽŽŽŽŸ%ZM‘êñëÖThere–7&are,›[ at“presen¬rt,˜no“additional“built-in“theorems“abSŽout“these“t•¬rw“o‘7&functions.‘ý F‘ÿVurther-Ž¡‘êñëmore,‘ãthe–å²de nitions“of“ÓLINVŽ›Ê Öand“ÓRINVŽ˜Öshoš¬rwn“abSŽo˜v˜e“should“bSŽe“regarded“as“only“pro˜visional;Ž¡‘êñëthey–ê¨maš¬ry“bSŽe“c˜hanged“in“future“v˜ersions.ŽŸ*˜Û‘êñëç1.12Ž‘"% Finite–Ÿ¼and“in nite“setsŽ¦‘êñëÖThe‘7ŠÓsetsŽ‘m¼Ölibrary–7Šincludes“the“de nition“of“a“predicate“called“ÓFINITEŽ‘%µ†Ö,‘[]whic¬rh“is“true“of“ niteŽ¡‘êñësets–ê¨and“false“of“in nite“ones.‘8àThe“de nition“of“this“constanš¬rt“is“sho˜wn“bSŽelo˜w.ŽŽŽŒ‹Ò  ÌU ýFÓŸú™š‘ÇaÛ1.12.‘ €Finite–€and“in nite“sets’ù15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýžuFŸKˆŸØi‘*_ÓFINITE_DEFŽ¤ ‘5…³|-‘¿ª!s.Ž¡‘L„[FINITE–¿ªs“=Ž¡‘L„[(!P.–¿ªP{}“/\“(!s'.“P“s'“==>“(!e.“P(e“INSERT“s')))“==>“P“s)ŽŽŽŽŽŽŽŸ1ꌑÇaÖThat–êis,‘)óa“set“ÓsŽ‘“ØÖis“ nite“precisely“when“it“is“in“the“smallest“class“of“sets“that“con¬rtainsŽ¤‘Çathe–üemptš¬ry“set“and“is“closed“under“the“ÓINSERTŽ‘*vÖopSŽeration.‘mThis“inductiv˜e“de nition“mak˜esŽ¡‘ÇaÓFINITEŽ‘:}ÚÖtrue–8}of“just“those“sets“that“can“bSŽe“constructed“from“the“emptš¬ry“set“b˜y“a“ niteŽ¡‘Çasequence–ê¨of“applications“of“the“ÓINSERTŽ‘*SLÖopSŽeration.Ž©kq‘(ðThe‘ƒÓsetsŽ‘ ²Ölibrary–ƒconš¬rtains“v‘ÿXäarious“built-in“theorems“that“follo˜w“from“the“de nition“ofŽ¡‘ÇaÓFINITEŽ‘90Ögiv•¬ren›ê¨abSŽo“v“e.‘8àAmong˜these˜are˜the˜t“w“o˜fundamen“tal˜theorems˜sho“wn˜bSŽelo“w:ŽŸ%ÛVŸÐáŸñõQ‘*_ÓFINITE_EMPTY‘>þ|-‘¿ªFINITE{}ŽŸ ‘*_FINITE_INSERT‘ T|-–¿ª!x“s.“FINITE(x“INSERT“s)“=“FINITE“sŽŽŽŽŽŽŽŸ%oå‘ÇaÖThese–µ›state“that“the“empt¬ry“set“is“indeed“ nite“and“insertion“constructs“ nite“sets“onlyŽ¡‘Çafrom–ê¨other“ nite“sets.‘8àSee“c¬rhapter“3“for“other“built-in“theorems“abSŽout“ nite“sets.Ž¦‘(ðThe›yÕabSŽo•¬rv“e˜de nition˜of˜ÓFINITEŽ‘-q¦Öformalizes˜the˜notion˜of˜a˜ nite˜set˜in˜logic,‘Ý and˜itŽ¡‘Çatherefore–å½also“determines“the“form“of“de nition“for“the“complemen¬rtary“notion“of“an“in niteŽ¡‘Çaset.‘8àIn–ê¨the“ÓsetsŽ‘ÓøÖlibrary‘ÿV,“the“predicate“ÓINFINITEŽ‘5Ò Öis“de ned“as“follo¬rws:Ž© […ŸPáŸþõQ‘*_ÓINFINITE_DEF‘>þ|-–¿ª!s.“INFINITE“s“=“~FINITE“sŽŽŽŽŽŽŽŸð‘ÇaÖThere–!Ãare“a“few“consequences“of“this“de nition“stored“in“the“ÓsetsŽ‘B.Ölibrary‘ÿV.‘Þ1The“follo¬rwingŽ¡‘Çatheorem,–OÃfor›;‹example,“states˜that˜the˜image˜of˜an˜injectiv¬re˜function˜on˜an˜in nite˜set˜isŽ¡‘Çain nite:ŽŸ)€ªŸ ˈŸåi‘*_ÓIMAGE_11_INFINITEŽ¤ ‘;E]|-–¿ª!f.“(!x“y.“(f“x“=“f“y)“==>“(x“=“y))“==>Ž¡‘cƒ(!s.–¿ªINFINITE“s“==>“INFINITE(IMAGE“f“s))ŽŽŽŽŽŽŽŸ+jŒ‘ÇaÖOther–ê¨built-in“theorems“abšSŽout“ÓINFINITEŽ‘5Ò Öcan“b˜e“found“in“c¬rhapter“3.ŽŸ%a7‘Çaâ1.12.1Ž‘M¨ŒTheorem-proŠ=ving‘…suppuÂortŽŸšv‘ÇaÖThere–>6are“t•¬rw“o–>6ÍML“Öfunctions“in“the“ÓsetsŽ‘!{Ölibrary“for“reasoning“abšSŽout“prop˜ositions“thatŽ¡‘Çain•¬rv“olv“e–the“ niteness“predicate“ÓFINITEŽ‘'šÖ.‘Í?The“ rst“of“these“is“a“con•¬rv“ersion‘ÓFINITE_CONVŽŽ¡‘ÇaÖwhicš¬rh–ê¨automatically“pro˜v˜es“that“sets“of“the“form“Ó"{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}"“Öare“ nite.‘8àEv‘ÿXäaluatingŽ¦Ÿ±ïŸþ34‘*_ÓFINITE‘°—‰ffsŽ‘#™CONV–¿ª"FINITE“{×tŸÌ̸1ŽŽ‘þ:Ó,Î:–Ó1:“:ŽŽ‘™”Ó,×tŸÌ̹nŽŽ‘ æ†Ó}";;ŽŽŽŽŽŽŽŸð‘ÇaÖyields–ê¨the“theorem“Ó|-–¿ªFINITE“{ÎtŸ¤z¸1Ž‘ÀÓ,Î:–Ó1:“:ŽŽ‘™”Ó,ÎtŸ¤z¹nŽ‘¨PÓ}“=“TÖ.ŽŽŽŒ‹Ü¢ ÌU ýFÓŸú™š‘êñëÛ16’é¿4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.13Ž‘"% Cardinalit‘ÿr°y–Ÿ¼of“ nite“setsŽ©â#‘êñëÖThe›¾ Ùc–ÿffar“dinality‘Ì"Öof˜a˜ nite˜set˜is˜the˜n•¬rum“bSŽer˜of˜elemen“ts˜it˜con“tains.‘ÔÝIn˜the˜ÓsetsŽ‘{èÖlibrary‘ÿV,‘ú¢thisŽ¤‘êñëis–ŸËformalized“bš¬ry“a“constan˜t“ÓCARDŽ‘>>Öde ned“b˜y“means“of“the“follo˜wing“constan˜t“spSŽeci cation:ŽŸ4‘ŸˈŸËi‘üq?ÓCARD_DEFŽ¤ ‘ð“|-–¿ª(CARD{}“=“0)“/\Ž¡‘/‘(!s.Ž¡‘$®åFINITE–¿ªs“==>Ž¡‘$®å(!x.–¿ªCARD(x“INSERT“s)“=“(x“IN“s“=>“CARD“s“|“SUC(CARD“s))))ŽŽŽŽŽŽŽŸ4‘Œ‘êñëÖThis–\theorem“is“the“sole“de ning“propSŽert¬ry“of“ÓCARDŽ‘€Ö.‘üýBecause“the“equation“in“the“secondŽ¡‘êñëclause–`³holds“only“under“the“assumption“that“ÓsŽ‘Öis“ nite,‘¾5this“form“of“de nition“allo¬rwsŽ¡‘êñënothing–ê¨signi can¬rt“to“bšSŽe“deduced“ab˜out“the“cardinalit¬ry“`ÓCARD‘¿ªsŽ‘"}üÖ'“of“an“Ùin nite‘ÐXÖset“ÓsŽ‘ ªRÖ.Ž¡‘öSzThe–»dbuilt-in“theorems“abSŽout“cardinalit¬ry“are“all“restricted“to“ nite“sets“only‘ÿV,‘/“eitherŽ¡‘êñëimplicitly–ê¨as“in“the“theorem:Ž¤ŸPáŸþõQ‘0éÓCARD_SING‘ T|-–¿ª!x.“CARD{x}“=“1ŽŽŽŽŽŽŽ¡‘êñëÖor–ê¨explicitly‘ÿV,“as“in:ŽŸA‘Ÿ'ˈŸ±i‘0éÓFINITE_ISO_NUMŽ¤ ‘ °=|-‘¿ª!s:(*)set.Ž¡‘$®åFINITE–¿ªs“==>Ž¡‘$®å(?f:num->*.Ž¡‘0.9(!n‘¿ªm.Ž¡‘;­n–¿ª<“(CARD“s)“/\“m“<“(CARD“s)“==>“(f“n“=“f“m)“==>“(n“=“m))“/\Ž¡‘0.9(s–¿ª=“{f“n“|“n“<“(CARD“s)}))ŽŽŽŽŽŽŽŸA‘Œ‘êñëÖThis–&second“theorem“states“that“the“elemenš¬rts“of“a“ nite“set“can“alw˜a˜ys“bSŽe“put“in˜to“aŽ¤‘êñëone-to-one–:écorrespšSŽondence“with“the“natural“n•¬rum“b˜ers–:éless“than“the“set's“cardinalit¬ry|i.e.Ž¡‘êñëthe–öEelemenš¬rts“of“a“ nite“set“ÓsŽ‘¬4Öcan“bSŽe“n˜um˜bSŽered“Ó0Ž‘ µïÖ,‘9,Ó1Ž‘ øÖÖ,‘9,×:–ÿþ:“:ŽŽ‘ÊÖ,‘9,Ó(CARD‘¿ªs)-1Ö.‘[·Other“theoremsŽ¡‘êñëin•¬rv“olving–ê¨the“cardinalitš¬ry“function“ÓCARDŽ‘ÓøÖcan“bSŽe“found“in“c˜hapter“3.ŽŸ'÷@‘êñëç1.14Ž‘"% Using–Ÿ¼the“libraryŽ¦‘êñëÖThe‘_®Ófinite_setsŽ‘EûªÖlibrary–_®is“loaded“in¬rto“a“user's“ÍHOL“Ösession“using“the“builtin“ÍML“ÖfunctionŽ¡‘êñëÓload_libraryŽ‘3p]Ö(see–‚zthe“ÍHOL“Öman¬rual“for“a“general“description“of“library“loading).‘&The“ rstŽ¡‘êñëaction–3_in“the“load“sequence“is“to“upSŽdate“the“inš¬rternal“ÍHOL“Ösearc˜h“paths.‘A‘3Lpathname“toŽ¡‘êñëthe– Wlibrary“is“added“to“the“searcš¬rh“path“so“that“theorems“ma˜y“bSŽe“autoloaded“from“theŽ¡‘êñëlibrary–Patheory“Ófinite_setsŽ‘CŒ¯Ö;‘ƒ>and“the“ÍHOL“Öhelp“searc¬rh“path“is“upSŽdated“with“a“pathnameŽ¡‘êñëto–ê¨online“help“ les“for“the“ÍML“Öfunctions“in“the“library‘ÿV.Ž¡‘öSzAfter–ÓUthe“searcš¬rh“paths“are“upSŽdated,‘×ÿthe“actions“tak˜en“b˜y“the“load“sequence“for“depSŽendŽ¡‘êñëon–y¸the“curren¬rt“state“of“the“ÍHOL“Ösession.‘;If“the“system“is“in“draft“moSŽde,‘Nthe“library“theoryŽŽŽŒ‹秠ÌU ýFÓŸú™š‘ÇaÛ1.14.‘ €Using–€the“library’.+F17Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓfinite_setsŽ‘UÐÖis–ÌVadded“as“a“new“parenš¬rt“to“the“curren˜t“theory‘ÿV.‘.ÅIf“the“system“is“not“in“draftŽ¤‘ÇamoSŽde,‘µêbut–Zthe“curren¬rt“theory“is“an“ancestor“of“the“Ófinite_setsŽ‘IðnÖtheory“in“the“libraryŽ¡‘Ça(e.g.–ì½the“user“is“in“a“fresh“ÍHOL“Ösession)“then“Ófinite_setsŽ‘GÈÖis“made“the“curren¬rt“theory‘ÿV.‘?InŽ¡‘ÇabSŽoth–Ý*cases,‘Ëthe“ÍML“Öfunctions“proš¬rvided“b˜y“the“library“are“loaded“in˜to“ÍHOL‘ÒCÖand“all“theŽ¡‘Çatheorems–¹¥in“the“library“(including“de nitions)“are“set“up“to“bSŽe“autoloaded“on“demand.Ž¡‘ÇaThe–N—parser“and“prett•¬ry-prin“ter–N—for“the“notation“describšSŽed“ab˜o•¬rv“e–N—in“sections“Û??‘d®Öand“1.3.1Ž¡‘Çaare–…qthen“activ‘ÿXäated,‘™¯and“the“ÍML“Öfunctions“proš¬rvided“b˜y“the“library“for“reasoning“abSŽout“setsŽ¡‘Çaare–ê¨loaded.‘8àThe“Ófinite_setsŽ‘GžÖlibrary“is“then“fully“loaded“in¬rto“the“user's“ÍHOL“Ösession.ŽŸ+17‘Çaâ1.14.1Ž‘M¨ŒExample‘…sessionŽŸ…‘ÇaÖThe–tÚfolloš¬rwing“session“sho˜ws“ho˜w“Ófinite_setsŽ‘H&Öma˜y“bSŽe“loaded“using“Óload_libraryŽ‘IpÒÖ.‘×wSup-Ž¡‘Çap•SŽose,›™‚b“eginning–CWin“a“fresh“ÍHOL“Ösession,˜the“user“wishes“to“create“a“theory“ÓfooŽ‘ŬÖwhoseŽ¡‘Çaparenš¬rts–ê¨include“the“theory“Ófinite_setsŽ‘GžÖin“the“library‘ÿV.‘8àThis“ma˜y“bSŽe“done“as“follo˜ws:Ž©Oõ”‘ÇaŸË¬ ‰ffÇ IŸ^NNÌÍŸYœ„b§êffŸ§¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#new_theory‘¿ª`foo`;;Ž¤ ‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#load_library‘¿ª`finite_sets`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¡‘ÌÍLibrary–¿ªfinite_sets“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„b§êffŽŽŸÀ‰ffÇ IŽŽŽŸN˜×‘ÇaÖLoading–Aáthe“library“while“drafting“the“theory“ÓfooŽ‘ÂÀÖmak¬res“the“library“theory“Ófinite_setsŽŽ¡‘ÇaÖinš¬rto–_Va“paren˜t“of“ÓfooŽ‘žTÖ.‘ oThe“same“e ect“could“ha˜v˜e“bSŽeen“ac˜hiev˜ed“(in“a“fresh“session)“b˜y“ rstŽ¡‘Çaloading–ê¨the“library“and“then“creating“ÓfooŽ‘)¦Ö:Ž¦‘ÇaŸË¬ ‰ffÇ IŸ^NNÌÍŸYœ„b§êffŸ§¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`finite_sets`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ªfinite_sets“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#new_theory‘¿ª`foo`;;Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„b§êffŽŽŸÀ‰ffÇ IŽŽŽŸN˜×‘ÇaÖThe–}$theory“Ófinite_setsŽ‘J6–Öis“ rst“made“the“curren¬rt“theory“of“the“new“session.‘ ðUIt“thenŽ¡‘Çaautomatically–ê¨bSŽecomes“a“parenš¬rt“of“ÓfooŽ‘NÖwhen“this“theory“is“created“b˜y“Ónew_theoryŽ‘=gLÖ.ŽŸ\½‘(ðNo¬rw,‘ÌïsuppšSŽose–Åthat“ÓfooŽ‘ÊÖhas“b˜een“created“as“sho¬rwn“ab˜o•¬rv“e,‘Ìïand–Åthe“user“do˜es“some“w¬rorkŽ¡‘Çain–§this“theory‘ÿV,‘´quits“ÍHOLÖ,“and“in“a“later“session“wishes“to“load“the“theory“ÓfooŽ‘æÖ.‘"UThis“m¬rustŽ¡‘ÇabSŽe–ê¨done“b¬ry“Ù rst‘ìÖloading“the“Ófinite_setsŽ‘GžÖlibrary“and“Ùthen‘ÐXÖloading“the“theory“ÓfooŽ‘)¦Ö.ŽŽŽŒ‹òÇ ÌU ýFÓŸú™š‘êñëÛ18’é¿4Chapter–€1.‘ €The“ nite‘ÌʉˆŠ ÏŽ‘ê¨sets“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý» |‘êñëŸÅ, ‰ffÇ IŸkNNÌÍŸYœ„o§êffŸš¯$’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`finite_sets`;;ŽŸÍUŸø‘L!.Ž¤‘L!.Ž¡‘L!.ŽŽŽ¤ ‘ÌÍLibrary–¿ªfinite_sets“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#load_theory‘¿ª`foo`;;Ž¡‘ÌÍTheory–¿ªfoo“loadedŽ¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„o§êffŽŽŸÀ‰ffÇ IŽŽŽŸK¯‘êñëÖThis–ÈUsequence“of“actions“ensures“that“the“system“can“ nd“the“paren¬rt“theory“Ófinite_setsŽŽ¤‘êñëÖwhen–ê¨it“comes“to“load“ÓfooŽ‘)¦Ö,“since“loading“the“library“upSŽdates“the“searc¬rh“path.ŽŸ"Ê«‘êñëâ1.14.2Ž‘%ÓThe›…óKßê|ŸGëHML– ‰‹F‘ýunctions“in“the“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–úcš¬rhapter“pro˜vides“doSŽcumen˜tation“on“all“the“ÍML“Öfunctions“that“are“made“a˜v‘ÿXäailable“inŽ¤ÍHOL–™ÒÖwhen“the“Ófinite_setsŽ‘FoòÖlibrary“is“loaded.‘îThis“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“onlineŽ¡via–ê¨the“ÓhelpŽ‘ÓøÖfacilit¬ry‘ÿV.ŽŸ&3Ÿ¹IŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍóLßê“convŽ© âSynopsisŽ¡ÖReduce›ê¨Ó{x1,...,xn}–¿ªDELETE“x˜Öb¬ry˜deleting˜Óx˜Öfrom˜Ó{x1,...,xn}Ö.Ž¦âDescriptionŽ¡ÖThe–äÔfunction“ÓDELETE_CONV‘ä‘Öis“a“parameterized“con•¬rv“ersion–äÔfor“reducing“ nite“sets“of“the“formŽ¡Ó"{t1,...,tn}–¿ªDELETE“t"Ö,‘Ywhere–BüÓ{t1,...,tn}“Öis“a“set“of“t¬rypSŽe“Ó(ty)set“Öand“Ót“Öis“a“term“ofŽ¡tš¬rypSŽe–NÓtyÖ.‘cThe“ rst“argumen˜t“to“ÓDELETE_CONV‘MõÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–Nthat“decidesŽ¡equalit•¬ry›Ì bSŽet“w“een˜v‘ÿXäalues˜of˜the˜base˜t“ypSŽe˜ÓtyÖ.‘.«Giv“en˜an˜equation˜Ó"e1–¿ª=“e2"Ö,‘Ò(where˜Óe1˜ÖandŽ¡Óe2–.eÖare“terms“of“tš¬rypSŽe“ÓtyÖ,‘?Uthis“con˜v˜ersion“should“return“the“theorem“Ó|-–¿ª(e1“=“e2)“=“T‘.TÖorŽ¡the–ê¨theorem“Ó|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.Ž¡‘ aGiv•¬ren›R\suc“h˜a˜con“v“ersion˜ÓconvÖ,‘pÒthe˜function˜ÓDELETE_CONV‘R5Öreturns˜a˜con“v“ersion˜that˜mapsŽ¡a–ê¨term“of“the“form“Ó"{t1,...,tn}–¿ªDELETE“t"–ê¨Öto“the“theoremŽ©"‘>þÓ|-–¿ª{t1,...,tn}“DELETE“t“=“{ti,...,tj}ŽŸˆ…Öwhere–Ó{ti,...,tj}“Öis“the“subset“of“Ó{t1,...,tn}“Öfor“whicš¬rh“the“supplied“equalit˜y“con˜v˜ersionŽ¡Óconv‘ê¨Öpro•¬rv“esŽ¦‘>þÓ|-–¿ª(ti“=“t)“=“F,“...,“|-“(tj“=“t)“=“FŽŸˆ…Öand–îfor“all“the“elemenš¬rts“Ótk“Öin“Ó{t1,...,tn}“Öbut“not“in“Ó{ti,...,tj}Ö,‘.àeither“Óconv“Öpro˜v˜esŽ¡Ó|-–¿ª(tk“=“t)“=“T‘¿Öor–Ótk“Öis“alpha-equiv‘ÿXäalen¬rt“to“ÓtÖ.‘ÓThat“is,‘jèthe“reduced“set“Ó{ti,...,tj}Ž¡Öcomprises–¦ºall“those“elemenš¬rts“of“the“original“set“that“are“pro˜v‘ÿXäably“not“equal“to“the“deletedŽ¡elemen¬rt‘ê¨ÓtÖ.ŽŽŸ$ý’烈Û19ŽŽŒ‹ è ÌU ýFÓŸú™š‘êñëÛ20’ÅëEChapter–€2.‘ €ML“F‘þàunctions“in“the“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽ¤‘êñëÖIn–Uthe“folloš¬rwing“example,‘rïthe“con˜v˜ersion“Ónum_EQ_CONV‘TÛÖis“supplied“as“a“parameter“and“usedŽ¡‘êñëto–ê¨test“equalitš¬ry“of“the“deleted“v‘ÿXäalue“Ó2“Öwith“the“elemen˜ts“of“the“set.ŽŸ~;‘ü0éÓ#DELETE_CONV–¿ªnum_EQ_CONV“"{2,1,SUC“1,3}“DELETE“2";;Ž© ™š‘ü0é|-–¿ª{2,1,SUC“1,3}“DELETE“2“=“{1,3}ŽŸ'­ã‘êñëâF‘þž¸ailureŽ¡‘êñëÓDELETE_CONV›¿ªconv–@Öfails“if“applied“to“a“term“not“of“the“form“Ó"{t1,...,tn}˜DELETE˜t"Ö.‘95AŽ¡‘êñëcall›gäÓDELETE_CONV–¿ªconv“"{t1,...,tn}“DELETE“t"˜Öfails˜unless˜for˜eac•¬rh˜elemen“t˜Óti˜Öof˜theŽ¡‘êñëset–=MÓ{t1,...,tn}Ö,‘‘öthe“term“Ót“Öis“either“alpha-equiv‘ÿXäalen¬rt“to“Óti“Öor“Óconv–¿ª"ti“=“t"‘=MÖreturnsŽ¡‘êñëÓ|-–¿ª(ti“=“t)“=“T–ê¨Öor“Ó|-–¿ª(ti“=“t)“=“FÖ.Ž¤ÉB‘êñëâSee‘…alsoŽ¦‘êñëÓINSERT_CONV.ŽŸ([ÆŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëLIMAGE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.üÝ‘êñëÓIMAGE_CONV–¿ª:“conv“->“conv“->“convŽ¡‘êñëâSynopsisŽ©‘êñëÖCompute–ê¨the“image“of“a“function“on“a“ nite“set.Ž¡‘êñëâDescriptionŽ¦‘êñëÖThe–€pfunction“ÓIMAGE_CONV‘€Öis“a“parameterized“con•¬rv“ersion–€pfor“computing“the“image“of“aŽ¦‘êñëfunction–(´Óf:ty1->ty2“Öon“a“ nite“set“Ó"{t1,...,tn}"“Öof“tš¬rypSŽe“Ó(ty1)setÖ.‘óThe“ rst“argumen˜tŽ¦‘êñëto–Ø¥ÓIMAGE_CONV‘ØgÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–Ø¥that“computes“the“result“of“applying“theŽ¦‘êñëfunction–‰+Óf“Öto“eacš¬rh“elemen˜t“of“this“set.‘jWhen“applied“to“a“term“Ó"f‘¿ªti"Ö,‘°Ìthis“con˜v˜ersionŽ¦‘êñëshould–V‚return“a“theorem“of“the“form“Ó|-–¿ª(f“ti)“=“riÖ,‘qywhere–V‚Óri“Öis“the“result“of“applyingŽ¦‘êñëthe–¯ofunction“Óf“Öto“the“elemenš¬rt“ÓtiÖ.‘‡4This“con˜v˜ersion“is“used“b˜y“ÓIMAGE_CONV‘¯<Öto“compute“aŽ¦‘êñëtheorem–ê¨of“the“formŽŸ~;‘ü0éÓ|-–¿ªIMAGE“f“{t1,...,tn}“=“{r1,...,rn}ŽŸä¡‘êñëÖThe–IÞsecond“argumen¬rt“to“ÓIMAGE_CONV‘IÆÖis“used“(optionally)“to“simplify“the“resulting“imageŽ¦‘êñëset–ÿöÓ{r1,...,rn}“Öbš¬ry“remo˜ving“redundan˜t“oSŽccurrences“of“v‘ÿXäalues.‘xËThis“con˜v˜ersion“expSŽectedŽ¦‘êñëto–¥Ûdecide“equalitš¬ry“of“v‘ÿXäalues“of“the“result“t˜ypSŽe“Óty2Ö;‘ugiv˜en“an“equation“Ó"e1–¿ª=“e2"Ö,‘Ô¨whereŽ¦‘êñëÓe1–ŠgÖand“Óe2“Öare“terms“of“tš¬rypSŽe“Óty2Ö,‘§the“con˜v˜ersion“should“return“either“Ó|-–¿ª(e1“=“e2)“=“T‘ŠOÖorŽ¦‘êñëÓ|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.ŽŽŽŒ‹1 ÌU ýFÓŸú™š‘ÇaÒIMA¦tGE‘Ái‰ffÇŽ‘ˆ„CONV’c5>Û21Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘(ðÖGivš¬ren–Ê8appropriate“con˜v˜ersions“Óconv1“Öand“Óconv2Ö,‘Bthe“function“ÓIMAGE_CONV‘ɽÖreturns“aŽ¤‘Çacon•¬rv“ersion–ê¨that“maps“a“term“of“the“form“Ó"IMAGE–¿ªf“{t1,...,tn}"–ê¨Öto“the“theoremŽ©;ב$_Ó|-–¿ªIMAGE“f“{t1,...,tn}“=“{rj,...,rk}ŽŸy®‘ÇaÖwhere–èÓconv1“Öpro•¬rv“es–èa“theorem“of“the“form“Ó|-–¿ª(f“ti)“=“ri–èÖfor“eacš¬rh“elemen˜t“Óti“Öof“the“setŽ¡‘ÇaÓ{t1,...,tn}Ö,‘…’and–f—where“the“set“Ó{rj,...,rk}“Öis“the“smallest“subset“of“Ó{r1,...,rn}“Ösuc¬rhŽ¡‘Çano›ïît•¬rw“o˜elemen“ts˜are˜alpha-equiv‘ÿXäalen“t˜and˜Óconv2˜ÖdoSŽes˜not˜map˜Ó"rl–¿ª=“rm"˜Öto˜the˜theoremŽ¡‘ÇaÓ|-–¿ª(rl“=“rm)“=“T‘è@Öfor–èAan¬ry“pair“of“v‘ÿXäalues“Órl“Öand“Órm“Öin“Ó{rj,...,rk}Ö.‘8That“is,‘è¼Ó{rj,...,rk}Ž¡‘ÇaÖis–×Âthe“set“obtained“bš¬ry“remo˜ving“m˜ultiple“oSŽccurrences“of“v‘ÿXäalues“from“the“set“Ó{r1,...,rn}Ö,Ž¡‘Çawhere–õ‘the“equalitš¬ry“con˜v˜ersion“Óconv2“Ö(or“alpha-equiv‘ÿXäalence)“is“used“to“determine“whic˜hŽ¡‘Çapairs–ê¨of“terms“in“Ó{r1,...,rn}“Öare“equal.ŽŸ ¢>‘ÇaâExampleŽŸ(‘ÇaÖThe–Yfolloš¬rwing“is“a“v˜ery“simple“example“in“whic˜h“ÓREFL‘/Öis“used“to“construct“the“result“ofŽ¡‘Çaapplying–the“function“Óf“Öto“eacš¬rh“elemen˜t“of“the“set“Ó{1,2,1,4}Ö,‘¡hand“ÓNO_CONV‘Öis“the“suppliedŽ¡‘Ça`equalit•¬ry‘ê¨con“v“ersion'.Ž¦‘$_Ó#IMAGE_CONV–¿ªREFL“NO_CONV“"IMAGE“(f:num->num)“{1,2,1,4}";;ŽŸ ™š‘$_|-–¿ªIMAGE“f{1,2,1,4}“=“{f“2,f“1,f“4}ŽŸy®‘ÇaÖThe–dresult“conš¬rtains“only“one“oSŽccurrence“of“`Óf‘¿ª1Ö',‘ev˜en“though“ÓNO_CONV‘^Öalw˜a˜ys“fails,‘sinceŽ¡‘ÇaÓIMAGE_CONV‘âÑÖsimpli es–ãthe“resulting“set“bš¬ry“remo˜ving“elemen˜ts“that“are“redundan˜t“up“toŽ¡‘Çaalpha-equiv‘ÿXäalence.ŽŸ(‘(ðF‘ÿVor–­xthe“next“example,‘¹µwš¬re“construct“a“con˜v˜ersion“that“maps“ÓSUC‘¿ªn“Öfor“an˜y“n˜umeral“Ón“ÖtoŽ¡‘Çathe–ê¨n¬rumeral“standing“for“the“successor“of“ÓnÖ.Ž¦‘$_Ó#let–¿ªSUC_CONV“tm“=Ž¤ ™š‘@ılet–¿ªn“=“int_of_string(fst(dest_const(rand“tm)))“inŽ¡‘@ılet–¿ªsucn“=“mk_const(string_of_int(n+1),“":num")“inŽ¡‘WÃYSYM–¿ª(num_CONV“sucn);;Ž¡‘$_SUC_CONV–¿ª=“-“:“convŽŸy®‘ÇaÖThe–ê¨result“is“a“con•¬rv“ersion–ê¨that“in•¬rv“erts‘ê¨Ónum_CONVÖ:Ž¦‘$_Ó#num_CONV‘¿ª"4";;Ž¡‘$_|-–¿ª4“=“SUC“3ŽŸ34‘$_#SUC_CONV–¿ª"SUC“3";;Ž¡‘$_|-–¿ªSUC“3“=“4ŽŸy®‘ÇaÖThe›<þcon•¬rv“ersion˜ÓSUC_CONV‘<ÑÖcan˜then˜bSŽe˜used˜to˜compute˜the˜image˜of˜the˜successor˜functionŽŽŽŒ‹½ ÌU ýFÓŸú™š‘êñëÛ22’ÅëEChapter–€2.‘ €ML“F‘þàunctions“in“the“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖon–ê¨a“ nite“set:Ž©*s‘ü0éÓ#IMAGE_CONV–¿ªSUC_CONV“NO_CONV“"IMAGE“SUC“{1,2,1,4}";;ŽŸ ™š‘ü0é|-–¿ªIMAGE“SUC{1,2,1,4}“=“{3,2,5}ŽŸÙ‘êñëÖNote–ê¨that“Ó2“Ö(=“ÓSUC‘¿ª1Ö)“appSŽears“only“once“in“the“resulting“set.Ž¤‘öSzFianlly‘ÿV,‘dhere–­¥is“an“example“of“using“ÓIMAGE_CONV‘­1Öto“compute“the“image“of“a“pairedŽ¡‘êñëaddition–ê¨function“on“a“set“of“pairs“of“n•¬rum“bSŽers:Ž¦‘ü0éÓ#IMAGE_CONV–¿ª(PAIRED_BETA_CONV“THENC“ADD_CONV)“num_EQ_CONVŽ¤ ™š‘A,á"IMAGE–¿ª(\(n,m).n+m)“{(1,2),“(3,4),“(0,3),“(1,3)}";;Ž¡‘ü0é|-–¿ªIMAGE(\(n,m).“n“+“m){(1,2),(3,4),(0,3),(1,3)}“=“{7,3,4}ŽŸ&²‹‘êñëâF‘þž¸ailureŽ¤‘êñëÓIMAGE_CONV–¿ªconv1“conv2–þÖfails“if“applied“to“a“term“not“of“the“form“Ó"IMAGE–¿ªf“{t1,...,tn}"Ö.Ž¡‘êñëAn–Ö´application“of“ÓIMAGE_CONV–¿ªconv1“conv2–Ö´Öto“a“term“Ó"IMAGE–¿ªf“{t1,...,tn}"–Ö´Öfails“unlessŽ¡‘êñëfor–5all“Óti“Öin“the“set“Ó{t1,...,tn}Ö,‘‡´ev‘ÿXäaluating“Óconv1–¿ª"f“ti"–5Öreturns“Ó|-–¿ª(f“ti)“=“ri‘5ÖforŽ¡‘êñësome‘ê¨ÓriÖ.ŽŸ&eŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëLINSERT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ-­¼‘êñëÓINSERT_CONV–¿ª:“conv“->“convŽ©!²‘êñëâSynopsisŽ¡‘êñëÖReduce›ê¨Óx–¿ªINSERT“{x1,...,x,...,xn}˜Öto˜Ó{x1,...,x,...,xn}Ö.Ž¦‘êñëâDescriptionŽ¡‘êñëÖThe–Üfunction“ÓINSERT_CONV‘ŒÖis“a“parameterized“con•¬rv“ersion–Üfor“reducing“ nite“sets“of“theŽ¡‘êñëform›¶ÛÓ"t–¿ªINSERT“{t1,...,tn}"Ö,‘Á7where˜Ó{t1,...,tn}˜Öis˜a˜set˜of˜t¬rypSŽe˜Ó(ty)set˜Öand˜Ót˜Öis˜equalŽ¡‘êñëto–±some“elemenš¬rt“Óti“Öof“this“set.‘fThe“ rst“argumen˜t“to“ÓINSERT_CONV‘±LÖis“expšSŽected“to“b˜e“aŽ¡‘êñëcon•¬rv“ersion–Wtthat“decides“equalitš¬ry“bSŽet˜w˜een“v‘ÿXäalues“of“the“base“t˜ypSŽe“ÓtyÖ.‘DGiv˜en“an“equationŽ¡‘êñëÓ"e1–¿ª=“e2"Ö,›÷where–º=Óe1“Öand“Óe2“Öare“terms“of“t¬rypSŽe“ÓtyÖ,˜this“con•¬rv“ersion–º=should“return“the“theoremŽ¡‘êñëÓ|-–¿ª(e1“=“e2)“=“T–ê¨Öor“the“theorem“Ó|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.Ž¡‘öSzGiv•¬ren›½»suc“h˜a˜con“v“ersion,‘òthe˜function˜ÓINSERT_CONV‘½„Öreturns˜a˜con“v“ersion˜that˜maps˜aŽ¡‘êñëterm–ê¨of“the“form“Ó"t–¿ªINSERT“{t1,...,tn}"–ê¨Öto“the“theoremŽŸ*s‘ü0éÓ|-–¿ªt“INSERT“{t1,...,tn}“=“{t1,...,tn}ŽŸÙ‘êñëÖif–îyÓt“Öis“alpha-equiv‘ÿXäalenš¬rt“to“an˜y“Óti“Öin“the“set“Ó{t1,...,tn}Ö,‘/mor“if“the“supplied“con˜v˜ersionŽ¡‘êñëpro•¬rv“es›ê¨Ó|-–¿ª(t“=“ti)“=“T˜Öfor˜an¬ry˜ÓtiÖ.ŽŽŽŒ‹&p ÌU ýFÓŸú™š‘ÇaÒINSER‘þó\T‘Ái‰ffÇŽ‘ˆ„CONV’`:)Û23Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽ©«‘ÇaÖIn–Uthe“folloš¬rwing“example,‘rïthe“con˜v˜ersion“Ónum_EQ_CONV‘TÛÖis“supplied“as“a“parameter“and“usedŽ¤‘Çato–ê¨test“equalitš¬ry“of“the“inserted“v‘ÿXäalue“Ó2“Öwith“the“remaining“elemen˜ts“of“the“set.ŽŸE›‘$_Ó#INSERT_CONV–¿ªnum_EQ_CONV“"2“INSERT“{1,SUC“1,3}";;ŽŸ ™š‘$_|-–¿ª{2,1,SUC“1,3}“=“{1,SUC“1,3}ŽŸ‘ÇaÖIn–^Çthis“example,‘»Îthe“supplied“con•¬rv“ersion–^ÇÓnum_EQ_CONV‘^gÖis“able“to“pro•¬rv“e–^Çthat“Ó2“Öis“equalŽ¡‘Çato–}HÓSUC›¿ª1“Öand“the“set“is“therefore“reduced.‘ ð¿Note“that“Ó"2˜INSERT˜{1,SUC˜1,3}"“Öis“justŽ¡‘ÇaÓ"{2,1,SUC‘¿ª1,3}"Ö.Ž¦‘(ðA› Öcall– Þto“ÓINSERT_CONV˜Öfails“when“the“v›ÿXäalue“bSŽeing“inserted“is“pro¬rv˜ably“not“equal“to“an¬ryŽ¡‘Çaof–ê¨the“remaining“elemen¬rts:ŽŸE›‘$_Ó#INSERT_CONV–¿ªnum_EQ_CONV“"1“INSERT“{2,3}";;ŽŸ ™š‘$_evaluation‘¿ªfailed‘¾RINSERT_CONVŽŸ‘ÇaÖBut–ê¨this“failure“can,“if“desired,“bSŽe“caugh¬rt“using“ÓTRY_CONVÖ.Ž¦‘(ðThe–|ùbSŽehaš¬rviour“of“the“supplied“con˜v˜ersion“is“irrelev‘ÿXäan˜t“when“the“inserted“v‘ÿXäalue“is“alpha-Ž¡‘Çaequiv‘ÿXäalenš¬rt–ê¨to“one“of“the“remaining“elemen˜ts:ŽŸE›‘$_Ó#INSERT_CONV–¿ªNO_CONV“"(y:*)“INSERT“{x,y,z}";;ŽŸ ™š‘$_|-–¿ª{y,x,y,z}“=“{x,y,z}ŽŸ‘ÇaÖThe›µ‰con•¬rv“ersion˜ÓNO_CONV‘µUÖalw“a“ys˜fails,‘èBbut˜ÓINSERT_CONV‘µUÖis˜non“theless˜able˜in˜this˜case˜toŽ¡‘Çapro•¬rv“e–ê¨the“required“result.Ž¦‘(ðNote–)Òthat“ÓDEPTH_CONV(INSERT_CONV‘¿ªconv)“Öcan“bSŽe“used“to“remo•¬rv“e–)Òduplicate“elemen¬rtsŽ¡‘Çafrom–ê¨a“ nite“set,“but“the“folloš¬rwing“con˜v˜ersion“is“faster:ŽŸE›‘$_Ó#letrec–¿ªREDUCE_CONV“conv“tm“=Ž¤ ™š‘5E](SUB_CONV–¿ª(REDUCE_CONV“conv)“THENC“(TRY_CONV“(INSERT_CONV“conv)))“tm;;Ž¡‘$_REDUCE_CONV–¿ª=“-“:“(conv“->“conv)ŽŸ34‘$_#REDUCE_CONV–¿ªnum_EQ_CONV“"{1,2,1,3,2,4,3,5,6}";;Ž¡‘$_|-–¿ª{1,2,1,3,2,4,3,5,6}“=“{1,2,4,3,5,6}ŽŸ,‘ÇaâF‘þž¸ailureŽ¦‘ÇaÓINSERT_CONV›¿ªconv–@Öfails“if“applied“to“a“term“not“of“the“form“Ó"t˜INSERT˜{t1,...,tn}"Ö.‘95AŽ¤‘Çacall›ŽÓINSERT_CONV–¿ªconv“"t“INSERT“{t1,...,tn}"˜Öfails˜unless˜Ót˜Öis˜alpha-equiv‘ÿXäalen¬rt˜to˜someŽ¡‘ÇaÓtiÖ,–ê¨or“Óconv–¿ª"t“=“ti"–ê¨Öreturns“Ó|-–¿ª(t“=“ti)“=“T–ê¨Öfor“some“ÓtiÖ.ŽŸ¬‘ÇaâSee‘…alsoŽŸDš‘ÇaÓDELETE_CONV.ŽŽŽŒ‹0 ÌU ýFÓŸú™š‘êñëÛ24’ÅëEChapter–€2.‘ €ML“F‘þàunctions“in“the“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëLIN_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ4€‘êñëÓIN_CONV–¿ª:“conv“->“convŽ¤çÜ‘êñëâSynopsisŽ©¹÷‘êñëÖDecision–ê¨prošSŽcedure“for“mem¬rb˜ership“in“ nite“sets.Ž¡‘êñëâDescriptionŽ¦‘êñëÖThe–20function“ÓIN_CONV‘2Öis“a“parameterized“con•¬rv“ersion–20for“proš¬rving“or“dispro˜ving“mem˜bSŽershipŽ¤‘êñëassertions–ê¨of“the“general“form:ŽŸv‘ü0éÓ"t–¿ªIN“{t1,...,tn}"ŽŸ-å‘êñëÖwhere–á­Ó{t1,...,tn}“Öis“a“set“of“tš¬rypSŽe“Ó(ty)set“Öand“Ót“Öis“a“v‘ÿXäalue“of“the“base“t˜ypSŽe“ÓtyÖ.‘ðTheŽ¡‘êñë rst–©¤argumen¬rt“to“ÓIN_CONV‘©sÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–©¤that“decides“equalit¬ry“b˜et•¬rw“eenŽ¡‘êñëv‘ÿXäalues–of“the“base“tš¬rypSŽe“ÓtyÖ.‘×dGiv˜en“an“equation“Ó"e1–¿ª=“e2"Ö,‘l´where–Óe1“Öand“Óe2“Öare“termsŽ¡‘êñëof–Xñtš¬rypSŽe“ÓtyÖ,‘tƒthis“con˜v˜ersion“should“return“the“theorem“Ó|-–¿ª(e1“=“e2)“=“T‘XÔÖor–Xñthe“theoremŽ¡‘êñëÓ|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.Ž¦‘öSzGiv•¬ren›KÀsuc“h˜a˜con“v“ersion,‘dthe˜function˜ÓIN_CONV‘K§Öreturns˜a˜con“v“ersion˜that˜maps˜a˜termŽ¡‘êñëof–ê¨the“form“Ó"t–¿ªIN“{t1,...,tn}"–ê¨Öto“the“theoremŽ©v‘ü0éÓ|-–¿ªt“IN“{t1,...,tn}“=“TŽŸ-å‘êñëÖif–:ãÓt“Öis“alpha-equiv‘ÿXäalenš¬rt“to“an˜y“ÓtiÖ,‘^ or“if“the“supplied“con˜v˜ersion“pro˜v˜es“Ó|-–¿ª(t“=“ti)“=“T‘:¶ÖforŽ¡‘êñëanš¬ry–™ÓtiÖ.‘ªIf“the“supplied“con˜v˜ersion“pro˜v˜es“Ó|-–¿ª(t“=“ti)“=“F‘˜ðÖfor–™ev˜ery“ÓtiÖ,‘©Ythen“the“result“isŽ¡‘êñëthe‘ê¨theoremŽ¦‘ü0éÓ|-–¿ªt“IN“{t1,...,tn}“=“FŽŸ-å‘êñëÖIn–ê¨all“other“cases,“ÓIN_CONV“Öwill“fail.ŽŸçÜ‘êñëâExampleŽŸ¹÷‘êñëÖIn–Uthe“folloš¬rwing“example,‘rïthe“con˜v˜ersion“Ónum_EQ_CONV‘TÛÖis“supplied“as“a“parameter“and“usedŽ¡‘êñëto–ê¨test“equalitš¬ry“of“the“candidate“elemen˜t“Ó1“Öwith“the“actual“elemen˜ts“of“the“giv˜en“set.Ž¦‘ü0éÓ#IN_CONV–¿ªnum_EQ_CONV“"2“IN“{0,SUC“1,3}";;ŽŸ ™š‘ü0é|-–¿ª2“IN“{0,SUC“1,3}“=“TŽŸ-å‘êñëÖThe–yresult“is“ÓT›xäÖbSŽecause“Ónum_EQ_CONV˜Öis“able“to“pro•¬rv“e–ythat“Ó2“Öis“equal“to“ÓSUC‘¿ª1Ö.‘þAn“exampleŽŽŽŒ‹9: ÌU ýFÓŸú™š‘ÇaÒSET‘Ái‰ffÇŽ–ˆ„INDUCT‘Ái‰ffÇŽ“T‘þó\A¦tC’J×ÞÛ25Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖof–ê¨a“negativ¬re“result“is:Ž¤b£‘$_Ó#IN_CONV–¿ªnum_EQ_CONV“"1“IN“{0,2,3}";;Ž© ™š‘$_|-–¿ª1“IN“{0,2,3}“=“FŽŸÖÆ‘ÇaÖFinally–²the“bSŽehaš¬rviour“of“the“supplied“con˜v˜ersion“is“irrelev‘ÿXäan˜t“when“the“v‘ÿXäalue“to“bSŽe“testedŽŸ‘Çafor–ê¨memš¬rbSŽership“is“alpha-equiv‘ÿXäalen˜t“to“an“actual“elemen˜t:Ž¡‘$_Ó#IN_CONV–¿ªNO_CONV“"1“IN“{3,2,1}";;Ž¦‘$_|-–¿ª1“IN“{3,2,1}“=“TŽŸÖÆ‘ÇaÖThe› žcon•¬rv“ersion˜ÓNO_CONV‘ •Öalw“a“ys˜fails,‘Ûbut˜ÓIN_CONV‘ •Öis˜non“theless˜able˜in˜this˜case˜to˜pro“v“eŽ¤‘Çathe–ê¨required“result.Ž©É ‘ÇaâF‘þž¸ailureŽŸòB‘ÇaÓIN_CONV›¿ªconv–ÀáÖfails“if“applied“to“a“term“that“is“not“of“the“form“Ó"t˜IN˜{t1,...,tn}"Ö.‘»ŒAŽ¡‘Çacall›fÓIN_CONV–¿ªconv“"t“IN“{t1,...,tn}"˜Öfails˜unless˜the˜term˜Ót˜Öis˜alpha-equiv‘ÿXäalen¬rt˜to˜someŽ¡‘ÇaÓtiÖ,‘öor›\Óconv–¿ª"t“=“ti"˜Öreturns˜Ó|-“(t“=“ti)“=“T‘ŒðÖfor˜some˜ÓtiÖ,‘öor˜Óconv“"t“=“ti"˜ÖreturnsŽ¡‘ÇaÓ|-–¿ª(t“=“ti)“=“F–ê¨Öfor“ev¬rery“ÓtiÖ.ŽŸ4[Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëLSET_INDUCT_TACŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ6 (‘ÇaÓSET_INDUCT_TAC–¿ª:“tacticŽ¦‘ÇaâSynopsisŽ¤òB‘ÇaÖT‘ÿVactic–ê¨for“induction“on“ nite“sets.Ž¦‘ÇaâDescriptionŽ¡‘ÇaÓSET_INDUCT_TAC‘:ÁÖis–:Õan“induction“tacic“for“pro¬rving“propSŽerties“of“ nite“sets.‘)hWhen“appliedŽ¤‘Çato–ê¨a“goal“of“the“formŽŸb£‘$_Ó!s:(*)set.‘¿ªP[s]ŽŸÖÆ‘ÇaSET_INDUCT_TAC‘+ÅÖreduces–+öthis“goal“to“proš¬rving“that“the“propSŽert˜y“Ó\s.P[s]“Öholds“of“the“empt˜yŽ¡‘Çaset–•¹and“is“preservš¬red“b˜y“insertion“of“an“elemen˜t“in˜to“an“arbitrary“ nite“set.‘:Since“ev˜eryŽ¡‘Ça nite–4tset“can“bSŽe“built“up“from“the“emptš¬ry“set“Ó"{}"“Öb˜y“repSŽeated“insertion“of“v‘ÿXäalues,‘FçtheseŽ¡‘Çasubgoals–ê¨imply“that“the“propSŽert¬ry“Ó\s.P[s]“Öholds“of“all“ nite“sets.ŽŽŽŒ‹A¯ ÌU ýFÓŸú™š‘êñëÛ26’ÅëEChapter–€2.‘ €ML“F‘þàunctions“in“the“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖThe–ê¨tactic“spSŽeci cation“of“ÓSET_INDUCT_TAC“Öis:ŽŸš‚‘z©…ÓA–¿ª?-“!s.PŽ¤ ™š‘ü0é==================================================‘ TSET_INDUCT_TACŽ¡‘°=A–¿ª|-“P[{}/s]Ž¡‘°=A–¿ªu“{P[s'/s],“~e“IN“s'}“?-“P[e“INSERT“s'/s]ŽŸ®‘êñëÖwhere–ÞÓe“Öis“a“v‘ÿXäariable“c¬rhosen“so“as“not“to“appSŽear“free“in“the“assumptions“ÓAÖ,“and“Ós'“Öis“aŽ¤‘êñëprimed–ê¨v‘ÿXäarian¬rt“of“Ós“Öthat“došSŽes“not“app˜ear“free“in“ÓA“Ö(usually‘ÿV,“Ós'“Öis“just“ÓsÖ).Ž©è‘êñëâF‘þž¸ailureŽŸ:‘êñëÓSET_INDUCT_TAC‘¿ª(A,g)–7ýÖfails“unless“Óg“Öhas“the“form“Ó!s.PÖ,“where“the“v‘ÿXäariable“Ós“Öhas“t¬rypSŽeŽ¡‘êñëÓ(ty)set–ê¨Öfor“some“t¬rypSŽe“ÓtyÖ.ŽŸ)¸Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëLUNION_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ/kï‘êñëÓUNION_CONV–¿ª:“conv“->“convŽ¦‘êñëâSynopsisŽ¤:‘êñëÖReduce›ê¨Ó{t1,...,tn}–¿ªUNION“s˜Öto˜Ót1“INSERT“(...“(tn“INSERT“s))Ö.Ž¦‘êñëâDescriptionŽ¡‘êñëÖThe–Ê@function“ÓUNION_CONV‘ÉÅÖis“a“parameterized“con•¬rv“ersion–Ê@for“reducing“sets“of“the“formŽ¤‘êñëÓ"{t1,...,tn}–¿ªUNION“s"Ö,‘¡‰where–IÂÓ{t1,...,tn}“Öand“Ós“Öare“sets“of“t¬rypSŽe“Ó(ty)setÖ.‘ V/The“ rstŽ¡‘êñëargumen¬rt–NMto“ÓUNION_CONV‘MòÖis“expšSŽected“to“b˜e“a“con•¬rv“ersion–NMthat“decides“equalit¬ry“b˜et•¬rw“eenŽ¡‘êñëv‘ÿXäalues–of“the“base“tš¬rypSŽe“ÓtyÖ.‘×dGiv˜en“an“equation“Ó"e1–¿ª=“e2"Ö,‘l´where–Óe1“Öand“Óe2“Öare“termsŽ¡‘êñëof–Xñtš¬rypSŽe“ÓtyÖ,‘tƒthis“con˜v˜ersion“should“return“the“theorem“Ó|-–¿ª(e1“=“e2)“=“T‘XÔÖor–Xñthe“theoremŽ¡‘êñëÓ|-–¿ª(e1“=“e2)“=“FÖ,–ê¨as“appropriate.ŽŸ:‘öSzGiv•¬ren›5àsuc“h˜a˜con“v“ersion,‘ˆ®the˜function˜ÓUNION_CONV‘5‹Öreturns˜a˜con“v“ersion˜that˜maps˜aŽ¡‘êñëterm–ê¨of“the“form“Ó"{t1,...,tn}–¿ªUNION“s"–ê¨Öto“the“theoremŽŸš‚‘ü0éÓ|-–¿ªt“UNION“{t1,...,tn}“=“ti“INSERT“...“(tj“INSERT“s)ŽŸ®‘êñëÖwhere–ËÓ{ti,...,tj}“Öis“the“set“of“all“terms“Ót“Öthat“oSŽccur“as“elemen¬rts“of“Ó{t1,...,tn}“ÖforŽ¡‘êñëwhicš¬rh–oÎthe“con˜v˜ersion“ÓIN_CONV‘¿ªconv“Öfails“to“pro˜v˜e“that“Ó|-–¿ª(t“IN“s)“=“T‘o¯Ö(that–oÎis,‘ˆ`either“b˜yŽ¡‘êñëpro¬rving›ê¨Ó|-–¿ª(t“IN“s)“=“F˜Öinstead,˜or˜b•¬ry˜failing˜outrigh“t).Ž¦‘êñëâExampleŽŸ:‘êñëÖIn–vthe“follo¬rwing“example,‘hÓnum_EQ_CONV›uûÖis“supplied“as“a“parameter“to“ÓUNION_CONV˜Öand“usedŽ¡‘êñëto–)#test“for“memš¬rbSŽership“of“eac˜h“elemen˜t“of“the“ rst“ nite“set“Ó{1,2,3}“Öof“the“union“in“theŽŽŽŒ‹IV ÌU ýFÓŸú™š‘ÇaÒUNION‘Ái‰ffÇŽ‘ˆ„CONV’c¦%Û27Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖsecond–ê¨ nite“set“Ó{SUC‘¿ª0,3,4}Ö.Ž¤™š‘$_Ó#UNION_CONV–¿ªnum_EQ_CONV“"{1,2,3}“UNION“{SUC“0,3,4}";;ŽŸ ™š‘$_|-–¿ª{1,2,3}“UNION“{SUC“0,3,4}“=“{2,SUC“0,3,4}Ž©‘ÇaÖThe–j7result“is“Ó{2,SUC›¿ª0,3,4}Ö,‘ƒçrather“than“Ó{1,2,SUC˜0,3,4}Ö,‘ƒçbSŽecause“ÓUNION_CONV‘jÖis“able“b¬ryŽŸ‘Çameans–ê¨of“a“call“toŽ¡‘$_ÓIN_CONV–¿ªnum_EQ_CONV“"1“IN“{SUC“0,3,4}"Ž¦‘ÇaÖto›ê¨pro•¬rv“e˜that˜Ó1˜Öis˜already˜an˜elemen“t˜of˜the˜set˜Ó{SUC‘¿ª0,3,4}Ö.Ž¤‘(ðThe›Ýïcon•¬rv“ersion˜supplied˜to˜ÓUNION_CONV‘ÝëÖneed˜not˜actually˜pro“v“e˜equalit“y˜of˜elemen“ts,‘àzifŽ¡‘Çasimpli cation–ê¨of“the“resulting“set“is“not“desired.‘8àF‘ÿVor“example:ŽŸ™š‘$_Ó#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“{SUC“0,3,4}";;ŽŸ ™š‘$_|-–¿ª{1,2,3}“UNION“{SUC“0,3,4}“=“{1,2,SUC“0,3,4}Ž¦‘ÇaÖIn–£Êthis“case,›±öthe“resulting“set“is“just“left“unsimpli ed.‘!AMoreo•¬rv“er,˜the–£Êsecond“set“argumen¬rtŽ¡‘Çato–ê¨ÓUNION“Öneed“not“bSŽe“a“ nite“set:ŽŸ™š‘$_Ó#UNION_CONV–¿ªNO_CONV“"{1,2,3}“UNION“s";;ŽŸ ™š‘$_|-–¿ª{1,2,3}“UNION“s“=“1“INSERT“(2“INSERT“(3“INSERT“s))Ž¦‘ÇaÖAnd,–ê¨of“course,“in“this“case“the“con•¬rv“ersion›ê¨argumen“t˜to˜ÓUNION_CONV˜Öis˜irrelev‘ÿXäan“t.Ž¦‘ÇaâF‘þž¸ailureŽ¡‘ÇaÓUNION_CONV›¿ªconv–ê¨Öfails“if“applied“to“a“term“not“of“the“form“Ó"{t1,...,tn}˜UNION˜s"Ö.Ž¦‘ÇaâSee‘…alsoŽŸ ™š‘ÇaÓIN_CONV.ŽŽŽŒ‹S ÌU ýFÓŸú™š‘êñëÛ28’ÅëEChapter–€2.‘ €ML“F‘þàunctions“in“the“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹XÑ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…3Ž‘ÇaŸ Ì̉Ç>|ŸGëHPre-pro–ÿ4‰v“ed‘ ‰‹TheoremsŽŸÖx‰Ç>|Ÿ:UTÖThe–OMsections“that“follo¬rw“list“all“theorems“in“the“Ófinite_setsŽ‘EÚèÖlibrary‘ÿV,‘n_including“de nitions.Ž¤The–dtheorems“are“groupSŽed“in¬rto“sections“according“to“sub‘§ject“matter.‘ ¦¾Some“theoremsŽ¡could–ƒbSŽe“classi ed“under“more“than“one“sub‘§ject,‘©but“eac¬rh“theorem“is“listed“in“only“oneŽ¡section.‘2The–Ö]reader“maš¬ry“therefore“ha˜v˜e“to“consult“more“than“one“section“when“searc˜hingŽ¡for–ê¨an¬ry“particular“theorem.Ž¡‘ aWhen–„×the“Ófinite_setsŽ‘FEüÖlibrary“is“loaded,‘™4all“the“theorems“listed“in“this“c¬rhapter“(includ-Ž¡ing–ê¨de nitions)“are“set“up“to“autoload“when“their“names“are“men¬rtioned“in“ÍMLÖ.ŽŸ(Vç3.1Ž‘-C„The–Ÿ¼t‘ÿr°yp‘Oe“de nitionŽŸ'C²ÓFINITE_SET_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘9óÓ|-–¿ª(!x.“~x“IN“{})“/\Ž¡‘xñ(!x–¿ªy“s.“x“IN“(y“INSERT“s)“=“(x“=“y)“\/“x“IN“s)“/\Ž¡‘xñ(!x–¿ªs.“x“INSERT“(x“INSERT“s)“=“x“INSERT“s)“/\Ž¡‘xñ(!x–¿ªy“s.“x“INSERT“(y“INSERT“s)“=“y“INSERT“(x“INSERT“s))“/\Ž¡‘xñ(!P.–¿ªP{}“/\“(!s.“P“s“==>“(!e.“P(e“INSERT“s)))“==>“(!s.“P“s))Ž©aIS_SET_REP‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘9óÓ|-–¿ªIS_SET_REP(\x.“F)“/\Ž¡‘xñ(!s.–¿ªIS_SET_REP“s“==>“(!x.“IS_SET_REP(\y.“(y“=“x)“\/“s“y)))“/\Ž¡‘xñ(!P.Ž¡‘*øEP(\x.–¿ªF)“/\“(!t.“P“t“==>“(!x.“P(\y.“(y“=“x)“\/“t“y)))“==>Ž¡‘*øE(!s.–¿ªIS_SET_REP“s“==>“P“s))Ž¦set_TY_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘9óÓ|-–¿ª?rep.“TYPE_DEFINITION“IS_SET_REP“repŽŸ(Vç3.2Ž‘-C„Basic–Ÿ¼prop‘Oerties“of“ëJEMPTYç,“ëJINSERTç,“and“ëJINŽŸ'C²ÓABSORPTION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘9óÓ|-–¿ª!x“s.“x“IN“s“=“(x“INSERT“s“=“s)ŽŽŸ$ý’烈Û29ŽŽŒ‹Yi ÌU ýFÓŸú™š‘êñëÛ30’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓCOMPONENT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!x“s.“x“IN“(x“INSERT“s)Ž©'b‘êñëDECOMPOSITION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x.“x“IN“s“=“(?t.“(s“=“x“INSERT“t)“/\“~x“IN“t)Ž¦‘êñëEXTENSION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“(s“=“t)“=“(!x.“x“IN“s“=“x“IN“t)Ž¦‘êñëINSERT_COMM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y“s.“x“INSERT“(y“INSERT“s)“=“y“INSERT“(x“INSERT“s)Ž¦‘êñëINSERT_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“x“INSERT“(x“INSERT“s)“=“x“INSERT“sŽ¦‘êñëIN_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y“s.“x“IN“(y“INSERT“s)“=“(x“=“y)“\/“x“IN“sŽ¦‘êñëMEMBER_NOT_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“(?x.“x“IN“s)“=“~(s“=“{})Ž¦‘êñëNOT_EMPTY_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~({}“=“x“INSERT“s)Ž¦‘êñëNOT_EQUAL_SETS‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“~(s“=“t)“=“(?x.“x“IN“t“=“~x“IN“s)Ž¦‘êñëNOT_INSERT_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~(x“INSERT“s“=“{})Ž¦‘êñëNOT_IN_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“~x“IN“{}Ž¦‘êñëNUM_SET_WOP‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“(?n.“n“IN“s)“=“(?n.“n“IN“s“/\“(!m.“m“IN“s“==>“n“<=“m))Ž¦‘êñëSET_CASES‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“(s“=“{})“\/“(?x“t.“(s“=“x“INSERT“t)“/\“~x“IN“t)Ž¦‘êñëSET_INDUCT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-‘¿ª!P.Ž¡‘*†P{}–¿ª/\“(!s.“P“s“==>“(!e.“~e“IN“s“==>“P(e“INSERT“s)))“==>“(!s.“P“s)Ž¦‘êñëSET_MINIMUM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“M.“(?x.“x“IN“s)“=“(?x.“x“IN“s“/\“(!y.“y“IN“s“==>“(M“x)“<=“(M“y)))ŽŽŽŒ‹`R ÌU ýFÓŸú™š‘ÇaÛ3.3.‘ €Set‘€inclusion’Oe31Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç3.3Ž‘@ åSet‘Ÿ¼inclusionŽŸ*©r‘ÇaÓEMPTY_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘!TÓ|-–¿ª!s.“{}“SUBSET“sŽ©Rô‘ÇaINSERT_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.“(x“INSERT“s)“SUBSET“t“=“x“IN“t“/\“s“SUBSET“tŽ¦‘ÇaNOT_PSUBSET_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“~s“PSUBSET“{}Ž¦‘ÇaPSUBSET_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“PSUBSET“t“=“s“SUBSET“t“/\“~(s“=“t)Ž¦‘ÇaPSUBSET_INSERT_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“PSUBSET“t“=“(?x.“~x“IN“s“/\“(x“INSERT“s)“SUBSET“t)Ž¦‘ÇaPSUBSET_IRREFL‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“~s“PSUBSET“sŽ¦‘ÇaPSUBSET_MEMBER‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“PSUBSET“t“=“s“SUBSET“t“/\“(?y.“y“IN“t“/\“~y“IN“s)Ž¦‘ÇaPSUBSET_TRANS‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“s“PSUBSET“t“/\“t“PSUBSET“u“==>“s“PSUBSET“uŽ¦‘ÇaSUBSET_ANTISYM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“SUBSET“t“/\“t“SUBSET“s“==>“(s“=“t)Ž¦‘ÇaSUBSET_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“SUBSET“t“=“(!x.“x“IN“s“==>“x“IN“t)Ž¦‘ÇaSUBSET_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“SUBSET“{}“=“(s“=“{})Ž¦‘ÇaSUBSET_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x“s.“~x“IN“s“==>“(!t.“s“SUBSET“(x“INSERT“t)“=“s“SUBSET“t)Ž¦‘ÇaSUBSET_REFL‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“SUBSET“sŽ¦‘ÇaSUBSET_TRANS‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“s“SUBSET“t“/\“t“SUBSET“u“==>“s“SUBSET“uŽŽŽŒ‹ gŒ ÌU ýFÓŸú™š‘êñëÛ32’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç3.4Ž‘5oIn‘ÿr°tersection–Ÿ¼and“unionŽŸ'C²‘êñëÓDELETE_INTER‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s“t“x.“(s“DELETE“x)“INTER“t“=“(s“INTER“t)“DELETE“xŽ©a‘êñëEMPTY_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“(s“UNION“t“=“{})“=“(s“=“{})“/\“(t“=“{})Ž¦‘êñëINSERT_INTER‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.Ž¡‘*†(x–¿ªINSERT“s)“INTER“t“=“(x“IN“t“=>“x“INSERT“(s“INTER“t)“|“s“INTER“t)Ž¦‘êñëINSERT_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.Ž¡‘*†(x–¿ªINSERT“s)“UNION“t“=“(x“IN“t“=>“s“UNION“t“|“x“INSERT“(s“UNION“t))Ž¦‘êñëINSERT_UNION_EQ‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.“(x“INSERT“s)“UNION“t“=“x“INSERT“(s“UNION“t)Ž¦‘êñëINTER_ASSOC‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“u.“(s“INTER“t)“INTER“u“=“s“INTER“(t“INTER“u)Ž¦‘êñëINTER_COMM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“INTER“t“=“t“INTER“sŽ¦‘êñëINTER_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!s.“{}“INTER“s“=“{})“/\“(!s.“s“INTER“{}“=“{})Ž¦‘êñëINTER_IDEMPOT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“s“INTER“s“=“sŽ¦‘êñëINTER_OVER_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“u.“s“UNION“(t“INTER“u)“=“(s“UNION“t)“INTER“(s“UNION“u)Ž¦‘êñëINTER_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª(!s“t.“(s“INTER“t)“SUBSET“s)“/\“(!s“t.“(t“INTER“s)“SUBSET“s)Ž¦‘êñëIN_INTER‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“x.“x“IN“(s“INTER“t)“=“x“IN“s“/\“x“IN“tŽ¦‘êñëIN_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“x.“x“IN“(s“UNION“t)“=“x“IN“s“\/“x“IN“tŽ¦‘êñëSUBSET_INTER_ABSORPTION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“SUBSET“t“=“(s“INTER“t“=“s)ŽŽŽŒ‹!nJ ÌU ýFÓŸú™š‘ÇaÛ3.5.‘ Set‘€di erence’K·a33Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓSUBSET_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘!TÓ|-–¿ª(!s“t.“s“SUBSET“(s“UNION“t))“/\“(!s“t.“s“SUBSET“(t“UNION“s))Ž©a‘ÇaSUBSET_UNION_ABSORPTION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“SUBSET“t“=“(s“UNION“t“=“t)Ž¦‘ÇaUNION_ASSOC‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“(s“UNION“t)“UNION“u“=“s“UNION“(t“UNION“u)Ž¦‘ÇaUNION_COMM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“s“UNION“t“=“t“UNION“sŽ¦‘ÇaUNION_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª(!s.“{}“UNION“s“=“s)“/\“(!s.“s“UNION“{}“=“s)Ž¦‘ÇaUNION_IDEMPOT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“UNION“s“=“sŽ¦‘ÇaUNION_OVER_INTER‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“s“INTER“(t“UNION“u)“=“(s“INTER“t)“UNION“(s“INTER“u)ŽŸ(V‘Çaç3.5Ž‘@ åSet‘Ÿ¼di erenceŽŸ'C²‘ÇaÓDIFF_DIFF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“(s“DIFF“t)“DIFF“t“=“s“DIFF“tŽ¦‘ÇaDIFF_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“DIFF“{}“=“sŽ¦‘ÇaDIFF_EQ_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“s“DIFF“s“=“{}Ž¦‘ÇaEMPTY_DIFF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“{}“DIFF“s“=“{}Ž¦‘ÇaIN_DIFF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t“x.“x“IN“(s“DIFF“t)“=“x“IN“s“/\“~x“IN“tŽŸ(V‘Çaç3.6Ž‘@ åDeletion–Ÿ¼of“an“elemen‘ÿr°tŽŸ'C²‘ÇaÓDELETE_COMM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x“y“s.“(s“DELETE“x)“DELETE“y“=“(s“DELETE“y)“DELETE“xŽŽŽŒ‹"uµ ÌU ýFÓŸú™š‘êñëÛ34’ðD,Chapter›€3.‘ €Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓDELETE_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s“x.“s“DELETE“x“=“s“DIFF“{x}Ž©a‘êñëDELETE_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“(s“DELETE“x)“DELETE“x“=“s“DELETE“xŽ¦‘êñëDELETE_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y“s.Ž¡‘*†(x–¿ªINSERT“s)“DELETE“y“=Ž¡‘*†((x–¿ª=“y)“=>“s“DELETE“y“|“x“INSERT“(s“DELETE“y))Ž¦‘êñëDELETE_NON_ELEMENT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“~x“IN“s“=“(s“DELETE“x“=“s)Ž¦‘êñëDELETE_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“(s“DELETE“x)“SUBSET“sŽ¦‘êñëDIFF_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t“x.“s“DIFF“(x“INSERT“t)“=“(s“DELETE“x)“DIFF“tŽ¦‘êñëEMPTY_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“{}“DELETE“x“=“{}Ž¦‘êñëINSERT_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“x“IN“s“==>“(x“INSERT“(s“DELETE“x)“=“s)Ž¦‘êñëIN_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x“y.“x“IN“(s“DELETE“y)“=“x“IN“s“/\“~(x“=“y)Ž¦‘êñëIN_DELETE_EQ‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x“x'.Ž¡‘*†(x–¿ªIN“s“=“x'“IN“s)“=“(x“IN“(s“DELETE“x')“=“x'“IN“(s“DELETE“x))Ž¦‘êñëSUBSET_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.“s“SUBSET“(t“DELETE“x)“=“~x“IN“s“/\“s“SUBSET“tŽ¦‘êñëSUBSET_INSERT_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s“t.“s“SUBSET“(x“INSERT“t)“=“(s“DELETE“x)“SUBSET“tŽŸ(V‘êñëç3.7Ž‘5oDisjoin‘ÿr°t‘Ÿ¼setsŽŸ'C²‘êñëÓDISJOINT_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“DISJOINT“s“t“=“(s“INTER“t“=“{})ŽŽŽŒ‹#| ÌU ýFÓŸú™š‘ÇaÛ3.8.‘ €The–€ÜCHOICE“Ûand“ÜREST“Ûfunctions’è.Ö35Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓDISJOINT_DELETE_SYM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘!TÓ|-–¿ª!s“t“x.“DISJOINT(s“DELETE“x)t“=“DISJOINT(t“DELETE“x)sŽ©a‘ÇaDISJOINT_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“DISJOINT“{}“s“/\“DISJOINT“s“{}Ž¦‘ÇaDISJOINT_EMPTY_REFL‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“(s“=“{})“=“DISJOINT“s“sŽ¦‘ÇaDISJOINT_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x“s“t.“DISJOINT(x“INSERT“s)t“=“DISJOINT“s“t“/\“~x“IN“tŽ¦‘ÇaDISJOINT_SYM‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“DISJOINT“s“t“=“DISJOINT“t“sŽ¦‘ÇaDISJOINT_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t“u.“DISJOINT(s“UNION“t)u“=“DISJOINT“s“u“/\“DISJOINT“t“uŽ¦‘ÇaIN_DISJOINT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“DISJOINT“s“t“=“~(?x.“x“IN“s“/\“x“IN“t)ŽŸ(V‘Çaç3.8Ž‘@ åThe–Ÿ¼ëJCHOICE“çand“ëJREST“çfunctionsŽŸ'C²‘ÇaÓCHOICE_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“~(s“=“{})“==>“(CHOICE“s)“IN“sŽ¦‘ÇaCHOICE_INSERT_REST‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“~(s“=“{})“==>“((CHOICE“s)“INSERT“(REST“s)“=“s)Ž¦‘ÇaCHOICE_NOT_IN_REST‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“~(CHOICE“s)“IN“(REST“s)Ž¦‘ÇaCHOICE_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x.“CHOICE{x}“=“xŽ¦‘ÇaREST_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“REST“s“=“s“DELETE“(CHOICE“s)Ž¦‘ÇaREST_PSUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“~(s“=“{})“==>“(REST“s)“PSUBSET“sŽ¦‘ÇaREST_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x.“REST{x}“=“{}ŽŽŽŒ‹$‚â ÌU ýFÓŸú™š‘êñëÛ36’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓREST_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!s.“(REST“s)“SUBSET“sŽ© œñ‘êñëSING_IFF_EMPTY_REST‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“SING“s“=“~(s“=“{})“/\“(REST“s“=“{})ŽŸ,çØ‘êñëç3.9Ž‘5oImage–Ÿ¼of“a“function“on“a“setŽŸ-Mð‘êñëÓIMAGE_COMPOSE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“g“s.“IMAGE(f“o“g)s“=“IMAGE“f(IMAGE“g“s)Ž¦‘êñëIMAGE_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“x“s.“~x“IN“s“==>“(IMAGE“f(s“DELETE“x)“=“IMAGE“f“s)Ž¦‘êñëIMAGE_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f.“IMAGE“f{}“=“{}Ž¦‘êñëIMAGE_EQ_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“f.“(IMAGE“f“s“=“{})“=“(s“=“{})Ž¦‘êñëIMAGE_ID‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“IMAGE(\x.“x)s“=“sŽ¦‘êñëIMAGE_IN‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“s.“x“IN“s“==>“(!f.“(f“x)“IN“(IMAGE“f“s))Ž¦‘êñëIMAGE_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“x“s.“IMAGE“f(x“INSERT“s)“=“(f“x)“INSERT“(IMAGE“f“s)Ž¦‘êñëIMAGE_INTER‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.“(IMAGE“f(s“INTER“t))“SUBSET“((IMAGE“f“s)“INTER“(IMAGE“f“t))Ž¦‘êñëIMAGE_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“t.“s“SUBSET“t“==>“(!f.“(IMAGE“f“s)“SUBSET“(IMAGE“f“t))Ž¦‘êñëIMAGE_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“t.“IMAGE“f(s“UNION“t)“=“(IMAGE“f“s)“UNION“(IMAGE“f“t)Ž¦‘êñëIN_IMAGE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!f“s“y.“y“IN“(IMAGE“f“s)“=“(?x.“(y“=“f“x)“/\“x“IN“s)ŽŽŽŒ‹%‰½ ÌU ýFÓŸú™š‘ÇaÛ3.10.‘ €Mappings›€b`et• w“een˜sets’ £37Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç3.10Ž‘IúMappings›Ÿ¼b‘Oet–ÿr°w“een˜setsŽŸ':*‘ÇaÓBIJ_COMPOSE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘!TÓ|-–¿ª!f“g“s“t“u.“BIJ“f“s“t“/\“BIJ“g“t“u“==>“BIJ(g“o“f)s“uŽ©X‘ÇaBIJ_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.“BIJ“f“s“t“=“INJ“f“s“t“/\“SURJ“f“s“tŽ¦‘ÇaBIJ_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f.“(!s.“BIJ“f{}s“=“(s“=“{}))“/\“(!s.“BIJ“f“s{}“=“(s“=“{}))Ž¦‘ÇaBIJ_ID‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“BIJ(\x.“x)s“sŽ¦‘ÇaIMAGE_SURJ‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.“SURJ“f“s“t“=“(IMAGE“f“s“=“t)Ž¦‘ÇaINJ_COMPOSE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“g“s“t“u.“INJ“f“s“t“/\“INJ“g“t“u“==>“INJ(g“o“f)s“uŽ¦‘ÇaINJ_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.Ž¡‘7ÿüINJ–¿ªf“s“t“=Ž¡‘7ÿü(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘7ÿü(!x–¿ªy.“x“IN“s“/\“y“IN“s“==>“(f“x“=“f“y)“==>“(x“=“y))Ž¦‘ÇaINJ_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f.“(!s.“INJ“f{}s)“/\“(!s.“INJ“f“s{}“=“(s“=“{}))Ž¦‘ÇaINJ_ID‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“INJ(\x.“x)s“sŽ¦‘ÇaLINV_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.“INJ“f“s“t“==>“(!x.“x“IN“s“==>“(LINV“f“s(f“x)“=“x))Ž¦‘ÇaRINV_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.“SURJ“f“s“t“==>“(!x.“x“IN“t“==>“(f(RINV“f“s“x)“=“x))Ž¦‘ÇaSURJ_COMPOSE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“g“s“t“u.“SURJ“f“s“t“/\“SURJ“g“t“u“==>“SURJ(g“o“f)s“uŽ¦‘ÇaSURJ_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!f“s“t.Ž¡‘7ÿüSURJ–¿ªf“s“t“=Ž¡‘7ÿü(!x.–¿ªx“IN“s“==>“(f“x)“IN“t)“/\Ž¡‘7ÿü(!x.–¿ªx“IN“t“==>“(?y.“y“IN“s“/\“(f“y“=“x)))ŽŽŽŒ‹&T ÌU ýFÓŸú™š‘êñëÛ38’ñÄ,Chapter›€3.‘ Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓSURJ_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘ù+ÞÓ|-–¿ª!f.“(!s.“SURJ“f{}s“=“(s“=“{}))“/\“(!s.“SURJ“f“s{}“=“(s“=“{}))Ž©a‘êñëSURJ_ID‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“SURJ(\x.“x)s“sŽŸ(V‘êñëç3.11Ž‘"% Singleton‘Ÿ¼setsŽŸ'C²‘êñëÓDELETE_EQ_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x.“x“IN“s“==>“((s“DELETE“x“=“{})“=“(s“=“{x}))Ž¦‘êñëDISJOINT_SING_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“DISJOINT{x}{}Ž¦‘êñëEQUAL_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y.“({x}“=“{y})“=“(x“=“y)Ž¦‘êñëINSERT_SING_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s“x.“x“INSERT“s“=“{x}“UNION“sŽ¦‘êñëIN_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x“y.“x“IN“{y}“=“(x“=“y)Ž¦‘êñëNOT_EMPTY_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“~({}“=“{x})Ž¦‘êñëNOT_SING_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“~({x}“=“{})Ž¦‘êñëSING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“SING{x}Ž¦‘êñëSING_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!s.“SING“s“=“(?x.“s“=“{x})Ž¦‘êñëSING_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª!x.“{x}“DELETE“x“=“{}ŽŸ(V‘êñëç3.12Ž‘"% Cardinalit‘ÿr°y–Ÿ¼of“setsŽŸ'C²‘êñëÓCARD_DEF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘ù+ÞÓ|-–¿ª(CARD{}“=“0)“/\Ž¡‘ jÜ(!s–¿ªx.“CARD(x“INSERT“s)“=“(x“IN“s“=>“CARD“s“|“SUC(CARD“s)))ŽŽŽŒ‹'— ÌU ýFÓŸú™š‘ÇaÛ3.12.‘ €Cardinalit y–€of“sets’&ë¢39Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÓCARD_DELETE‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¤ ™š‘!TÓ|-–¿ª!s“x.“CARD(s“DELETE“x)“=“(x“IN“s“=>“(CARD“s)“-“1“|“CARD“s)Ž©a‘ÇaCARD_DIFF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!t“s.“CARD(s“DIFF“t)“=“(CARD“s)“-“(CARD(s“INTER“t))Ž¦‘ÇaCARD_EMPTY‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ªCARD{}“=“0Ž¦‘ÇaCARD_EQ_0‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“(CARD“s“=“0)“=“(s“=“{})Ž¦‘ÇaCARD_INSERT‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“x.“CARD(x“INSERT“s)“=“(x“IN“s“=>“CARD“s“|“SUC(CARD“s))Ž¦‘ÇaCARD_INTER_LESS_EQ‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“(CARD(s“INTER“t))“<=“(CARD“s)Ž¦‘ÇaCARD_PSUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“t“PSUBSET“s“==>“(CARD“t)“<“(CARD“s)Ž¦‘ÇaCARD_SING‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!x.“CARD{x}“=“1Ž¦‘ÇaCARD_SUBSET‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“t“SUBSET“s“==>“(CARD“t)“<=“(CARD“s)Ž¦‘ÇaCARD_UNION‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s“t.“(CARD(s“UNION“t))“+“(CARD(s“INTER“t))“=“(CARD“s)“+“(CARD“t)Ž¦‘ÇaLESS_CARD_DIFF‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!t“s.“(CARD“t)“<“(CARD“s)“==>“0“<“(CARD(s“DIFF“t))Ž¦‘ÇaSING_IFF_CARD1‘ ¿øÖ(Ófinite‘°—‰ffsŽ‘#™setsÖ)Ž¡‘!TÓ|-–¿ª!s.“SING“s“=“(CARD“s“=“1)ŽŽŽŒ‹(– ÌU ýFÓŸú™š‘êñëÛ40’ðD,Chapter›€3.‘ €Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹)£V ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸGëHReferencesŽŸ‰Ç>|Ÿ;‘ßüÖ[1]ŽŽ‘' Z.–tÃManna“and“R.“W‘ÿValdinger,‘ŒWÙThe›Æ×L–ÿffo“gic“al˜Basis˜for˜Computer˜Pr“o“gr“amming:‘0:V‘ÿ™olumeŽ¤‘' 1,–35De›ÿffductive“R˜e˜asoningÖ,›ê¨Addison-W–ÿVesley“,˜1985.Ž©‘ßü[2]ŽŽ‘' T.–ü¼F.“Melham,›,QÙThe–X„HOL‘XMsets“libr‘ÿffaryÖ,˜Univ•¬rersit“y–ü¼of“Cam¬rbridge“Computer“LabSŽoratory‘ÿV,Ž¡‘' OctobSŽer‘ê¨1991.Ž¦‘ßü[3]ŽŽ‘' T.›­ÕMelham,‘¹ÿ`A‘­ÅP•¬rac“k‘ÿXäage˜for˜Inductiv“e˜Relation˜De nitions˜in˜HOL',˜to˜appSŽear˜in˜theŽ¡‘' ProSŽceedings–Kof“the“1991“In¬rternational“T›ÿVutorial“and“W˜orkshop“on“the“HOL‘K5Theo-Ž¡‘' rem–ÅÇPro¬rving“System,›Í'27{30“August“1991,˜Daš¬rvis“California“(IEEE‘ŽComputer“SoSŽciet˜yŽ¡‘' Press).Ž¦‘ßü[4]ŽŽ‘' Univ•¬rersit“y–‚3of“Cam¬rbridge“Computer“LabSŽoratory‘ÿV,‘—ÙThe‘Ó2HOL‘ÓSystem:‘6gDESCRIPTIONÖ,Ž¡‘' revised–ê¨edition,“July“1991.ŽŽŸ$ý’烈Û41ŽŽŒ‹*£æ ÌU ýFÓ ”/ß ýáä‘êñ럳¸ä‰Ç>|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘êñëÜABSORPTIONÖ,‘ê¨29Ž¤Z‘êñëaxiom–ê¨of“extension,“3Ž¡‘êñëaxioms–ê¨for“Ü(*)setÖ,“2{3Ž©.‘êñëÜBIJ_COMPOSEÖ,‘ê¨37Ž¡‘êñëÜBIJ_DEFÖ,–ê¨14,“37Ž¡‘êñëÜBIJ_EMPTYÖ,‘ê¨37Ž¡‘êñëÜBIJ_IDÖ,‘ê¨37Ž¦‘êñëÜCARD_DEFÖ,–ê¨16,“38Ž¡‘êñëÜCARD_DELETEÖ,‘ê¨39Ž¡‘êñëÜCARD_DIFFÖ,‘ê¨39Ž¡‘êñëÜCARD_EMPTYÖ,‘ê¨39Ž¡‘êñëÜCARD_EQ_0Ö,‘ê¨39Ž¡‘êñëÜCARD_INSERTÖ,‘ê¨39Ž¡‘êñëÜCARD_INTER_LESS_EQÖ,‘ê¨39Ž¡‘êñëÜCARD_PSUBSETÖ,‘ê¨39Ž¡‘êñëÜCARD_SINGÖ,–ê¨16,“39Ž¡‘êñëÜCARD_SUBSETÖ,‘ê¨39Ž¡‘êñëÜCARD_UNIONÖ,‘ê¨39Ž¡‘êñëÜCHOICE_DEFÖ,–ê¨12,“35Ž¡‘êñëÜCHOICE_INSERT_RESTÖ,‘ê¨35Ž¡‘êñëÜCHOICE_NOT_IN_RESTÖ,‘ê¨35Ž¡‘êñëÜCHOICE_SINGÖ,‘ê¨35Ž¡‘êñëÜCOMPONENTÖ,‘ê¨30Ž¡‘êñëcon•¬rv“ersionsŽ¡‘þñëÜDELETE_CONVÖ,‘ê¨11Ž¡‘þñëÜFINITE_CONVÖ,‘ê¨15Ž¡‘þñëÜIMAGE_CONVÖ,‘ê¨13Ž¡‘þñëÜIN_CONVÖ,‘ê¨7{8Ž¡‘þñëÜINSERT_CONVÖ,‘ê¨10Ž¡‘þñëÜUNION_CONVÖ,‘ê¨9{10Ž¦‘êñëÜDECOMPOSITIONÖ,‘ê¨30ŽŽŽ þä’à)Üdefine_finite_set_syntaxÖ,‘ê¨4Ž¤t„’à)de nitionŽ¡’ô)of–ê¨Ü(*)setÖ,“1{2Ž¡’ô)of–ê¨ÜBIJÖ,“14Ž¡’ô)of–ê¨ÜCARDÖ,“16Ž¡’ô)of–ê¨ÜCHOICEÖ,“12Ž¡’ô)of–ê¨ÜDELETEÖ,“7Ž¡’ô)of–ê¨ÜDIFFÖ,“6Ž¡’ô)of–ê¨ÜDISJOINTÖ,“6Ž¡’ô)of–ê¨ÜEMPTYÖ,“2Ž¡’ô)of–ê¨ÜFINITEÖ,“15Ž¡’ô)of–ê¨ÜIMAGEÖ,“12Ž¡’ô)of–ê¨ÜINÖ,“2Ž¡’ô)of–ê¨ÜINFINITEÖ,“15Ž¡’ô)of–ê¨ÜINJÖ,“14Ž¡’ô)of–ê¨ÜINSERTÖ,“2,“7Ž¡’ô)of–ê¨ÜINTERÖ,“6Ž¡’ô)of–ê¨ÜIS_SET_REPÖ,“2Ž¡’ô)of–ê¨ÜLINVÖ,“14Ž¡’ô)of–ê¨ÜPSUBSETÖ,“5Ž¡’ô)of–ê¨ÜRESTÖ,“12Ž¡’ô)of–ê¨ÜRINVÖ,“14Ž¡’ô)of–ê¨ÜSINGÖ,“11Ž¡’ô)of–ê¨ÜSUBSETÖ,“5Ž¡’ô)of–ê¨ÜSURJÖ,“14Ž¡’ô)of–ê¨ÜUNIONÖ,“6Ž¡’à)ÜDELETE_COMMÖ,‘ê¨33Ž¡’à)ÜDELETE_CONVÖ,–ê¨11,“19Ž¡’à)ÜDELETE_DEFÖ,–ê¨7,“34Ž¡’à)ÜDELETE_DELETEÖ,‘ê¨34Ž¡’à)ÜDELETE_EQ_SINGÖ,‘ê¨38Ž¡’à)ÜDELETE_INSERTÖ,‘ê¨34ŽŽŽŽŽŽŸ$ý’ÇÑ)Û42ŽŽŒ‹+§Ã ÌU ýFÓŸú™š‘ÇaÛIndex’˜n|43Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÜDELETE_INTERÖ,‘ê¨32Ž¤5‘ÇaÜDELETE_NON_ELEMENTÖ,‘ê¨34Ž¡‘ÇaÜDELETE_SUBSETÖ,‘ê¨34Ž¡‘ÇaÜDIFF_DEFÖ,‘ê¨6Ž¡‘ÇaÜDIFF_DIFFÖ,‘ê¨33Ž¡‘ÇaÜDIFF_EMPTYÖ,‘ê¨33Ž¡‘ÇaÜDIFF_EQ_EMPTYÖ,‘ê¨33Ž¡‘ÇaÜDIFF_INSERTÖ,‘ê¨34Ž¡‘ÇaÜDISJOINT_DEFÖ,–ê¨6,“34Ž¡‘ÇaÜDISJOINT_DELETE_SYMÖ,‘ê¨35Ž¡‘ÇaÜDISJOINT_EMPTYÖ,‘ê¨35Ž¡‘ÇaÜDISJOINT_EMPTY_REFLÖ,‘ê¨35Ž¡‘ÇaÜDISJOINT_INSERTÖ,‘ê¨35Ž¡‘ÇaÜDISJOINT_SING_EMPTYÖ,‘ê¨38Ž¡‘ÇaÜDISJOINT_SYMÖ,‘ê¨35Ž¡‘ÇaÜDISJOINT_UNIONÖ,‘ê¨35Ž©A¡‘ÇaÜEMPTY_DELETEÖ,‘ê¨34Ž¡‘ÇaÜEMPTY_DIFFÖ,‘ê¨33Ž¡‘ÇaÜEMPTY_SUBSETÖ,–ê¨5,“31Ž¡‘ÇaÜEMPTY_UNIONÖ,‘ê¨32Ž¡‘ÇaÜEQUAL_SINGÖ,‘ê¨38Ž¡‘ÇaÜEXTENSIONÖ,–ê¨3,“30Ž¦‘ÇaÜFINITE_CONVÖ,‘ê¨15Ž¡‘ÇaÜFINITE_DEFÖ,‘ê¨15Ž¡‘ÇaÜFINITE_EMPTYÖ,‘ê¨15Ž¡‘ÇaÜFINITE_INSERTÖ,‘ê¨15Ž¡‘ÇaÜFINITE_ISO_NUMÖ,‘ê¨16Ž¡‘ÇaÜFINITE_SET_DEFÖ,–ê¨2,“29Ž¦‘ÇaÜIMAGE_11_INFINITEÖ,‘ê¨15Ž¡‘ÇaÜIMAGE_COMPOSEÖ,‘ê¨36Ž¡‘ÇaÜIMAGE_CONVÖ,–ê¨13,“20Ž¡‘ÇaÜIMAGE_DEFÖ,‘ê¨12Ž¡‘ÇaÜIMAGE_DELETEÖ,‘ê¨36Ž¡‘ÇaÜIMAGE_EMPTYÖ,‘ê¨36Ž¡‘ÇaÜIMAGE_EQ_EMPTYÖ,‘ê¨36Ž¡‘ÇaÜIMAGE_IDÖ,‘ê¨36Ž¡‘ÇaÜIMAGE_INÖ,‘ê¨36Ž¡‘ÇaÜIMAGE_INSERTÖ,‘ê¨36ŽŽŽ ý‹Ð!’æŸÜIMAGE_INTERÖ,‘ê¨36Ž¤/µ’æŸÜIMAGE_SUBSETÖ,‘ê¨36Ž¡’æŸÜIMAGE_SURJÖ,‘ê¨37Ž¡’æŸÜIMAGE_UNIONÖ,‘ê¨36Ž¡’æŸÜIN_CONVÖ,–ê¨7{8,“24Ž¡’æŸÜIN_DELETEÖ,–ê¨7,“34Ž¡’æŸÜIN_DELETE_EQÖ,‘ê¨34Ž¡’æŸÜIN_DIFFÖ,–ê¨6,“33Ž¡’æŸÜIN_DISJOINTÖ,‘ê¨35Ž¡’æŸÜIN_IMAGEÖ,–ê¨12,“36Ž¡’æŸÜIN_INSERTÖ,–ê¨3,“7,“30Ž¡’æŸÜIN_INTERÖ,–ê¨6,“32Ž¡’æŸÜIN_SINGÖ,‘ê¨38Ž¡’æŸÜIN_UNIONÖ,–ê¨6,“32Ž¡’æŸinduction,‘ê¨3{4Ž¡’æŸÜINFINITE_DEFÖ,‘ê¨15Ž¡’æŸÜINJ_COMPOSEÖ,‘ê¨37Ž¡’æŸÜINJ_DEFÖ,–ê¨14,“37Ž¡’æŸÜINJ_EMPTYÖ,‘ê¨37Ž¡’æŸÜINJ_IDÖ,‘ê¨37Ž¡’æŸÜINSERT_COMMÖ,–ê¨3,“30Ž¡’æŸÜINSERT_CONVÖ,–ê¨10,“22Ž¡’æŸÜINSERT_DEFÖ,‘ê¨7Ž¡’æŸÜINSERT_DELETEÖ,‘ê¨34Ž¡’æŸÜINSERT_INSERTÖ,–ê¨3,“30Ž¡’æŸÜINSERT_INTERÖ,‘ê¨32Ž¡’æŸÜINSERT_SING_UNIONÖ,‘ê¨38Ž¡’æŸÜINSERT_SUBSETÖ,‘ê¨31Ž¡’æŸÜINSERT_UNIONÖ,‘ê¨32Ž¡’æŸÜINSERT_UNION_EQÖ,‘ê¨32Ž¡’æŸÜINTER_ASSOCÖ,‘ê¨32Ž¡’æŸÜINTER_COMMÖ,‘ê¨32Ž¡’æŸÜINTER_DEFÖ,‘ê¨6Ž¡’æŸÜINTER_EMPTYÖ,‘ê¨32Ž¡’æŸÜINTER_IDEMPOTÖ,‘ê¨32Ž¡’æŸÜINTER_OVER_UNIONÖ,‘ê¨32Ž¡’æŸÜINTER_SUBSETÖ,‘ê¨32Ž¡’æŸÜIS_SET_REPÖ,–ê¨2,“29ŽŸJÉ’æŸÜLESS_CARD_DIFFÖ,‘ê¨39ŽŽŽŽŽŽŒ‹,¯ ÌU ýFÓŸú™š‘êñëÛ44’˜n|IndexŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÜLINV_DEFÖ,–ê¨14,“37Ž©±‘êñëÜload_finite_setsÖ,‘ê¨18Ž¤Rã‘êñëÜMEMBER_NOT_EMPTYÖ,‘ê¨30Ž¡‘êñënaming‘ê¨con•¬rv“en“tionsŽ¦‘þñëfor–ê¨de nitions,“2Ž¦‘þñëfor–ê¨mem¬rbSŽership“conditions,“6Ž¦‘þñëfor–ê¨theorems“abSŽout“singletons,“11Ž¦‘þñëfor–ê¨theorems“generally‘ÿV,“6Ž¦‘êñëÜNOT_EMPTY_INSERTÖ,‘ê¨30Ž¦‘êñëÜNOT_EMPTY_SINGÖ,‘ê¨38Ž¦‘êñëÜNOT_EQUAL_SETSÖ,‘ê¨30Ž¦‘êñëÜNOT_IN_EMPTYÖ,–ê¨3,“30Ž¦‘êñëÜNOT_INSERT_EMPTYÖ,‘ê¨30Ž¦‘êñëÜNOT_PSUBSET_EMPTYÖ,–ê¨5,“31Ž¦‘êñëÜNOT_SING_EMPTYÖ,‘ê¨38Ž¦‘êñëÜNOT_UNIV_PSUBSETÖ,‘ê¨5Ž¦‘êñëÜNUM_SET_WOPÖ,‘ê¨30Ž¡‘êñëÜprint_set–ê¨Ö( ag),“5Ž¦‘êñëÜPSUBSET_DEFÖ,–ê¨5,“31Ž¦‘êñëÜPSUBSET_INSERT_SUBSETÖ,‘ê¨31Ž¦‘êñëÜPSUBSET_IRREFLÖ,‘ê¨31Ž¦‘êñëÜPSUBSET_MEMBERÖ,‘ê¨31Ž¦‘êñëÜPSUBSET_TRANSÖ,‘ê¨31Ž¡‘êñëÜREST_DEFÖ,–ê¨12,“35Ž¦‘êñëÜREST_PSUBSETÖ,‘ê¨35Ž¦‘êñëÜREST_SINGÖ,‘ê¨35Ž¦‘êñëÜREST_SUBSETÖ,‘ê¨36Ž¦‘êñëÜRINV_DEFÖ,–ê¨14,“37Ž¡‘êñëÜSET_CASESÖ,‘ê¨30Ž¦‘êñëÜSET_INDUCTÖ,–ê¨3,“30Ž¦‘êñëÜSET_INDUCT_TACÖ,–ê¨3{4,“25Ž¦‘êñëÜSET_MINIMUMÖ,‘ê¨30Ž¦‘êñëÜset_TY_DEFÖ,–ê¨2,“29Ž¦‘êñëÜSINGÖ,–ê¨11,“38Ž¦‘êñëÜSING_DEFÖ,–ê¨11,“38Ž¦‘êñëÜSING_DELETEÖ,‘ê¨38Ž¦‘êñëÜSING_IFF_CARD1Ö,‘ê¨39ŽŽŽ ý‹Ð!’à)ÜSING_IFF_EMPTY_RESTÖ,‘ê¨36Ž¤’à)ÜSUBSET_ANTISYMÖ,–ê¨5,“31Ž¡’à)ÜSUBSET_DEFÖ,–ê¨5,“31Ž¡’à)ÜSUBSET_DELETEÖ,‘ê¨34Ž¡’à)ÜSUBSET_EMPTYÖ,‘ê¨31Ž¡’à)ÜSUBSET_INSERTÖ,‘ê¨31Ž¡’à)ÜSUBSET_INSERT_DELETEÖ,‘ê¨34Ž¡’à)ÜSUBSET_INTER_ABSORPTIONÖ,‘ê¨32Ž¡’à)ÜSUBSET_REFLÖ,–ê¨5,“31Ž¡’à)ÜSUBSET_TRANSÖ,–ê¨5,“31Ž¡’à)ÜSUBSET_UNIONÖ,‘ê¨33Ž¡’à)ÜSUBSET_UNION_ABSORPTIONÖ,‘ê¨33Ž¡’à)ÜSUBSET_UNIVÖ,‘ê¨5Ž¡’à)ÜSURJ_COMPOSEÖ,‘ê¨37Ž¡’à)ÜSURJ_DEFÖ,–ê¨14,“37Ž¡’à)ÜSURJ_EMPTYÖ,‘ê¨38Ž¡’à)ÜSURJ_IDÖ,‘ê¨38Ž©’à)tacticsŽ¡’ô)ÜSET_INDUCT_TACÖ,‘ê¨3{4Ž¦’à)ÜUNION_ASSOCÖ,‘ê¨33Ž¡’à)ÜUNION_COMMÖ,‘ê¨33Ž¡’à)ÜUNION_CONVÖ,–ê¨9{10,“26Ž¡’à)ÜUNION_DEFÖ,‘ê¨6Ž¡’à)ÜUNION_EMPTYÖ,‘ê¨33Ž¡’à)ÜUNION_IDEMPOTÖ,‘ê¨33Ž¡’à)ÜUNION_OVER_INTERÖ,‘ê¨33ŽŽŽŽŽŽŒø¸3ƒ’À;èÌUÚÝ 0óLßê ó3 cmmi10ó"Kñ`y ó3 cmr10óp®0J cmsl10ó×2cmmi8ó |{Ycmr8ùÀAßßßßßhol88-2.02.19940316/Library/finite_sets/Manual/theorems-intro.tex0000640000212700021270000000110105147526713022565 0ustar cammcamm\label{theorems} The sections that follow list all theorems in the \ml{finite\_sets} library, including definitions. The theorems are grouped into sections according to subject matter. Some theorems could be classified under more than one subject, but each theorem is listed in only one section. The reader may therefore have to consult more than one section when searching for any particular theorem. When the \ml{finite\_sets} library is loaded, all the theorems listed in this chapter (including definitions) are set up to autoload when their names are mentioned in \ML. hol88-2.02.19940316/Library/finite_sets/Manual/entries.tex0000640000212700021270000004616505535604136021277 0ustar cammcamm\chapter{ML Functions in the Library} \label{entries} \input{entries-intro} \DOC{DELETE\_CONV} \TYPE {\small\verb%DELETE_CONV : conv -> conv%}\egroup \SYNOPSIS Reduce {\small\verb%{x1,...,xn} DELETE x%} by deleting {\small\verb%x%} from {\small\verb%{x1,...,xn}%}. \DESCRIBE The function {\small\verb%DELETE_CONV%} is a parameterized conversion for reducing finite sets of the form {\small\verb%"{t1,...,tn} DELETE t"%}, where {\small\verb%{t1,...,tn}%} is a set of type {\small\verb%(ty)set%} and {\small\verb%t%} is a term of type {\small\verb%ty%}. The first argument to {\small\verb%DELETE_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion {\small\verb%conv%}, the function {\small\verb%DELETE_CONV%} returns a conversion that maps a term of the form {\small\verb%"{t1,...,tn} DELETE t"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- {t1,...,tn} DELETE t = {ti,...,tj} \end{verbatim} } \noindent where {\small\verb%{ti,...,tj}%} is the subset of {\small\verb%{t1,...,tn}%} for which the supplied equality conversion {\small\verb%conv%} proves {\par\samepage\setseps\small \begin{verbatim} |- (ti = t) = F, ..., |- (tj = t) = F \end{verbatim} } \noindent and for all the elements {\small\verb%tk%} in {\small\verb%{t1,...,tn}%} but not in {\small\verb%{ti,...,tj}%}, either {\small\verb%conv%} proves {\small\verb%|- (tk = t) = T%} or {\small\verb%tk%} is alpha-equivalent to {\small\verb%t%}. That is, the reduced set {\small\verb%{ti,...,tj}%} comprises all those elements of the original set that are provably not equal to the deleted element {\small\verb%t%}. \EXAMPLE In the following example, the conversion {\small\verb%num_EQ_CONV%} is supplied as a parameter and used to test equality of the deleted value {\small\verb%2%} with the elements of the set. {\par\samepage\setseps\small \begin{verbatim} #DELETE_CONV num_EQ_CONV "{2,1,SUC 1,3} DELETE 2";; |- {2,1,SUC 1,3} DELETE 2 = {1,3} \end{verbatim} } \FAILURE {\small\verb%DELETE_CONV conv%} fails if applied to a term not of the form {\small\verb%"{t1,...,tn} DELETE t"%}. A call {\small\verb%DELETE_CONV conv "{t1,...,tn} DELETE t"%} fails unless for each element {\small\verb%ti%} of the set {\small\verb%{t1,...,tn}%}, the term {\small\verb%t%} is either alpha-equivalent to {\small\verb%ti%} or {\small\verb%conv "ti = t"%} returns {\small\verb%|- (ti = t) = T%} or {\small\verb%|- (ti = t) = F%}. \SEEALSO INSERT_CONV. \ENDDOC \DOC{IMAGE\_CONV} \TYPE {\small\verb%IMAGE_CONV : conv -> conv -> conv%}\egroup \SYNOPSIS Compute the image of a function on a finite set. \DESCRIBE The function {\small\verb%IMAGE_CONV%} is a parameterized conversion for computing the image of a function {\small\verb%f:ty1->ty2%} on a finite set {\small\verb%"{t1,...,tn}"%} of type {\small\verb%(ty1)set%}. The first argument to {\small\verb%IMAGE_CONV%} is expected to be a conversion that computes the result of applying the function {\small\verb%f%} to each element of this set. When applied to a term {\small\verb%"f ti"%}, this conversion should return a theorem of the form {\small\verb%|- (f ti) = ri%}, where {\small\verb%ri%} is the result of applying the function {\small\verb%f%} to the element {\small\verb%ti%}. This conversion is used by {\small\verb%IMAGE_CONV%} to compute a theorem of the form {\par\samepage\setseps\small \begin{verbatim} |- IMAGE f {t1,...,tn} = {r1,...,rn} \end{verbatim} } \noindent The second argument to {\small\verb%IMAGE_CONV%} is used (optionally) to simplify the resulting image set {\small\verb%{r1,...,rn}%} by removing redundant occurrences of values. This conversion expected to decide equality of values of the result type {\small\verb%ty2%}; given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty2%}, the conversion should return either {\small\verb%|- (e1 = e2) = T%} or {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given appropriate conversions {\small\verb%conv1%} and {\small\verb%conv2%}, the function {\small\verb%IMAGE_CONV%} returns a conversion that maps a term of the form {\small\verb%"IMAGE f {t1,...,tn}"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- IMAGE f {t1,...,tn} = {rj,...,rk} \end{verbatim} } \noindent where {\small\verb%conv1%} proves a theorem of the form {\small\verb%|- (f ti) = ri%} for each element {\small\verb%ti%} of the set {\small\verb%{t1,...,tn}%}, and where the set {\small\verb%{rj,...,rk}%} is the smallest subset of {\small\verb%{r1,...,rn}%} such no two elements are alpha-equivalent and {\small\verb%conv2%} does not map {\small\verb%"rl = rm"%} to the theorem {\small\verb%|- (rl = rm) = T%} for any pair of values {\small\verb%rl%} and {\small\verb%rm%} in {\small\verb%{rj,...,rk}%}. That is, {\small\verb%{rj,...,rk}%} is the set obtained by removing multiple occurrences of values from the set {\small\verb%{r1,...,rn}%}, where the equality conversion {\small\verb%conv2%} (or alpha-equivalence) is used to determine which pairs of terms in {\small\verb%{r1,...,rn}%} are equal. \EXAMPLE The following is a very simple example in which {\small\verb%REFL%} is used to construct the result of applying the function {\small\verb%f%} to each element of the set {\small\verb%{1,2,1,4}%}, and {\small\verb%NO_CONV%} is the supplied `equality conversion'. {\par\samepage\setseps\small \begin{verbatim} #IMAGE_CONV REFL NO_CONV "IMAGE (f:num->num) {1,2,1,4}";; |- IMAGE f{1,2,1,4} = {f 2,f 1,f 4} \end{verbatim} } \noindent The result contains only one occurrence of `{\small\verb%f 1%}', even though {\small\verb%NO_CONV%} always fails, since {\small\verb%IMAGE_CONV%} simplifies the resulting set by removing elements that are redundant up to alpha-equivalence. For the next example, we construct a conversion that maps {\small\verb%SUC n%} for any numeral {\small\verb%n%} to the numeral standing for the successor of {\small\verb%n%}. {\par\samepage\setseps\small \begin{verbatim} #let SUC_CONV tm = let n = int_of_string(fst(dest_const(rand tm))) in let sucn = mk_const(string_of_int(n+1), ":num") in SYM (num_CONV sucn);; SUC_CONV = - : conv \end{verbatim} } \noindent The result is a conversion that inverts {\small\verb%num_CONV%}: {\par\samepage\setseps\small \begin{verbatim} #num_CONV "4";; |- 4 = SUC 3 #SUC_CONV "SUC 3";; |- SUC 3 = 4 \end{verbatim} } \noindent The conversion {\small\verb%SUC_CONV%} can then be used to compute the image of the successor function on a finite set: {\par\samepage\setseps\small \begin{verbatim} #IMAGE_CONV SUC_CONV NO_CONV "IMAGE SUC {1,2,1,4}";; |- IMAGE SUC{1,2,1,4} = {3,2,5} \end{verbatim} } \noindent Note that {\small\verb%2%} (= {\small\verb%SUC 1%}) appears only once in the resulting set. Fianlly, here is an example of using {\small\verb%IMAGE_CONV%} to compute the image of a paired addition function on a set of pairs of numbers: {\par\samepage\setseps\small \begin{verbatim} #IMAGE_CONV (PAIRED_BETA_CONV THENC ADD_CONV) num_EQ_CONV "IMAGE (\(n,m).n+m) {(1,2), (3,4), (0,3), (1,3)}";; |- IMAGE(\(n,m). n + m){(1,2),(3,4),(0,3),(1,3)} = {7,3,4} \end{verbatim} } \FAILURE {\small\verb%IMAGE_CONV conv1 conv2%} fails if applied to a term not of the form {\small\verb%"IMAGE f {t1,...,tn}"%}. An application of {\small\verb%IMAGE_CONV conv1 conv2%} to a term {\small\verb%"IMAGE f {t1,...,tn}"%} fails unless for all {\small\verb%ti%} in the set {\small\verb%{t1,...,tn}%}, evaluating {\small\verb%conv1 "f ti"%} returns {\small\verb%|- (f ti) = ri%} for some {\small\verb%ri%}. \ENDDOC \DOC{INSERT\_CONV} \TYPE {\small\verb%INSERT_CONV : conv -> conv%}\egroup \SYNOPSIS Reduce {\small\verb%x INSERT {x1,...,x,...,xn}%} to {\small\verb%{x1,...,x,...,xn}%}. \DESCRIBE The function {\small\verb%INSERT_CONV%} is a parameterized conversion for reducing finite sets of the form {\small\verb%"t INSERT {t1,...,tn}"%}, where {\small\verb%{t1,...,tn}%} is a set of type {\small\verb%(ty)set%} and {\small\verb%t%} is equal to some element {\small\verb%ti%} of this set. The first argument to {\small\verb%INSERT_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion, the function {\small\verb%INSERT_CONV%} returns a conversion that maps a term of the form {\small\verb%"t INSERT {t1,...,tn}"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- t INSERT {t1,...,tn} = {t1,...,tn} \end{verbatim} } \noindent if {\small\verb%t%} is alpha-equivalent to any {\small\verb%ti%} in the set {\small\verb%{t1,...,tn}%}, or if the supplied conversion proves {\small\verb%|- (t = ti) = T%} for any {\small\verb%ti%}. \EXAMPLE In the following example, the conversion {\small\verb%num_EQ_CONV%} is supplied as a parameter and used to test equality of the inserted value {\small\verb%2%} with the remaining elements of the set. {\par\samepage\setseps\small \begin{verbatim} #INSERT_CONV num_EQ_CONV "2 INSERT {1,SUC 1,3}";; |- {2,1,SUC 1,3} = {1,SUC 1,3} \end{verbatim} } \noindent In this example, the supplied conversion {\small\verb%num_EQ_CONV%} is able to prove that {\small\verb%2%} is equal to {\small\verb%SUC 1%} and the set is therefore reduced. Note that {\small\verb%"2 INSERT {1,SUC 1,3}"%} is just {\small\verb%"{2,1,SUC 1,3}"%}. A call to {\small\verb%INSERT_CONV%} fails when the value being inserted is provably not equal to any of the remaining elements: {\par\samepage\setseps\small \begin{verbatim} #INSERT_CONV num_EQ_CONV "1 INSERT {2,3}";; evaluation failed INSERT_CONV \end{verbatim} } \noindent But this failure can, if desired, be caught using {\small\verb%TRY_CONV%}. The behaviour of the supplied conversion is irrelevant when the inserted value is alpha-equivalent to one of the remaining elements: {\par\samepage\setseps\small \begin{verbatim} #INSERT_CONV NO_CONV "(y:*) INSERT {x,y,z}";; |- {y,x,y,z} = {x,y,z} \end{verbatim} } \noindent The conversion {\small\verb%NO_CONV%} always fails, but {\small\verb%INSERT_CONV%} is nontheless able in this case to prove the required result. Note that {\small\verb%DEPTH_CONV(INSERT_CONV conv)%} can be used to remove duplicate elements from a finite set, but the following conversion is faster: {\par\samepage\setseps\small \begin{verbatim} #letrec REDUCE_CONV conv tm = (SUB_CONV (REDUCE_CONV conv) THENC (TRY_CONV (INSERT_CONV conv))) tm;; REDUCE_CONV = - : (conv -> conv) #REDUCE_CONV num_EQ_CONV "{1,2,1,3,2,4,3,5,6}";; |- {1,2,1,3,2,4,3,5,6} = {1,2,4,3,5,6} \end{verbatim} } \FAILURE {\small\verb%INSERT_CONV conv%} fails if applied to a term not of the form {\small\verb%"t INSERT {t1,...,tn}"%}. A call {\small\verb%INSERT_CONV conv "t INSERT {t1,...,tn}"%} fails unless {\small\verb%t%} is alpha-equivalent to some {\small\verb%ti%}, or {\small\verb%conv "t = ti"%} returns {\small\verb%|- (t = ti) = T%} for some {\small\verb%ti%}. \SEEALSO DELETE_CONV. \ENDDOC \DOC{IN\_CONV} \TYPE {\small\verb%IN_CONV : conv -> conv%}\egroup \SYNOPSIS Decision procedure for membership in finite sets. \DESCRIBE The function {\small\verb%IN_CONV%} is a parameterized conversion for proving or disproving membership assertions of the general form: {\par\samepage\setseps\small \begin{verbatim} "t IN {t1,...,tn}" \end{verbatim} } \noindent where {\small\verb%{t1,...,tn}%} is a set of type {\small\verb%(ty)set%} and {\small\verb%t%} is a value of the base type {\small\verb%ty%}. The first argument to {\small\verb%IN_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion, the function {\small\verb%IN_CONV%} returns a conversion that maps a term of the form {\small\verb%"t IN {t1,...,tn}"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- t IN {t1,...,tn} = T \end{verbatim} } \noindent if {\small\verb%t%} is alpha-equivalent to any {\small\verb%ti%}, or if the supplied conversion proves {\small\verb%|- (t = ti) = T%} for any {\small\verb%ti%}. If the supplied conversion proves {\small\verb%|- (t = ti) = F%} for every {\small\verb%ti%}, then the result is the theorem {\par\samepage\setseps\small \begin{verbatim} |- t IN {t1,...,tn} = F \end{verbatim} } \noindent In all other cases, {\small\verb%IN_CONV%} will fail. \EXAMPLE In the following example, the conversion {\small\verb%num_EQ_CONV%} is supplied as a parameter and used to test equality of the candidate element {\small\verb%1%} with the actual elements of the given set. {\par\samepage\setseps\small \begin{verbatim} #IN_CONV num_EQ_CONV "2 IN {0,SUC 1,3}";; |- 2 IN {0,SUC 1,3} = T \end{verbatim} } \noindent The result is {\small\verb%T%} because {\small\verb%num_EQ_CONV%} is able to prove that {\small\verb%2%} is equal to {\small\verb%SUC 1%}. An example of a negative result is: {\par\samepage\setseps\small \begin{verbatim} #IN_CONV num_EQ_CONV "1 IN {0,2,3}";; |- 1 IN {0,2,3} = F \end{verbatim} } \noindent Finally the behaviour of the supplied conversion is irrelevant when the value to be tested for membership is alpha-equivalent to an actual element: {\par\samepage\setseps\small \begin{verbatim} #IN_CONV NO_CONV "1 IN {3,2,1}";; |- 1 IN {3,2,1} = T \end{verbatim} } \noindent The conversion {\small\verb%NO_CONV%} always fails, but {\small\verb%IN_CONV%} is nontheless able in this case to prove the required result. \FAILURE {\small\verb%IN_CONV conv%} fails if applied to a term that is not of the form {\small\verb%"t IN {t1,...,tn}"%}. A call {\small\verb%IN_CONV conv "t IN {t1,...,tn}"%} fails unless the term {\small\verb%t%} is alpha-equivalent to some {\small\verb%ti%}, or {\small\verb%conv "t = ti"%} returns {\small\verb%|- (t = ti) = T%} for some {\small\verb%ti%}, or {\small\verb%conv "t = ti"%} returns {\small\verb%|- (t = ti) = F%} for every {\small\verb%ti%}. \ENDDOC \DOC{SET\_INDUCT\_TAC} \TYPE {\small\verb%SET_INDUCT_TAC : tactic%}\egroup \SYNOPSIS Tactic for induction on finite sets. \DESCRIBE {\small\verb%SET_INDUCT_TAC%} is an induction tacic for proving properties of finite sets. When applied to a goal of the form {\par\samepage\setseps\small \begin{verbatim} !s:(*)set. P[s] \end{verbatim} } \noindent {\small\verb%SET_INDUCT_TAC%} reduces this goal to proving that the property {\small\verb%\s.P[s]%} holds of the empty set and is preserved by insertion of an element into an arbitrary finite set. Since every finite set can be built up from the empty set {\small\verb%"{}"%} by repeated insertion of values, these subgoals imply that the property {\small\verb%\s.P[s]%} holds of all finite sets. The tactic specification of {\small\verb%SET_INDUCT_TAC%} is: {\par\samepage\setseps\small \begin{verbatim} A ?- !s.P ================================================== SET_INDUCT_TAC A |- P[{}/s] A u {P[s'/s], ~e IN s'} ?- P[e INSERT s'/s] \end{verbatim} } \noindent where {\small\verb%e%} is a variable chosen so as not to appear free in the assumptions {\small\verb%A%}, and {\small\verb%s'%} is a primed variant of {\small\verb%s%} that does not appear free in {\small\verb%A%} (usually, {\small\verb%s'%} is just {\small\verb%s%}). \FAILURE {\small\verb%SET_INDUCT_TAC (A,g)%} fails unless {\small\verb%g%} has the form {\small\verb%!s.P%}, where the variable {\small\verb%s%} has type {\small\verb%(ty)set%} for some type {\small\verb%ty%}. \ENDDOC \DOC{UNION\_CONV} \TYPE {\small\verb%UNION_CONV : conv -> conv%}\egroup \SYNOPSIS Reduce {\small\verb%{t1,...,tn} UNION s%} to {\small\verb%t1 INSERT (... (tn INSERT s))%}. \DESCRIBE The function {\small\verb%UNION_CONV%} is a parameterized conversion for reducing sets of the form {\small\verb%"{t1,...,tn} UNION s"%}, where {\small\verb%{t1,...,tn}%} and {\small\verb%s%} are sets of type {\small\verb%(ty)set%}. The first argument to {\small\verb%UNION_CONV%} is expected to be a conversion that decides equality between values of the base type {\small\verb%ty%}. Given an equation {\small\verb%"e1 = e2"%}, where {\small\verb%e1%} and {\small\verb%e2%} are terms of type {\small\verb%ty%}, this conversion should return the theorem {\small\verb%|- (e1 = e2) = T%} or the theorem {\small\verb%|- (e1 = e2) = F%}, as appropriate. Given such a conversion, the function {\small\verb%UNION_CONV%} returns a conversion that maps a term of the form {\small\verb%"{t1,...,tn} UNION s"%} to the theorem {\par\samepage\setseps\small \begin{verbatim} |- t UNION {t1,...,tn} = ti INSERT ... (tj INSERT s) \end{verbatim} } \noindent where {\small\verb%{ti,...,tj}%} is the set of all terms {\small\verb%t%} that occur as elements of {\small\verb%{t1,...,tn}%} for which the conversion {\small\verb%IN_CONV conv%} fails to prove that {\small\verb%|- (t IN s) = T%} (that is, either by proving {\small\verb%|- (t IN s) = F%} instead, or by failing outright). \EXAMPLE In the following example, {\small\verb%num_EQ_CONV%} is supplied as a parameter to {\small\verb%UNION_CONV%} and used to test for membership of each element of the first finite set {\small\verb%{1,2,3}%} of the union in the second finite set {\small\verb%{SUC 0,3,4}%}. {\par\samepage\setseps\small \begin{verbatim} #UNION_CONV num_EQ_CONV "{1,2,3} UNION {SUC 0,3,4}";; |- {1,2,3} UNION {SUC 0,3,4} = {2,SUC 0,3,4} \end{verbatim} } \noindent The result is {\small\verb%{2,SUC 0,3,4}%}, rather than {\small\verb%{1,2,SUC 0,3,4}%}, because {\small\verb%UNION_CONV%} is able by means of a call to {\par\samepage\setseps\small \begin{verbatim} IN_CONV num_EQ_CONV "1 IN {SUC 0,3,4}" \end{verbatim} } \noindent to prove that {\small\verb%1%} is already an element of the set {\small\verb%{SUC 0,3,4}%}. The conversion supplied to {\small\verb%UNION_CONV%} need not actually prove equality of elements, if simplification of the resulting set is not desired. For example: {\par\samepage\setseps\small \begin{verbatim} #UNION_CONV NO_CONV "{1,2,3} UNION {SUC 0,3,4}";; |- {1,2,3} UNION {SUC 0,3,4} = {1,2,SUC 0,3,4} \end{verbatim} } \noindent In this case, the resulting set is just left unsimplified. Moreover, the second set argument to {\small\verb%UNION%} need not be a finite set: {\par\samepage\setseps\small \begin{verbatim} #UNION_CONV NO_CONV "{1,2,3} UNION s";; |- {1,2,3} UNION s = 1 INSERT (2 INSERT (3 INSERT s)) \end{verbatim} } \noindent And, of course, in this case the conversion argument to {\small\verb%UNION_CONV%} is irrelevant. \FAILURE {\small\verb%UNION_CONV conv%} fails if applied to a term not of the form {\small\verb%"{t1,...,tn} UNION s"%}. \SEEALSO IN_CONV. \ENDDOC hol88-2.02.19940316/Library/finite_sets/Manual/theorems.tex0000640000212700021270000003264405535604134021447 0ustar cammcamm\chapter{Pre-proved Theorems} \input{theorems-intro} \section{The type definition} \THEOREM FINITE\_SET\_DEF finite\_sets |- (!x. ~x IN {}) /\ (!x y s. x IN (y INSERT s) = (x = y) \/ x IN s) /\ (!x s. x INSERT (x INSERT s) = x INSERT s) /\ (!x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)) /\ (!P. P{} /\ (!s. P s ==> (!e. P(e INSERT s))) ==> (!s. P s)) \ENDTHEOREM \THEOREM IS\_SET\_REP finite\_sets |- IS_SET_REP(\x. F) /\ (!s. IS_SET_REP s ==> (!x. IS_SET_REP(\y. (y = x) \/ s y))) /\ (!P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. IS_SET_REP s ==> P s)) \ENDTHEOREM \THEOREM set\_TY\_DEF finite\_sets |- ?rep. TYPE_DEFINITION IS_SET_REP rep \ENDTHEOREM \section{Basic properties of {\tt EMPTY}, {\tt INSERT}, and {\tt IN}} \THEOREM ABSORPTION finite\_sets |- !x s. x IN s = (x INSERT s = s) \ENDTHEOREM \THEOREM COMPONENT finite\_sets |- !x s. x IN (x INSERT s) \ENDTHEOREM \THEOREM DECOMPOSITION finite\_sets |- !s x. x IN s = (?t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM \THEOREM EXTENSION finite\_sets |- !s t. (s = t) = (!x. x IN s = x IN t) \ENDTHEOREM \THEOREM INSERT\_COMM finite\_sets |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) \ENDTHEOREM \THEOREM INSERT\_INSERT finite\_sets |- !x s. x INSERT (x INSERT s) = x INSERT s \ENDTHEOREM \THEOREM IN\_INSERT finite\_sets |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s \ENDTHEOREM \THEOREM MEMBER\_NOT\_EMPTY finite\_sets |- !s. (?x. x IN s) = ~(s = {}) \ENDTHEOREM \THEOREM NOT\_EMPTY\_INSERT finite\_sets |- !x s. ~({} = x INSERT s) \ENDTHEOREM \THEOREM NOT\_EQUAL\_SETS finite\_sets |- !s t. ~(s = t) = (?x. x IN t = ~x IN s) \ENDTHEOREM \THEOREM NOT\_INSERT\_EMPTY finite\_sets |- !x s. ~(x INSERT s = {}) \ENDTHEOREM \THEOREM NOT\_IN\_EMPTY finite\_sets |- !x. ~x IN {} \ENDTHEOREM \THEOREM NUM\_SET\_WOP finite\_sets |- !s. (?n. n IN s) = (?n. n IN s /\ (!m. m IN s ==> n <= m)) \ENDTHEOREM \THEOREM SET\_CASES finite\_sets |- !s. (s = {}) \/ (?x t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM \THEOREM SET\_INDUCT finite\_sets |- !P. P{} /\ (!s. P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> (!s. P s) \ENDTHEOREM \THEOREM SET\_MINIMUM finite\_sets |- !s M. (?x. x IN s) = (?x. x IN s /\ (!y. y IN s ==> (M x) <= (M y))) \ENDTHEOREM \section{Set inclusion} \THEOREM EMPTY\_SUBSET finite\_sets |- !s. {} SUBSET s \ENDTHEOREM \THEOREM INSERT\_SUBSET finite\_sets |- !x s t. (x INSERT s) SUBSET t = x IN t /\ s SUBSET t \ENDTHEOREM \THEOREM NOT\_PSUBSET\_EMPTY finite\_sets |- !s. ~s PSUBSET {} \ENDTHEOREM \THEOREM PSUBSET\_DEF finite\_sets |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) \ENDTHEOREM \THEOREM PSUBSET\_INSERT\_SUBSET finite\_sets |- !s t. s PSUBSET t = (?x. ~x IN s /\ (x INSERT s) SUBSET t) \ENDTHEOREM \THEOREM PSUBSET\_IRREFL finite\_sets |- !s. ~s PSUBSET s \ENDTHEOREM \THEOREM PSUBSET\_MEMBER finite\_sets |- !s t. s PSUBSET t = s SUBSET t /\ (?y. y IN t /\ ~y IN s) \ENDTHEOREM \THEOREM PSUBSET\_TRANS finite\_sets |- !s t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u \ENDTHEOREM \THEOREM SUBSET\_ANTISYM finite\_sets |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) \ENDTHEOREM \THEOREM SUBSET\_DEF finite\_sets |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) \ENDTHEOREM \THEOREM SUBSET\_EMPTY finite\_sets |- !s. s SUBSET {} = (s = {}) \ENDTHEOREM \THEOREM SUBSET\_INSERT finite\_sets |- !x s. ~x IN s ==> (!t. s SUBSET (x INSERT t) = s SUBSET t) \ENDTHEOREM \THEOREM SUBSET\_REFL finite\_sets |- !s. s SUBSET s \ENDTHEOREM \THEOREM SUBSET\_TRANS finite\_sets |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u \ENDTHEOREM \section{Intersection and union} \THEOREM DELETE\_INTER finite\_sets |- !s t x. (s DELETE x) INTER t = (s INTER t) DELETE x \ENDTHEOREM \THEOREM EMPTY\_UNION finite\_sets |- !s t. (s UNION t = {}) = (s = {}) /\ (t = {}) \ENDTHEOREM \THEOREM INSERT\_INTER finite\_sets |- !x s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t) \ENDTHEOREM \THEOREM INSERT\_UNION finite\_sets |- !x s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t)) \ENDTHEOREM \THEOREM INSERT\_UNION\_EQ finite\_sets |- !x s t. (x INSERT s) UNION t = x INSERT (s UNION t) \ENDTHEOREM \THEOREM INTER\_ASSOC finite\_sets |- !s t u. (s INTER t) INTER u = s INTER (t INTER u) \ENDTHEOREM \THEOREM INTER\_COMM finite\_sets |- !s t. s INTER t = t INTER s \ENDTHEOREM \THEOREM INTER\_EMPTY finite\_sets |- (!s. {} INTER s = {}) /\ (!s. s INTER {} = {}) \ENDTHEOREM \THEOREM INTER\_IDEMPOT finite\_sets |- !s. s INTER s = s \ENDTHEOREM \THEOREM INTER\_OVER\_UNION finite\_sets |- !s t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u) \ENDTHEOREM \THEOREM INTER\_SUBSET finite\_sets |- (!s t. (s INTER t) SUBSET s) /\ (!s t. (t INTER s) SUBSET s) \ENDTHEOREM \THEOREM IN\_INTER finite\_sets |- !s t x. x IN (s INTER t) = x IN s /\ x IN t \ENDTHEOREM \THEOREM IN\_UNION finite\_sets |- !s t x. x IN (s UNION t) = x IN s \/ x IN t \ENDTHEOREM \THEOREM SUBSET\_INTER\_ABSORPTION finite\_sets |- !s t. s SUBSET t = (s INTER t = s) \ENDTHEOREM \THEOREM SUBSET\_UNION finite\_sets |- (!s t. s SUBSET (s UNION t)) /\ (!s t. s SUBSET (t UNION s)) \ENDTHEOREM \THEOREM SUBSET\_UNION\_ABSORPTION finite\_sets |- !s t. s SUBSET t = (s UNION t = t) \ENDTHEOREM \THEOREM UNION\_ASSOC finite\_sets |- !s t u. (s UNION t) UNION u = s UNION (t UNION u) \ENDTHEOREM \THEOREM UNION\_COMM finite\_sets |- !s t. s UNION t = t UNION s \ENDTHEOREM \THEOREM UNION\_EMPTY finite\_sets |- (!s. {} UNION s = s) /\ (!s. s UNION {} = s) \ENDTHEOREM \THEOREM UNION\_IDEMPOT finite\_sets |- !s. s UNION s = s \ENDTHEOREM \THEOREM UNION\_OVER\_INTER finite\_sets |- !s t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u) \ENDTHEOREM \section{Set difference} \THEOREM DIFF\_DIFF finite\_sets |- !s t. (s DIFF t) DIFF t = s DIFF t \ENDTHEOREM \THEOREM DIFF\_EMPTY finite\_sets |- !s. s DIFF {} = s \ENDTHEOREM \THEOREM DIFF\_EQ\_EMPTY finite\_sets |- !s. s DIFF s = {} \ENDTHEOREM \THEOREM EMPTY\_DIFF finite\_sets |- !s. {} DIFF s = {} \ENDTHEOREM \THEOREM IN\_DIFF finite\_sets |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t \ENDTHEOREM \section{Deletion of an element} \THEOREM DELETE\_COMM finite\_sets |- !x y s. (s DELETE x) DELETE y = (s DELETE y) DELETE x \ENDTHEOREM \THEOREM DELETE\_DEF finite\_sets |- !s x. s DELETE x = s DIFF {x} \ENDTHEOREM \THEOREM DELETE\_DELETE finite\_sets |- !x s. (s DELETE x) DELETE x = s DELETE x \ENDTHEOREM \THEOREM DELETE\_INSERT finite\_sets |- !x y s. (x INSERT s) DELETE y = ((x = y) => s DELETE y | x INSERT (s DELETE y)) \ENDTHEOREM \THEOREM DELETE\_NON\_ELEMENT finite\_sets |- !x s. ~x IN s = (s DELETE x = s) \ENDTHEOREM \THEOREM DELETE\_SUBSET finite\_sets |- !x s. (s DELETE x) SUBSET s \ENDTHEOREM \THEOREM DIFF\_INSERT finite\_sets |- !s t x. s DIFF (x INSERT t) = (s DELETE x) DIFF t \ENDTHEOREM \THEOREM EMPTY\_DELETE finite\_sets |- !x. {} DELETE x = {} \ENDTHEOREM \THEOREM INSERT\_DELETE finite\_sets |- !x s. x IN s ==> (x INSERT (s DELETE x) = s) \ENDTHEOREM \THEOREM IN\_DELETE finite\_sets |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) \ENDTHEOREM \THEOREM IN\_DELETE\_EQ finite\_sets |- !s x x'. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x)) \ENDTHEOREM \THEOREM SUBSET\_DELETE finite\_sets |- !x s t. s SUBSET (t DELETE x) = ~x IN s /\ s SUBSET t \ENDTHEOREM \THEOREM SUBSET\_INSERT\_DELETE finite\_sets |- !x s t. s SUBSET (x INSERT t) = (s DELETE x) SUBSET t \ENDTHEOREM \section{Disjoint sets} \THEOREM DISJOINT\_DEF finite\_sets |- !s t. DISJOINT s t = (s INTER t = {}) \ENDTHEOREM \THEOREM DISJOINT\_DELETE\_SYM finite\_sets |- !s t x. DISJOINT(s DELETE x)t = DISJOINT(t DELETE x)s \ENDTHEOREM \THEOREM DISJOINT\_EMPTY finite\_sets |- !s. DISJOINT {} s /\ DISJOINT s {} \ENDTHEOREM \THEOREM DISJOINT\_EMPTY\_REFL finite\_sets |- !s. (s = {}) = DISJOINT s s \ENDTHEOREM \THEOREM DISJOINT\_INSERT finite\_sets |- !x s t. DISJOINT(x INSERT s)t = DISJOINT s t /\ ~x IN t \ENDTHEOREM \THEOREM DISJOINT\_SYM finite\_sets |- !s t. DISJOINT s t = DISJOINT t s \ENDTHEOREM \THEOREM DISJOINT\_UNION finite\_sets |- !s t u. DISJOINT(s UNION t)u = DISJOINT s u /\ DISJOINT t u \ENDTHEOREM \THEOREM IN\_DISJOINT finite\_sets |- !s t. DISJOINT s t = ~(?x. x IN s /\ x IN t) \ENDTHEOREM \section{The {\tt CHOICE} and {\tt REST} functions} \THEOREM CHOICE\_DEF finite\_sets |- !s. ~(s = {}) ==> (CHOICE s) IN s \ENDTHEOREM \THEOREM CHOICE\_INSERT\_REST finite\_sets |- !s. ~(s = {}) ==> ((CHOICE s) INSERT (REST s) = s) \ENDTHEOREM \THEOREM CHOICE\_NOT\_IN\_REST finite\_sets |- !s. ~(CHOICE s) IN (REST s) \ENDTHEOREM \THEOREM CHOICE\_SING finite\_sets |- !x. CHOICE{x} = x \ENDTHEOREM \THEOREM REST\_DEF finite\_sets |- !s. REST s = s DELETE (CHOICE s) \ENDTHEOREM \THEOREM REST\_PSUBSET finite\_sets |- !s. ~(s = {}) ==> (REST s) PSUBSET s \ENDTHEOREM \THEOREM REST\_SING finite\_sets |- !x. REST{x} = {} \ENDTHEOREM \THEOREM REST\_SUBSET finite\_sets |- !s. (REST s) SUBSET s \ENDTHEOREM \THEOREM SING\_IFF\_EMPTY\_REST finite\_sets |- !s. SING s = ~(s = {}) /\ (REST s = {}) \ENDTHEOREM \section{Image of a function on a set} \THEOREM IMAGE\_COMPOSE finite\_sets |- !f g s. IMAGE(f o g)s = IMAGE f(IMAGE g s) \ENDTHEOREM \THEOREM IMAGE\_DELETE finite\_sets |- !f x s. ~x IN s ==> (IMAGE f(s DELETE x) = IMAGE f s) \ENDTHEOREM \THEOREM IMAGE\_EMPTY finite\_sets |- !f. IMAGE f{} = {} \ENDTHEOREM \THEOREM IMAGE\_EQ\_EMPTY finite\_sets |- !s f. (IMAGE f s = {}) = (s = {}) \ENDTHEOREM \THEOREM IMAGE\_ID finite\_sets |- !s. IMAGE(\x. x)s = s \ENDTHEOREM \THEOREM IMAGE\_IN finite\_sets |- !x s. x IN s ==> (!f. (f x) IN (IMAGE f s)) \ENDTHEOREM \THEOREM IMAGE\_INSERT finite\_sets |- !f x s. IMAGE f(x INSERT s) = (f x) INSERT (IMAGE f s) \ENDTHEOREM \THEOREM IMAGE\_INTER finite\_sets |- !f s t. (IMAGE f(s INTER t)) SUBSET ((IMAGE f s) INTER (IMAGE f t)) \ENDTHEOREM \THEOREM IMAGE\_SUBSET finite\_sets |- !s t. s SUBSET t ==> (!f. (IMAGE f s) SUBSET (IMAGE f t)) \ENDTHEOREM \THEOREM IMAGE\_UNION finite\_sets |- !f s t. IMAGE f(s UNION t) = (IMAGE f s) UNION (IMAGE f t) \ENDTHEOREM \THEOREM IN\_IMAGE finite\_sets |- !f s y. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) \ENDTHEOREM \section{Mappings between sets} \THEOREM BIJ\_COMPOSE finite\_sets |- !f g s t u. BIJ f s t /\ BIJ g t u ==> BIJ(g o f)s u \ENDTHEOREM \THEOREM BIJ\_DEF finite\_sets |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t \ENDTHEOREM \THEOREM BIJ\_EMPTY finite\_sets |- !f. (!s. BIJ f{}s = (s = {})) /\ (!s. BIJ f s{} = (s = {})) \ENDTHEOREM \THEOREM BIJ\_ID finite\_sets |- !s. BIJ(\x. x)s s \ENDTHEOREM \THEOREM IMAGE\_SURJ finite\_sets |- !f s t. SURJ f s t = (IMAGE f s = t) \ENDTHEOREM \THEOREM INJ\_COMPOSE finite\_sets |- !f g s t u. INJ f s t /\ INJ g t u ==> INJ(g o f)s u \ENDTHEOREM \THEOREM INJ\_DEF finite\_sets |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) \ENDTHEOREM \THEOREM INJ\_EMPTY finite\_sets |- !f. (!s. INJ f{}s) /\ (!s. INJ f s{} = (s = {})) \ENDTHEOREM \THEOREM INJ\_ID finite\_sets |- !s. INJ(\x. x)s s \ENDTHEOREM \THEOREM LINV\_DEF finite\_sets |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) \ENDTHEOREM \THEOREM RINV\_DEF finite\_sets |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) \ENDTHEOREM \THEOREM SURJ\_COMPOSE finite\_sets |- !f g s t u. SURJ f s t /\ SURJ g t u ==> SURJ(g o f)s u \ENDTHEOREM \THEOREM SURJ\_DEF finite\_sets |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) \ENDTHEOREM \THEOREM SURJ\_EMPTY finite\_sets |- !f. (!s. SURJ f{}s = (s = {})) /\ (!s. SURJ f s{} = (s = {})) \ENDTHEOREM \THEOREM SURJ\_ID finite\_sets |- !s. SURJ(\x. x)s s \ENDTHEOREM \section{Singleton sets} \THEOREM DELETE\_EQ\_SING finite\_sets |- !s x. x IN s ==> ((s DELETE x = {}) = (s = {x})) \ENDTHEOREM \THEOREM DISJOINT\_SING\_EMPTY finite\_sets |- !x. DISJOINT{x}{} \ENDTHEOREM \THEOREM EQUAL\_SING finite\_sets |- !x y. ({x} = {y}) = (x = y) \ENDTHEOREM \THEOREM INSERT\_SING\_UNION finite\_sets |- !s x. x INSERT s = {x} UNION s \ENDTHEOREM \THEOREM IN\_SING finite\_sets |- !x y. x IN {y} = (x = y) \ENDTHEOREM \THEOREM NOT\_EMPTY\_SING finite\_sets |- !x. ~({} = {x}) \ENDTHEOREM \THEOREM NOT\_SING\_EMPTY finite\_sets |- !x. ~({x} = {}) \ENDTHEOREM \THEOREM SING finite\_sets |- !x. SING{x} \ENDTHEOREM \THEOREM SING\_DEF finite\_sets |- !s. SING s = (?x. s = {x}) \ENDTHEOREM \THEOREM SING\_DELETE finite\_sets |- !x. {x} DELETE x = {} \ENDTHEOREM \section{Cardinality of sets} \THEOREM CARD\_DEF finite\_sets |- (CARD{} = 0) /\ (!s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s))) \ENDTHEOREM \THEOREM CARD\_DELETE finite\_sets |- !s x. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s) \ENDTHEOREM \THEOREM CARD\_DIFF finite\_sets |- !t s. CARD(s DIFF t) = (CARD s) - (CARD(s INTER t)) \ENDTHEOREM \THEOREM CARD\_EMPTY finite\_sets |- CARD{} = 0 \ENDTHEOREM \THEOREM CARD\_EQ\_0 finite\_sets |- !s. (CARD s = 0) = (s = {}) \ENDTHEOREM \THEOREM CARD\_INSERT finite\_sets |- !s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)) \ENDTHEOREM \THEOREM CARD\_INTER\_LESS\_EQ finite\_sets |- !s t. (CARD(s INTER t)) <= (CARD s) \ENDTHEOREM \THEOREM CARD\_PSUBSET finite\_sets |- !s t. t PSUBSET s ==> (CARD t) < (CARD s) \ENDTHEOREM \THEOREM CARD\_SING finite\_sets |- !x. CARD{x} = 1 \ENDTHEOREM \THEOREM CARD\_SUBSET finite\_sets |- !s t. t SUBSET s ==> (CARD t) <= (CARD s) \ENDTHEOREM \THEOREM CARD\_UNION finite\_sets |- !s t. (CARD(s UNION t)) + (CARD(s INTER t)) = (CARD s) + (CARD t) \ENDTHEOREM \THEOREM LESS\_CARD\_DIFF finite\_sets |- !t s. (CARD t) < (CARD s) ==> 0 < (CARD(s DIFF t)) \ENDTHEOREM \THEOREM SING\_IFF\_CARD1 finite\_sets |- !s. SING s = (CARD s = 1) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/Manual/finite_sets.toc0000640000212700021270000000601205535604274022115 0ustar cammcamm\contentsline {chapter}{\numberline {1}The finite{\unhbox \voidb@x \kern 0.15ex \vbox {\hrule height0.1ex width0.3em}\kern 0.2ex}sets Library}{1} \contentsline {section}{\numberline {1.1}The type definition}{1} \contentsline {section}{\numberline {1.2}Abstract characterization of the type {\ptt (*)set}}{2} \contentsline {section}{\numberline {1.3}The set induction tactic}{3} \contentsline {subsection}{\numberline {1.3.1}Parser and pretty-printer support}{4} \contentsline {section}{\numberline {1.4}Set inclusion}{5} \contentsline {section}{\numberline {1.5}Union, intersection, and set difference}{6} \contentsline {section}{\numberline {1.6}Disjoint sets}{6} \contentsline {section}{\numberline {1.7}Insertion and deletion of an element}{7} \contentsline {subsection}{\numberline {1.7.1}Conversions for enumerated finite sets}{7} \contentsline {subsubsection}{\numberline {1.7.1.1}Membership}{7} \contentsline {subsubsection}{\numberline {1.7.1.2}Union}{9} \contentsline {subsubsection}{\numberline {1.7.1.3}Insertion}{10} \contentsline {subsubsection}{\numberline {1.7.1.4}Deletion}{11} \contentsline {section}{\numberline {1.8}Singleton sets}{11} \contentsline {section}{\numberline {1.9}The {\ptt CHOICE} and {\ptt REST} functions}{12} \contentsline {section}{\numberline {1.10}Image of a function on a set}{12} \contentsline {subsection}{\numberline {1.10.1}Theorem-proving support}{13} \contentsline {section}{\numberline {1.11}Mappings between sets}{14} \contentsline {section}{\numberline {1.12}Finite and infinite sets}{14} \contentsline {subsection}{\numberline {1.12.1}Theorem-proving support}{15} \contentsline {section}{\numberline {1.13}Cardinality of finite sets}{16} \contentsline {section}{\numberline {1.14}Using the library}{16} \contentsline {subsection}{\numberline {1.14.1}Example session}{17} \contentsline {subsection}{\numberline {1.14.2}The {\ptt load\unhbox \voidb@x \kern .06em \vbox {\hrule width.3em}finite\unhbox \voidb@x \kern .06em \vbox {\hrule width.3em}sets} function}{18} \contentsline {chapter}{\numberline {2}ML Functions in the Library}{19} \contentsline {chapter}{\numberline {3}Pre-proved Theorems}{29} \contentsline {section}{\numberline {3.1}The type definition}{29} \contentsline {section}{\numberline {3.2}Basic properties of {\ptt EMPTY}, {\ptt INSERT}, and {\ptt IN}}{29} \contentsline {section}{\numberline {3.3}Set inclusion}{31} \contentsline {section}{\numberline {3.4}Intersection and union}{32} \contentsline {section}{\numberline {3.5}Set difference}{33} \contentsline {section}{\numberline {3.6}Deletion of an element}{33} \contentsline {section}{\numberline {3.7}Disjoint sets}{34} \contentsline {section}{\numberline {3.8}The {\ptt CHOICE} and {\ptt REST} functions}{35} \contentsline {section}{\numberline {3.9}Image of a function on a set}{36} \contentsline {section}{\numberline {3.10}Mappings between sets}{37} \contentsline {section}{\numberline {3.11}Singleton sets}{38} \contentsline {section}{\numberline {3.12}Cardinality of sets}{38} \contentsline {chapter}{References}{41} \contentsline {chapter}{Index}{42} hol88-2.02.19940316/Library/finite_sets/Manual/description.aux0000640000212700021270000000760105535604254022137 0ustar cammcamm\relax \citation{melham} \citation{manna} \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {1}The finite{\unhbox \voidb@x \kern 0.15ex \vbox {\hrule height0.1ex width0.3em}\kern 0.2ex}sets Library}{1}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.1}The type definition}{1}} \citation{ind-defs} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.2}Abstract characterization of the type {\string\ptt\space (*)set}}{2}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.3}The set induction tactic}{3}} \citation{manna} \citation{description} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.3.1}Parser and pretty-printer support}{4}} \newlabel{finite}{{1.3.1}{4}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.4}Set inclusion}{5}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.5}Union, intersection, and set difference}{6}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.6}Disjoint sets}{6}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.7}Insertion and deletion of an element}{7}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.7.1}Conversions for enumerated finite sets}{7}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.7.1.1}Membership}{7}} \newlabel{inconv}{{1.7.1.1}{7}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.7.1.2}Union}{9}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.7.1.3}Insertion}{10}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.7.1.4}Deletion}{11}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.8}Singleton sets}{11}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.9}The {\string\ptt\space CHOICE} and {\string\ptt\space REST} functions}{12}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.10}Image of a function on a set}{12}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.10.1}Theorem-proving support}{13}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.11}Mappings between sets}{14}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.12}Finite and infinite sets}{14}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.12.1}Theorem-proving support}{15}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.13}Cardinality of finite sets}{16}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.14}Using the library}{16}} \newlabel{using}{{1.14}{16}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.14.1}Example session}{17}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.14.2}The {\string\ptt\space load\unhbox \voidb@x \kern .06em \vbox {\hrule width.3em}finite\unhbox \voidb@x \kern .06em \vbox {\hrule width.3em}sets} function}{18}} \global\@namedef{cp@description}{ \setcounter{page}{19} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{1} \setcounter{section}{14} \setcounter{subsection}{2} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/finite_sets/Manual/entries.aux0000640000212700021270000000136405535604263021265 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {2}ML Functions in the Library}{19}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \newlabel{entries}{{2}{19}} \global\@namedef{cp@entries}{ \setcounter{page}{28} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{2} \setcounter{section}{0} \setcounter{subsection}{2} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/finite_sets/Manual/finite_sets.tex0000640000212700021270000000635205147526715022141 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: finite_sets library (standard latex style) % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % Define a few other commands. % --------------------------------------------------------------------- \def\bk{{\tt\char`\\}} \def\lb{{\tt\char`\{}} \def\rb{{\tt\char`\}}} \def\vb{{\tt\char`\|}} % --------------------------------------------------------------------- % % Macro to make a nice underscore in the library name when typeset in % % boldface. Standard \_ macro doesn't give tall enough underscore. % % The underscore is used on the titlepage and in Chapter 1 title (hence % % also on running heads) --- all in boldface. % % --------------------------------------------------------------------- % \def\und{\leavevmode% \kern0.15ex \vbox{\hrule height0.1ex width0.3em}\kern0.2ex} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{description} % --------------------------------------------------------------------- % Reference manual entries for functions % --------------------------------------------------------------------- \include{entries} % --------------------------------------------------------------------- % Listing of theorems % --------------------------------------------------------------------- \include{theorems} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/finite_sets/Manual/theorems.aux0000640000212700021270000000423105535604273021437 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {3}Pre-proved Theorems}{29}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \newlabel{theorems}{{3}{29}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.1}The type definition}{29}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.2}Basic properties of {\string\ptt\space EMPTY}, {\string\ptt\space INSERT}, and {\string\ptt\space IN}}{29}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.3}Set inclusion}{31}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.4}Intersection and union}{32}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.5}Set difference}{33}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.6}Deletion of an element}{33}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.7}Disjoint sets}{34}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.8}The {\string\ptt\space CHOICE} and {\string\ptt\space REST} functions}{35}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.9}Image of a function on a set}{36}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.10}Mappings between sets}{37}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.11}Singleton sets}{38}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {3.12}Cardinality of sets}{38}} \global\@namedef{cp@theorems}{ \setcounter{page}{40} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{12} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/finite_sets/Manual/references.aux0000640000212700021270000000123705535604273021735 0ustar cammcamm\relax \bibcite{manna}{1} \bibcite{melham}{2} \bibcite{ind-defs}{3} \bibcite{description}{4} \@writefile{toc}{\string\contentsline\space {chapter}{References}{41}} \global\@namedef{cp@references}{ \setcounter{page}{42} \setcounter{equation}{0} \setcounter{enumi}{4} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{12} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/finite_sets/Manual/index.aux0000640000212700021270000000107705535604274020726 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{Index}{42}} \global\@namedef{cp@index}{ \setcounter{page}{45} \setcounter{equation}{0} \setcounter{enumi}{4} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{12} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/finite_sets/Manual/Makefile0000640000212700021270000000650205267276563020546 0ustar cammcamm# ===================================================================== # Makefile for the finite_sets library documentation # ===================================================================== # --------------------------------------------------------------------- # Pathname to the finite_sets help files # --------------------------------------------------------------------- Help=../help # --------------------------------------------------------------------- # Pathname to the doc-to-tex script and doc-to-tex.sed file # --------------------------------------------------------------------- DOCTOTEX=../../../Manual/Reference/bin/doc-to-tex DOCTOTEXSED=../../../Manual/Reference/bin/doc-to-tex.sed # --------------------------------------------------------------------- # Pathname to the makeindex script # --------------------------------------------------------------------- MAKEINDEX=../../../Manual/LaTeX/makeindex ../../../ default: @echo "INSTRUCTIONS: Type \"make all\" to make the documentation" # --------------------------------------------------------------------- # Remove all trace of previous LaTeX jobs # --------------------------------------------------------------------- clean: rm -f *.dvi *.aux *.toc *.log *.idx *.ilg @echo "\begin{theindex}" > index.tex @echo "\mbox{}" >> index.tex @echo "\end{theindex}" >> index.tex tex: theorems ids @echo "TeX files made" ids: @echo "\chapter{ML Functions in the Library}">entries.tex @echo "\label{entries}">>entries.tex @echo "\input{entries-intro}" >> entries.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex theorems: @echo "\chapter{Pre-proved Theorems}" > theorems.tex @echo "\input{theorems-intro}" >> theorems.tex @echo "\section{The type definition}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/sdef theorems.tex @echo "\section{Basic properties of {\tt EMPTY}, {\tt INSERT}, and {\tt IN}}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/basic theorems.tex @echo "\section{Set inclusion}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/subs theorems.tex @echo "\section{Intersection and union}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/unin theorems.tex @echo "\section{Set difference}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/diff theorems.tex @echo "\section{Deletion of an element}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/del theorems.tex @echo "\section{Disjoint sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/disj theorems.tex @echo "\section{The {\tt CHOICE} and {\tt REST} functions}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/chre theorems.tex @echo "\section{Image of a function on a set}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/image theorems.tex @echo "\section{Mappings between sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/fun theorems.tex @echo "\section{Singleton sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/sing theorems.tex @echo "\section{Cardinality of sets}">>theorems.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/thms/card theorems.tex index: ${MAKEINDEX} finite_sets.idx index.tex finite_sets: latex finite_sets.tex all: make clean; make tex; make finite_sets; make index; make finite_sets hol88-2.02.19940316/Library/finite_sets/Manual/READ-ME0000640000212700021270000000007305304703521020015 0ustar cammcammWARNING: This manual is an incomplete and inaccurate draft.hol88-2.02.19940316/Library/finite_sets/help/0000750000212700021270000000000005227250240016571 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/entries/0000750000212700021270000000000005227253615020253 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/entries/IN_CONV.doc0000640000212700021270000000443405147526716022111 0ustar cammcamm\DOC IN_CONV \TYPE {IN_CONV : conv -> conv} \SYNOPSIS Decision procedure for membership in finite sets. \LIBRARY sets \DESCRIBE The function {IN_CONV} is a parameterized conversion for proving or disproving membership assertions of the general form: { "t IN {{t1,...,tn}}" } \noindent where {{{t1,...,tn}}} is a set of type {(ty)set} and {t} is a value of the base type {ty}. The first argument to {IN_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion, the function {IN_CONV} returns a conversion that maps a term of the form {"t IN {{t1,...,tn}}"} to the theorem { |- t IN {{t1,...,tn}} = T } \noindent if {t} is alpha-equivalent to any {ti}, or if the supplied conversion proves {|- (t = ti) = T} for any {ti}. If the supplied conversion proves {|- (t = ti) = F} for every {ti}, then the result is the theorem { |- t IN {{t1,...,tn}} = F } \noindent In all other cases, {IN_CONV} will fail. \EXAMPLE In the following example, the conversion {num_EQ_CONV} is supplied as a parameter and used to test equality of the candidate element {1} with the actual elements of the given set. { #IN_CONV num_EQ_CONV "2 IN {{0,SUC 1,3}}";; |- 2 IN {{0,SUC 1,3}} = T } \noindent The result is {T} because {num_EQ_CONV} is able to prove that {2} is equal to {SUC 1}. An example of a negative result is: { #IN_CONV num_EQ_CONV "1 IN {{0,2,3}}";; |- 1 IN {{0,2,3}} = F } \noindent Finally the behaviour of the supplied conversion is irrelevant when the value to be tested for membership is alpha-equivalent to an actual element: { #IN_CONV NO_CONV "1 IN {{3,2,1}}";; |- 1 IN {{3,2,1}} = T } \noindent The conversion {NO_CONV} always fails, but {IN_CONV} is nontheless able in this case to prove the required result. \FAILURE {IN_CONV conv} fails if applied to a term that is not of the form {"t IN {{t1,...,tn}}"}. A call {IN_CONV conv "t IN {{t1,...,tn}}"} fails unless the term {t} is alpha-equivalent to some {ti}, or {conv "t = ti"} returns {|- (t = ti) = T} for some {ti}, or {conv "t = ti"} returns {|- (t = ti) = F} for every {ti}. \ENDDOC hol88-2.02.19940316/Library/finite_sets/help/entries/INSERT_CONV.doc0000640000212700021270000000543605147526716022612 0ustar cammcamm\DOC INSERT_CONV \TYPE {INSERT_CONV : conv -> conv} \SYNOPSIS Reduce {x INSERT {{x1,...,x,...,xn}}} to {{{x1,...,x,...,xn}}}. \LIBRARY sets \DESCRIBE The function {INSERT_CONV} is a parameterized conversion for reducing finite sets of the form {"t INSERT {{t1,...,tn}}"}, where {{{t1,...,tn}}} is a set of type {(ty)set} and {t} is equal to some element {ti} of this set. The first argument to {INSERT_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion, the function {INSERT_CONV} returns a conversion that maps a term of the form {"t INSERT {{t1,...,tn}}"} to the theorem { |- t INSERT {{t1,...,tn}} = {{t1,...,tn}} } \noindent if {t} is alpha-equivalent to any {ti} in the set {{{t1,...,tn}}}, or if the supplied conversion proves {|- (t = ti) = T} for any {ti}. \EXAMPLE In the following example, the conversion {num_EQ_CONV} is supplied as a parameter and used to test equality of the inserted value {2} with the remaining elements of the set. { #INSERT_CONV num_EQ_CONV "2 INSERT {{1,SUC 1,3}}";; |- {{2,1,SUC 1,3}} = {{1,SUC 1,3}} } \noindent In this example, the supplied conversion {num_EQ_CONV} is able to prove that {2} is equal to {SUC 1} and the set is therefore reduced. Note that {"2 INSERT {{1,SUC 1,3}}"} is just {"{{2,1,SUC 1,3}}"}. A call to {INSERT_CONV} fails when the value being inserted is provably not equal to any of the remaining elements: { #INSERT_CONV num_EQ_CONV "1 INSERT {{2,3}}";; evaluation failed INSERT_CONV } \noindent But this failure can, if desired, be caught using {TRY_CONV}. The behaviour of the supplied conversion is irrelevant when the inserted value is alpha-equivalent to one of the remaining elements: { #INSERT_CONV NO_CONV "(y:*) INSERT {{x,y,z}}";; |- {{y,x,y,z}} = {{x,y,z}} } \noindent The conversion {NO_CONV} always fails, but {INSERT_CONV} is nontheless able in this case to prove the required result. Note that {DEPTH_CONV(INSERT_CONV conv)} can be used to remove duplicate elements from a finite set, but the following conversion is faster: { #letrec REDUCE_CONV conv tm = (SUB_CONV (REDUCE_CONV conv) THENC (TRY_CONV (INSERT_CONV conv))) tm;; REDUCE_CONV = - : (conv -> conv) #REDUCE_CONV num_EQ_CONV "{{1,2,1,3,2,4,3,5,6}}";; |- {{1,2,1,3,2,4,3,5,6}} = {{1,2,4,3,5,6}} } \FAILURE {INSERT_CONV conv} fails if applied to a term not of the form {"t INSERT {{t1,...,tn}}"}. A call {INSERT_CONV conv "t INSERT {{t1,...,tn}}"} fails unless {t} is alpha-equivalent to some {ti}, or {conv "t = ti"} returns {|- (t = ti) = T} for some {ti}. \SEEALSO DELETE_CONV. \ENDDOC hol88-2.02.19940316/Library/finite_sets/help/entries/IMAGE_CONV.doc0000640000212700021270000000760305147526717022427 0ustar cammcamm\DOC IMAGE_CONV \TYPE {IMAGE_CONV : conv -> conv -> conv} \SYNOPSIS Compute the image of a function on a finite set. \LIBRARY sets \DESCRIBE The function {IMAGE_CONV} is a parameterized conversion for computing the image of a function {f:ty1->ty2} on a finite set {"{{t1,...,tn}}"} of type {(ty1)set}. The first argument to {IMAGE_CONV} is expected to be a conversion that computes the result of applying the function {f} to each element of this set. When applied to a term {"f ti"}, this conversion should return a theorem of the form {|- (f ti) = ri}, where {ri} is the result of applying the function {f} to the element {ti}. This conversion is used by {IMAGE_CONV} to compute a theorem of the form { |- IMAGE f {{t1,...,tn}} = {{r1,...,rn}} } \noindent The second argument to {IMAGE_CONV} is used (optionally) to simplify the resulting image set {{{r1,...,rn}}} by removing redundant occurrences of values. This conversion expected to decide equality of values of the result type {ty2}; given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty2}, the conversion should return either {|- (e1 = e2) = T} or {|- (e1 = e2) = F}, as appropriate. Given appropriate conversions {conv1} and {conv2}, the function {IMAGE_CONV} returns a conversion that maps a term of the form {"IMAGE f {{t1,...,tn}}"} to the theorem { |- IMAGE f {{t1,...,tn}} = {{rj,...,rk}} } \noindent where {conv1} proves a theorem of the form {|- (f ti) = ri} for each element {ti} of the set {{{t1,...,tn}}}, and where the set {{{rj,...,rk}}} is the smallest subset of {{{r1,...,rn}}} such no two elements are alpha-equivalent and {conv2} does not map {"rl = rm"} to the theorem {|- (rl = rm) = T} for any pair of values {rl} and {rm} in {{{rj,...,rk}}}. That is, {{{rj,...,rk}}} is the set obtained by removing multiple occurrences of values from the set {{{r1,...,rn}}}, where the equality conversion {conv2} (or alpha-equivalence) is used to determine which pairs of terms in {{{r1,...,rn}}} are equal. \EXAMPLE The following is a very simple example in which {REFL} is used to construct the result of applying the function {f} to each element of the set {{{1,2,1,4}}}, and {NO_CONV} is the supplied `equality conversion'. { #IMAGE_CONV REFL NO_CONV "IMAGE (f:num->num) {{1,2,1,4}}";; |- IMAGE f{{1,2,1,4}} = {{f 2,f 1,f 4}} } \noindent The result contains only one occurrence of `{f 1}', even though {NO_CONV} always fails, since {IMAGE_CONV} simplifies the resulting set by removing elements that are redundant up to alpha-equivalence. For the next example, we construct a conversion that maps {SUC n} for any numeral {n} to the numeral standing for the successor of {n}. { #let SUC_CONV tm = let n = int_of_string(fst(dest_const(rand tm))) in let sucn = mk_const(string_of_int(n+1), ":num") in SYM (num_CONV sucn);; SUC_CONV = - : conv } \noindent The result is a conversion that inverts {num_CONV}: { #num_CONV "4";; |- 4 = SUC 3 #SUC_CONV "SUC 3";; |- SUC 3 = 4 } \noindent The conversion {SUC_CONV} can then be used to compute the image of the successor function on a finite set: { #IMAGE_CONV SUC_CONV NO_CONV "IMAGE SUC {{1,2,1,4}}";; |- IMAGE SUC{{1,2,1,4}} = {{3,2,5}} } \noindent Note that {2} (= {SUC 1}) appears only once in the resulting set. Fianlly, here is an example of using {IMAGE_CONV} to compute the image of a paired addition function on a set of pairs of numbers: { #IMAGE_CONV (PAIRED_BETA_CONV THENC ADD_CONV) num_EQ_CONV "IMAGE (\(n,m).n+m) {{(1,2), (3,4), (0,3), (1,3)}}";; |- IMAGE(\(n,m). n + m){{(1,2),(3,4),(0,3),(1,3)}} = {{7,3,4}} } \FAILURE {IMAGE_CONV conv1 conv2} fails if applied to a term not of the form {"IMAGE f {{t1,...,tn}}"}. An application of {IMAGE_CONV conv1 conv2} to a term {"IMAGE f {{t1,...,tn}}"} fails unless for all {ti} in the set {{{t1,...,tn}}}, evaluating {conv1 "f ti"} returns {|- (f ti) = ri} for some {ri}. \ENDDOC hol88-2.02.19940316/Library/finite_sets/help/entries/DELETE_CONV.doc0000640000212700021270000000371705147526717022551 0ustar cammcamm\DOC DELETE_CONV \TYPE {DELETE_CONV : conv -> conv} \SYNOPSIS Reduce {{{x1,...,xn}} DELETE x} by deleting {x} from {{{x1,...,xn}}}. \LIBRARY sets \DESCRIBE The function {DELETE_CONV} is a parameterized conversion for reducing finite sets of the form {"{{t1,...,tn}} DELETE t"}, where {{{t1,...,tn}}} is a set of type {(ty)set} and {t} is a term of type {ty}. The first argument to {DELETE_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion {conv}, the function {DELETE_CONV} returns a conversion that maps a term of the form {"{{t1,...,tn}} DELETE t"} to the theorem { |- {{t1,...,tn}} DELETE t = {{ti,...,tj}} } \noindent where {{{ti,...,tj}}} is the subset of {{{t1,...,tn}}} for which the supplied equality conversion {conv} proves { |- (ti = t) = F, ..., |- (tj = t) = F } \noindent and for all the elements {tk} in {{{t1,...,tn}}} but not in {{{ti,...,tj}}}, either {conv} proves {|- (tk = t) = T} or {tk} is alpha-equivalent to {t}. That is, the reduced set {{{ti,...,tj}}} comprises all those elements of the original set that are provably not equal to the deleted element {t}. \EXAMPLE In the following example, the conversion {num_EQ_CONV} is supplied as a parameter and used to test equality of the deleted value {2} with the elements of the set. { #DELETE_CONV num_EQ_CONV "{{2,1,SUC 1,3}} DELETE 2";; |- {{2,1,SUC 1,3}} DELETE 2 = {{1,3}} } \FAILURE {DELETE_CONV conv} fails if applied to a term not of the form {"{{t1,...,tn}} DELETE t"}. A call {DELETE_CONV conv "{{t1,...,tn}} DELETE t"} fails unless for each element {ti} of the set {{{t1,...,tn}}}, the term {t} is either alpha-equivalent to {ti} or {conv "ti = t"} returns {|- (ti = t) = T} or {|- (ti = t) = F}. \SEEALSO INSERT_CONV. \ENDDOC hol88-2.02.19940316/Library/finite_sets/help/entries/UNION_CONV.doc0000640000212700021270000000462605147526717022477 0ustar cammcamm\DOC UNION_CONV \TYPE {UNION_CONV : conv -> conv} \SYNOPSIS Reduce {{{t1,...,tn}} UNION s} to {t1 INSERT (... (tn INSERT s))}. \LIBRARY sets \DESCRIBE The function {UNION_CONV} is a parameterized conversion for reducing sets of the form {"{{t1,...,tn}} UNION s"}, where {{{t1,...,tn}}} and {s} are sets of type {(ty)set}. The first argument to {UNION_CONV} is expected to be a conversion that decides equality between values of the base type {ty}. Given an equation {"e1 = e2"}, where {e1} and {e2} are terms of type {ty}, this conversion should return the theorem {|- (e1 = e2) = T} or the theorem {|- (e1 = e2) = F}, as appropriate. Given such a conversion, the function {UNION_CONV} returns a conversion that maps a term of the form {"{{t1,...,tn}} UNION s"} to the theorem { |- t UNION {{t1,...,tn}} = ti INSERT ... (tj INSERT s) } \noindent where {{{ti,...,tj}}} is the set of all terms {t} that occur as elements of {{{t1,...,tn}}} for which the conversion {IN_CONV conv} fails to prove that {|- (t IN s) = T} (that is, either by proving {|- (t IN s) = F} instead, or by failing outright). \EXAMPLE In the following example, {num_EQ_CONV} is supplied as a parameter to {UNION_CONV} and used to test for membership of each element of the first finite set {{{1,2,3}}} of the union in the second finite set {{{SUC 0,3,4}}}. { #UNION_CONV num_EQ_CONV "{{1,2,3}} UNION {{SUC 0,3,4}}";; |- {{1,2,3}} UNION {{SUC 0,3,4}} = {{2,SUC 0,3,4}} } \noindent The result is {{{2,SUC 0,3,4}}}, rather than {{{1,2,SUC 0,3,4}}}, because {UNION_CONV} is able by means of a call to { IN_CONV num_EQ_CONV "1 IN {{SUC 0,3,4}}" } \noindent to prove that {1} is already an element of the set {{{SUC 0,3,4}}}. The conversion supplied to {UNION_CONV} need not actually prove equality of elements, if simplification of the resulting set is not desired. For example: { #UNION_CONV NO_CONV "{{1,2,3}} UNION {{SUC 0,3,4}}";; |- {{1,2,3}} UNION {{SUC 0,3,4}} = {{1,2,SUC 0,3,4}} } \noindent In this case, the resulting set is just left unsimplified. Moreover, the second set argument to {UNION} need not be a finite set: { #UNION_CONV NO_CONV "{{1,2,3}} UNION s";; |- {{1,2,3}} UNION s = 1 INSERT (2 INSERT (3 INSERT s)) } \noindent And, of course, in this case the conversion argument to {UNION_CONV} is irrelevant. \FAILURE {UNION_CONV conv} fails if applied to a term not of the form {"{{t1,...,tn}} UNION s"}. \SEEALSO IN_CONV. \ENDDOC hol88-2.02.19940316/Library/finite_sets/help/entries/SET_INDUCT_TAC.doc0000640000212700021270000000224505147537714023144 0ustar cammcamm\DOC SET_INDUCT_TAC \TYPE {SET_INDUCT_TAC : tactic} \SYNOPSIS Tactic for induction on finite sets. \LIBRARY finite_sets \DESCRIBE {SET_INDUCT_TAC} is an induction tacic for proving properties of finite sets. When applied to a goal of the form { !s:(*)set. P[s] } \noindent {SET_INDUCT_TAC} reduces this goal to proving that the property {\s.P[s]} holds of the empty set and is preserved by insertion of an element into an arbitrary finite set. Since every finite set can be built up from the empty set {"{{}}"} by repeated insertion of values, these subgoals imply that the property {\s.P[s]} holds of all finite sets. The tactic specification of {SET_INDUCT_TAC} is: { A ?- !s.P ================================================== SET_INDUCT_TAC A |- P[{{}}/s] A u {{P[s'/s], ~e IN s'}} ?- P[e INSERT s'/s] } \noindent where {e} is a variable chosen so as not to appear free in the assumptions {A}, and {s'} is a primed variant of {s} that does not appear free in {A} (usually, {s'} is just {s}). \FAILURE {SET_INDUCT_TAC (A,g)} fails unless {g} has the form {!s.P}, where the variable {s} has type {(ty)set} for some type {ty}. \ENDDOC hol88-2.02.19940316/Library/finite_sets/help/thms/0000750000212700021270000000000005227250242017546 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/sdef/0000750000212700021270000000000005227253750020476 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/sdef/set_TY_DEF.doc0000640000212700021270000000012405147526722023053 0ustar cammcamm\THEOREM set_TY_DEF finite_sets |- ?rep. TYPE_DEFINITION IS_SET_REP rep \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sdef/IS_SET_REP.doc0000640000212700021270000000035605147526722022731 0ustar cammcamm\THEOREM IS_SET_REP finite_sets |- IS_SET_REP(\x. F) /\ (!s. IS_SET_REP s ==> (!x. IS_SET_REP(\y. (y = x) \/ s y))) /\ (!P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. IS_SET_REP s ==> P s)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sdef/FINITE_SET_DEF.doc0000640000212700021270000000045605147526723023346 0ustar cammcamm\THEOREM FINITE_SET_DEF finite_sets |- (!x. ~x IN {{}}) /\ (!x y s. x IN (y INSERT s) = (x = y) \/ x IN s) /\ (!x s. x INSERT (x INSERT s) = x INSERT s) /\ (!x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)) /\ (!P. P{{}} /\ (!s. P s ==> (!e. P(e INSERT s))) ==> (!s. P s)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/0000750000212700021270000000000005227254006020461 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/card/LESS_CARD_DIFF.doc0000640000212700021270000000014605223320673023301 0ustar cammcamm\THEOREM LESS_CARD_DIFF finite_sets |- !t s. (CARD t) < (CARD s) ==> 0 < (CARD(s DIFF t)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_DEF.doc0000640000212700021270000000017605147526723022355 0ustar cammcamm\THEOREM CARD_DEF finite_sets |- (CARD{{}} = 0) /\ (!s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s))) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_DELETE.doc0000640000212700021270000000015305147526723022714 0ustar cammcamm\THEOREM CARD_DELETE finite_sets |- !s x. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_EMPTY.doc0000640000212700021270000000007405147526723022652 0ustar cammcamm\THEOREM CARD_EMPTY finite_sets |- CARD{{}} = 0 \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_EQ_0.doc0000640000212700021270000000011405147526724022474 0ustar cammcamm\THEOREM CARD_EQ_0 finite_sets |- !s. (CARD s = 0) = (s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_INSERT.doc0000640000212700021270000000015205147526724022756 0ustar cammcamm\THEOREM CARD_INSERT finite_sets |- !s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_INTER_LESS_EQ.doc0000640000212700021270000000013305147526724024045 0ustar cammcamm\THEOREM CARD_INTER_LESS_EQ finite_sets |- !s t. (CARD(s INTER t)) <= (CARD s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_PSUBSET.doc0000640000212700021270000000013305147526724023076 0ustar cammcamm\THEOREM CARD_PSUBSET finite_sets |- !s t. t PSUBSET s ==> (CARD t) < (CARD s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_SING.doc0000640000212700021270000000010005147526724022503 0ustar cammcamm\THEOREM CARD_SING finite_sets |- !x. CARD{{x}} = 1 \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/SING_IFF_CARD1.doc0000640000212700021270000000011505147526724023256 0ustar cammcamm\THEOREM SING_IFF_CARD1 finite_sets |- !s. SING s = (CARD s = 1) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_SUBSET.doc0000640000212700021270000000013205147526724022755 0ustar cammcamm\THEOREM CARD_SUBSET finite_sets |- !s t. t SUBSET s ==> (CARD t) <= (CARD s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_UNION.doc0000640000212700021270000000016105147526725022643 0ustar cammcamm\THEOREM CARD_UNION finite_sets |- !s t. (CARD(s UNION t)) + (CARD(s INTER t)) = (CARD s) + (CARD t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/card/CARD_DIFF.doc0000640000212700021270000000014205151736327022456 0ustar cammcamm\THEOREM CARD_DIFF finite_sets |- !t s. CARD(s DIFF t) = (CARD s) - (CARD(s INTER t)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/0000750000212700021270000000000005227254034020511 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/sing/DELETE_EQ_SING.doc0000640000212700021270000000015005147526725023356 0ustar cammcamm\THEOREM DELETE_EQ_SING finite_sets |- !s x. x IN s ==> ((s DELETE x = {{}}) = (s = {{x}})) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/DISJOINT_SING_EMPTY.doc0000640000212700021270000000011605147526725024232 0ustar cammcamm\THEOREM DISJOINT_SING_EMPTY finite_sets |- !x. DISJOINT{{x}}{{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/EQUAL_SING.doc0000640000212700021270000000011705147526726022702 0ustar cammcamm\THEOREM EQUAL_SING finite_sets |- !x y. ({{x}} = {{y}}) = (x = y) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/INSERT_SING_UNION.doc0000640000212700021270000000012705147526726024010 0ustar cammcamm\THEOREM INSERT_SING_UNION finite_sets |- !s x. x INSERT s = {{x}} UNION s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/IN_SING.doc0000640000212700021270000000010705147526726022340 0ustar cammcamm\THEOREM IN_SING finite_sets |- !x y. x IN {{y}} = (x = y) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/NOT_EMPTY_SING.doc0000640000212700021270000000010705147526726023450 0ustar cammcamm\THEOREM NOT_EMPTY_SING finite_sets |- !x. ~({{}} = {{x}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/NOT_SING_EMPTY.doc0000640000212700021270000000010705147526726023450 0ustar cammcamm\THEOREM NOT_SING_EMPTY finite_sets |- !x. ~({{x}} = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/SING.doc0000640000212700021270000000006705147526727021760 0ustar cammcamm\THEOREM SING finite_sets |- !x. SING{{x}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/SING_DEF.doc0000640000212700021270000000011205147526727022425 0ustar cammcamm\THEOREM SING_DEF finite_sets |- !s. SING s = (?x. s = {{x}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/sing/SING_DELETE.doc0000640000212700021270000000011205147526727022771 0ustar cammcamm\THEOREM SING_DELETE finite_sets |- !x. {{x}} DELETE x = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/0000750000212700021270000000000005227254132020471 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/chre/CHOICE_DEF.doc0000640000212700021270000000012305147526727022602 0ustar cammcamm\THEOREM CHOICE_DEF finite_sets |- !s. ~(s = {{}}) ==> (CHOICE s) IN s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/CHOICE_INSERT_REST.doc0000640000212700021270000000015405147526727024051 0ustar cammcamm\THEOREM CHOICE_INSERT_REST finite_sets |- !s. ~(s = {{}}) ==> ((CHOICE s) INSERT (REST s) = s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/CHOICE_NOT_IN_REST.doc0000640000212700021270000000012305147526730024061 0ustar cammcamm\THEOREM CHOICE_NOT_IN_REST finite_sets |- !s. ~(CHOICE s) IN (REST s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/CHOICE_SING.doc0000640000212700021270000000010405147526730022735 0ustar cammcamm\THEOREM CHOICE_SING finite_sets |- !x. CHOICE{{x}} = x \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/REST_DEF.doc0000640000212700021270000000011605147526730022421 0ustar cammcamm\THEOREM REST_DEF finite_sets |- !s. REST s = s DELETE (CHOICE s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/REST_PSUBSET.doc0000640000212700021270000000013005147526730023144 0ustar cammcamm\THEOREM REST_PSUBSET finite_sets |- !s. ~(s = {{}}) ==> (REST s) PSUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/REST_SING.doc0000640000212700021270000000010305147526730022557 0ustar cammcamm\THEOREM REST_SING finite_sets |- !x. REST{{x}} = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/REST_SUBSET.doc0000640000212700021270000000010605147526730023027 0ustar cammcamm\THEOREM REST_SUBSET finite_sets |- !s. (REST s) SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/chre/SING_IFF_EMPTY_REST.doc0000640000212700021270000000014405147526731024227 0ustar cammcamm\THEOREM SING_IFF_EMPTY_REST finite_sets |- !s. SING s = ~(s = {{}}) /\ (REST s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/0000750000212700021270000000000005227254201020476 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_INSERT.doc0000640000212700021270000000015405223275632023504 0ustar cammcamm\THEOREM DISJOINT_INSERT finite_sets |- !x s t. DISJOINT(x INSERT s)t = DISJOINT s t /\ ~x IN t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_DELETE_SYM.doc0000640000212700021270000000015605223605103024162 0ustar cammcamm\THEOREM DISJOINT_DELETE_SYM finite_sets |- !s t x. DISJOINT(s DELETE x)t = DISJOINT(t DELETE x)s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_EMPTY.doc0000640000212700021270000000013205223300761023362 0ustar cammcamm\THEOREM DISJOINT_EMPTY finite_sets |- !s. DISJOINT {{}} s /\ DISJOINT s {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_DEF.doc0000640000212700021270000000013105147526731023075 0ustar cammcamm\THEOREM DISJOINT_DEF finite_sets |- !s t. DISJOINT s t = (s INTER t = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_EMPTY_REFL.doc0000640000212700021270000000012605147526731024211 0ustar cammcamm\THEOREM DISJOINT_EMPTY_REFL finite_sets |- !s. (s = {{}}) = DISJOINT s s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_SYM.doc0000640000212700021270000000012305147526731023150 0ustar cammcamm\THEOREM DISJOINT_SYM finite_sets |- !s t. DISJOINT s t = DISJOINT t s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/IN_DISJOINT.doc0000640000212700021270000000013505147526731023011 0ustar cammcamm\THEOREM IN_DISJOINT finite_sets |- !s t. DISJOINT s t = ~(?x. x IN s /\ x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/disj/DISJOINT_UNION.doc0000640000212700021270000000015705151457224023372 0ustar cammcamm\THEOREM DISJOINT_UNION finite_sets |- !s t u. DISJOINT(s UNION t)u = DISJOINT s u /\ DISJOINT t u \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/0000750000212700021270000000000005227254270020635 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_COMPOSE.doc0000640000212700021270000000013505147526732023341 0ustar cammcamm\THEOREM IMAGE_COMPOSE finite_sets |- !f g s. IMAGE(f o g)s = IMAGE f(IMAGE g s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_EQ_EMPTY.doc0000640000212700021270000000013105151504727023506 0ustar cammcamm\THEOREM IMAGE_EQ_EMPTY finite_sets |- !s f. (IMAGE f s = {{}}) = (s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_DELETE.doc0000640000212700021270000000014705147526732023201 0ustar cammcamm\THEOREM IMAGE_DELETE finite_sets |- !f x s. ~x IN s ==> (IMAGE f(s DELETE x) = IMAGE f s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_EMPTY.doc0000640000212700021270000000010705147526732023131 0ustar cammcamm\THEOREM IMAGE_EMPTY finite_sets |- !f. IMAGE f{{}} = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_ID.doc0000640000212700021270000000010305147526732022523 0ustar cammcamm\THEOREM IMAGE_ID finite_sets |- !s. IMAGE(\x. x)s = s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_IN.doc0000640000212700021270000000013105147526733022537 0ustar cammcamm\THEOREM IMAGE_IN finite_sets |- !x s. x IN s ==> (!f. (f x) IN (IMAGE f s)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_INSERT.doc0000640000212700021270000000015005147526733023236 0ustar cammcamm\THEOREM IMAGE_INSERT finite_sets |- !f x s. IMAGE f(x INSERT s) = (f x) INSERT (IMAGE f s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_INTER.doc0000640000212700021270000000016405147526733023120 0ustar cammcamm\THEOREM IMAGE_INTER finite_sets |- !f s t. (IMAGE f(s INTER t)) SUBSET ((IMAGE f s) INTER (IMAGE f t)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_SUBSET.doc0000640000212700021270000000015305147526733023242 0ustar cammcamm\THEOREM IMAGE_SUBSET finite_sets |- !s t. s SUBSET t ==> (!f. (IMAGE f s) SUBSET (IMAGE f t)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IMAGE_UNION.doc0000640000212700021270000000015305147526733023125 0ustar cammcamm\THEOREM IMAGE_UNION finite_sets |- !f s t. IMAGE f(s UNION t) = (IMAGE f s) UNION (IMAGE f t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/image/IN_IMAGE.doc0000640000212700021270000000014205147526733022541 0ustar cammcamm\THEOREM IN_IMAGE finite_sets |- !f s y. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/diff/0000750000212700021270000000000005227254370020464 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/diff/DIFF_DIFF.doc0000640000212700021270000000012105147526734022455 0ustar cammcamm\THEOREM DIFF_DIFF finite_sets |- !s t. (s DIFF t) DIFF t = s DIFF t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/diff/DIFF_EMPTY.doc0000640000212700021270000000010305147526734022643 0ustar cammcamm\THEOREM DIFF_EMPTY finite_sets |- !s. s DIFF {{}} = s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/diff/DIFF_EQ_EMPTY.doc0000640000212700021270000000010605147526734023233 0ustar cammcamm\THEOREM DIFF_EQ_EMPTY finite_sets |- !s. s DIFF s = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/diff/EMPTY_DIFF.doc0000640000212700021270000000010605147526734022646 0ustar cammcamm\THEOREM EMPTY_DIFF finite_sets |- !s. {{}} DIFF s = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/diff/IN_DIFF.doc0000640000212700021270000000013005147526734022253 0ustar cammcamm\THEOREM IN_DIFF finite_sets |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/0000750000212700021270000000000005227254503020342 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/fun/BIJ_COMPOSE.doc0000640000212700021270000000014505147526735022635 0ustar cammcamm\THEOREM BIJ_COMPOSE finite_sets |- !f g s t u. BIJ f s t /\ BIJ g t u ==> BIJ(g o f)s u \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/BIJ_DEF.doc0000640000212700021270000000013005147526735022120 0ustar cammcamm\THEOREM BIJ_DEF finite_sets |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/BIJ_EMPTY.doc0000640000212700021270000000016205147526735022425 0ustar cammcamm\THEOREM BIJ_EMPTY finite_sets |- !f. (!s. BIJ f{{}}s = (s = {{}})) /\ (!s. BIJ f s{{}} = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/BIJ_ID.doc0000640000212700021270000000007505147526735022026 0ustar cammcamm\THEOREM BIJ_ID finite_sets |- !s. BIJ(\x. x)s s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/IMAGE_SURJ.doc0000640000212700021270000000012405147526736022527 0ustar cammcamm\THEOREM IMAGE_SURJ finite_sets |- !f s t. SURJ f s t = (IMAGE f s = t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/INJ_COMPOSE.doc0000640000212700021270000000014505147526736022652 0ustar cammcamm\THEOREM INJ_COMPOSE finite_sets |- !f g s t u. INJ f s t /\ INJ g t u ==> INJ(g o f)s u \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/INJ_DEF.doc0000640000212700021270000000024005147526736022137 0ustar cammcamm\THEOREM INJ_DEF finite_sets |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/INJ_EMPTY.doc0000640000212700021270000000014505147526736022443 0ustar cammcamm\THEOREM INJ_EMPTY finite_sets |- !f. (!s. INJ f{{}}s) /\ (!s. INJ f s{{}} = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/INJ_ID.doc0000640000212700021270000000007505147526736022043 0ustar cammcamm\THEOREM INJ_ID finite_sets |- !s. INJ(\x. x)s s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/LINV_DEF.doc0000640000212700021270000000015005147526736022267 0ustar cammcamm\THEOREM LINV_DEF finite_sets |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/RINV_DEF.doc0000640000212700021270000000015105147526737022277 0ustar cammcamm\THEOREM RINV_DEF finite_sets |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/SURJ_COMPOSE.doc0000640000212700021270000000015105147526737023013 0ustar cammcamm\THEOREM SURJ_COMPOSE finite_sets |- !f g s t u. SURJ f s t /\ SURJ g t u ==> SURJ(g o f)s u \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/SURJ_DEF.doc0000640000212700021270000000023005147526737022302 0ustar cammcamm\THEOREM SURJ_DEF finite_sets |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/SURJ_EMPTY.doc0000640000212700021270000000016505147526737022611 0ustar cammcamm\THEOREM SURJ_EMPTY finite_sets |- !f. (!s. SURJ f{{}}s = (s = {{}})) /\ (!s. SURJ f s{{}} = (s = {{}})) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/fun/SURJ_ID.doc0000640000212700021270000000007705147526737022211 0ustar cammcamm\THEOREM SURJ_ID finite_sets |- !s. SURJ(\x. x)s s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/0000750000212700021270000000000005227254644020531 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/unin/INSERT_INTER.doc0000640000212700021270000000020105147526721023156 0ustar cammcamm\THEOREM INSERT_INTER finite_sets |- !x s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INSERT_UNION_EQ.doc0000640000212700021270000000015005147526721023555 0ustar cammcamm\THEOREM INSERT_UNION_EQ finite_sets |- !x s t. (x INSERT s) UNION t = x INSERT (s UNION t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INSERT_UNION.doc0000640000212700021270000000020105147526721023165 0ustar cammcamm\THEOREM INSERT_UNION finite_sets |- !x s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/EMPTY_UNION.doc0000640000212700021270000000014405147526740023066 0ustar cammcamm\THEOREM EMPTY_UNION finite_sets |- !s t. (s UNION t = {{}}) = (s = {{}}) /\ (t = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INTER_ASSOC.doc0000640000212700021270000000014205147526740023027 0ustar cammcamm\THEOREM INTER_ASSOC finite_sets |- !s t u. (s INTER t) INTER u = s INTER (t INTER u) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INTER_COMM.doc0000640000212700021270000000011305147526740022710 0ustar cammcamm\THEOREM INTER_COMM finite_sets |- !s t. s INTER t = t INTER s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INTER_EMPTY.doc0000640000212700021270000000014705147526740023062 0ustar cammcamm\THEOREM INTER_EMPTY finite_sets |- (!s. {{}} INTER s = {{}}) /\ (!s. s INTER {{}} = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INTER_IDEMPOT.doc0000640000212700021270000000010405147526740023256 0ustar cammcamm\THEOREM INTER_IDEMPOT finite_sets |- !s. s INTER s = s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INTER_OVER_UNION.doc0000640000212700021270000000016105147526741023704 0ustar cammcamm\THEOREM INTER_OVER_UNION finite_sets |- !s t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/INTER_SUBSET.doc0000640000212700021270000000015605147526741023172 0ustar cammcamm\THEOREM INTER_SUBSET finite_sets |- (!s t. (s INTER t) SUBSET s) /\ (!s t. (t INTER s) SUBSET s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/IN_INTER.doc0000640000212700021270000000013105147526741022464 0ustar cammcamm\THEOREM IN_INTER finite_sets |- !s t x. x IN (s INTER t) = x IN s /\ x IN t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/IN_UNION.doc0000640000212700021270000000013105147526741022473 0ustar cammcamm\THEOREM IN_UNION finite_sets |- !s t x. x IN (s UNION t) = x IN s \/ x IN t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/SUBSET_INTER_ABSORPTION.doc0000640000212700021270000000013705147526741024731 0ustar cammcamm\THEOREM SUBSET_INTER_ABSORPTION finite_sets |- !s t. s SUBSET t = (s INTER t = s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/SUBSET_UNION.doc0000640000212700021270000000015605147526741023201 0ustar cammcamm\THEOREM SUBSET_UNION finite_sets |- (!s t. s SUBSET (s UNION t)) /\ (!s t. s SUBSET (t UNION s)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/SUBSET_UNION_ABSORPTION.doc0000640000212700021270000000013705147526742024741 0ustar cammcamm\THEOREM SUBSET_UNION_ABSORPTION finite_sets |- !s t. s SUBSET t = (s UNION t = t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/UNION_ASSOC.doc0000640000212700021270000000014205147526742023040 0ustar cammcamm\THEOREM UNION_ASSOC finite_sets |- !s t u. (s UNION t) UNION u = s UNION (t UNION u) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/UNION_COMM.doc0000640000212700021270000000011305147526742022721 0ustar cammcamm\THEOREM UNION_COMM finite_sets |- !s t. s UNION t = t UNION s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/UNION_EMPTY.doc0000640000212700021270000000014105147526742023065 0ustar cammcamm\THEOREM UNION_EMPTY finite_sets |- (!s. {{}} UNION s = s) /\ (!s. s UNION {{}} = s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/UNION_IDEMPOT.doc0000640000212700021270000000010405147526742023267 0ustar cammcamm\THEOREM UNION_IDEMPOT finite_sets |- !s. s UNION s = s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/UNION_OVER_INTER.doc0000640000212700021270000000016105147526742023705 0ustar cammcamm\THEOREM UNION_OVER_INTER finite_sets |- !s t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/unin/DELETE_INTER.doc0000640000212700021270000000014505151450201023103 0ustar cammcamm\THEOREM DELETE_INTER finite_sets |- !s t x. (s DELETE x) INTER t = (s INTER t) DELETE x \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/0000750000212700021270000000000005227254723020532 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/subs/PSUBSET_INSERT_SUBSET.doc0000640000212700021270000000016505147526721024523 0ustar cammcamm\THEOREM PSUBSET_INSERT_SUBSET finite_sets |- !s t. s PSUBSET t = (?x. ~x IN s /\ (x INSERT s) SUBSET t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/SUBSET_INSERT.doc0000640000212700021270000000015505147526722023316 0ustar cammcamm\THEOREM SUBSET_INSERT finite_sets |- !x s. ~x IN s ==> (!t. s SUBSET (x INSERT t) = s SUBSET t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/INSERT_SUBSET.doc0000640000212700021270000000014705147526722023317 0ustar cammcamm\THEOREM INSERT_SUBSET finite_sets |- !x s t. (x INSERT s) SUBSET t = x IN t /\ s SUBSET t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/EMPTY_SUBSET.doc0000640000212700021270000000010305147526743023204 0ustar cammcamm\THEOREM EMPTY_SUBSET finite_sets |- !s. {{}} SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/NOT_PSUBSET_EMPTY.doc0000640000212700021270000000011205147526743024044 0ustar cammcamm\THEOREM NOT_PSUBSET_EMPTY finite_sets |- !s. ~s PSUBSET {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/PSUBSET_DEF.doc0000640000212700021270000000013305147526744023030 0ustar cammcamm\THEOREM PSUBSET_DEF finite_sets |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/PSUBSET_IRREFL.doc0000640000212700021270000000010405147526744023413 0ustar cammcamm\THEOREM PSUBSET_IRREFL finite_sets |- !s. ~s PSUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/PSUBSET_MEMBER.doc0000640000212700021270000000015505147526744023405 0ustar cammcamm\THEOREM PSUBSET_MEMBER finite_sets |- !s t. s PSUBSET t = s SUBSET t /\ (?y. y IN t /\ ~y IN s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/PSUBSET_TRANS.doc0000640000212700021270000000014505147526744023324 0ustar cammcamm\THEOREM PSUBSET_TRANS finite_sets |- !s t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/SUBSET_ANTISYM.doc0000640000212700021270000000013605147526744023441 0ustar cammcamm\THEOREM SUBSET_ANTISYM finite_sets |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/SUBSET_DEF.doc0000640000212700021270000000013205147526744022707 0ustar cammcamm\THEOREM SUBSET_DEF finite_sets |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/SUBSET_EMPTY.doc0000640000212700021270000000012005147526745023205 0ustar cammcamm\THEOREM SUBSET_EMPTY finite_sets |- !s. s SUBSET {{}} = (s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/SUBSET_REFL.doc0000640000212700021270000000007705147526745023052 0ustar cammcamm\THEOREM SUBSET_REFL finite_sets |- !s. s SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/subs/SUBSET_TRANS.doc0000640000212700021270000000014105147526745023201 0ustar cammcamm\THEOREM SUBSET_TRANS finite_sets |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/0000750000212700021270000000000005261375400020631 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/basic/ABSORPTION.doc0000640000212700021270000000011705147526745023015 0ustar cammcamm\THEOREM ABSORPTION finite_sets |- !x s. x IN s = (x INSERT s = s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/COMPONENT.doc0000640000212700021270000000010605147526745022675 0ustar cammcamm\THEOREM COMPONENT finite_sets |- !x s. x IN (x INSERT s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/DECOMPOSITION.doc0000640000212700021270000000014305147526746023351 0ustar cammcamm\THEOREM DECOMPOSITION finite_sets |- !s x. x IN s = (?t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/EXTENSION.doc0000640000212700021270000000012405147526746022710 0ustar cammcamm\THEOREM EXTENSION finite_sets |- !s t. (s = t) = (!x. x IN s = x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/INSERT_COMM.doc0000640000212700021270000000014605147526746023157 0ustar cammcamm\THEOREM INSERT_COMM finite_sets |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/INSERT_INSERT.doc0000640000212700021270000000013305147526746023424 0ustar cammcamm\THEOREM INSERT_INSERT finite_sets |- !x s. x INSERT (x INSERT s) = x INSERT s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/IN_INSERT.doc0000640000212700021270000000013405147526746022727 0ustar cammcamm\THEOREM IN_INSERT finite_sets |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/MEMBER_NOT_EMPTY.doc0000640000212700021270000000012405147526746024001 0ustar cammcamm\THEOREM MEMBER_NOT_EMPTY finite_sets |- !s. (?x. x IN s) = ~(s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/NOT_EMPTY_INSERT.doc0000640000212700021270000000012005147526746024032 0ustar cammcamm\THEOREM NOT_EMPTY_INSERT finite_sets |- !x s. ~({{}} = x INSERT s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/NOT_EQUAL_SETS.doc0000640000212700021270000000013305147526747023562 0ustar cammcamm\THEOREM NOT_EQUAL_SETS finite_sets |- !s t. ~(s = t) = (?x. x IN t = ~x IN s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/NOT_INSERT_EMPTY.doc0000640000212700021270000000012005147526747024033 0ustar cammcamm\THEOREM NOT_INSERT_EMPTY finite_sets |- !x s. ~(x INSERT s = {{}}) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/NOT_IN_EMPTY.doc0000640000212700021270000000010005147526747023333 0ustar cammcamm\THEOREM NOT_IN_EMPTY finite_sets |- !x. ~x IN {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/SET_CASES.doc0000640000212700021270000000014405147526747022710 0ustar cammcamm\THEOREM SET_CASES finite_sets |- !s. (s = {{}}) \/ (?x t. (s = x INSERT t) /\ ~x IN t) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/SET_INDUCT.doc0000640000212700021270000000017405147526747023043 0ustar cammcamm\THEOREM SET_INDUCT finite_sets |- !P. P{{}} /\ (!s. P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> (!s. P s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/NUM_SET_WOP.doc0000640000212700021270000000015305261372500023215 0ustar cammcamm\THEOREM NUM_SET_WOP finite_sets |- !s. (?n. n IN s) = (?n. n IN s /\ (!m. m IN s ==> n <= m)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/basic/SET_MINIMUM.doc0000640000212700021270000000016505261375400023151 0ustar cammcamm\THEOREM SET_MINIMUM finite_sets |- !s M. (?x. x IN s) = (?x. x IN s /\ (!y. y IN s ==> (M x) <= (M y))) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/0000750000212700021270000000000005227255233020317 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/help/thms/del/INSERT_DELETE.doc0000640000212700021270000000013705147526720023041 0ustar cammcamm\THEOREM INSERT_DELETE finite_sets |- !x s. x IN s ==> (x INSERT (s DELETE x) = s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DELETE_INSERT.doc0000640000212700021270000000021205147526720023033 0ustar cammcamm\THEOREM DELETE_INSERT finite_sets |- !x y s. (x INSERT s) DELETE y = ((x = y) => s DELETE y | x INSERT (s DELETE y)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DIFF_INSERT.doc0000640000212700021270000000014205147526720022603 0ustar cammcamm\THEOREM DIFF_INSERT finite_sets |- !s t x. s DIFF (x INSERT t) = (s DELETE x) DIFF t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/SUBSET_INSERT_DELETE.doc0000640000212700021270000000015705147526720024130 0ustar cammcamm\THEOREM SUBSET_INSERT_DELETE finite_sets |- !x s t. s SUBSET (x INSERT t) = (s DELETE x) SUBSET t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/SUBSET_DELETE.doc0000640000212700021270000000015005147526720023035 0ustar cammcamm\THEOREM SUBSET_DELETE finite_sets |- !x s t. s SUBSET (t DELETE x) = ~x IN s /\ s SUBSET t \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DELETE_SUBSET.doc0000640000212700021270000000011605147526720023037 0ustar cammcamm\THEOREM DELETE_SUBSET finite_sets |- !x s. (s DELETE x) SUBSET s \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DELETE_COMM.doc0000640000212700021270000000014605147526720022570 0ustar cammcamm\THEOREM DELETE_COMM finite_sets |- !x y s. (s DELETE x) DELETE y = (s DELETE y) DELETE x \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DELETE_DELETE.doc0000640000212700021270000000013305147526720022773 0ustar cammcamm\THEOREM DELETE_DELETE finite_sets |- !x s. (s DELETE x) DELETE x = s DELETE x \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/EMPTY_DELETE.doc0000640000212700021270000000011205147526721022725 0ustar cammcamm\THEOREM EMPTY_DELETE finite_sets |- !x. {{}} DELETE x = {{}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/IN_DELETE.doc0000640000212700021270000000013505147526721022342 0ustar cammcamm\THEOREM IN_DELETE finite_sets |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/IN_DELETE_EQ.doc0000640000212700021270000000017505147526721022733 0ustar cammcamm\THEOREM IN_DELETE_EQ finite_sets |- !s x x'. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x)) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DELETE_NON_ELEMENT.doc0000640000212700021270000000013005147526721023632 0ustar cammcamm\THEOREM DELETE_NON_ELEMENT finite_sets |- !x s. ~x IN s = (s DELETE x = s) \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/help/thms/del/DELETE_DEF.doc0000640000212700021270000000011705147526722022433 0ustar cammcamm\THEOREM DELETE_DEF finite_sets |- !s x. s DELETE x = s DIFF {{x}} \ENDTHEOREM hol88-2.02.19940316/Library/finite_sets/OLD/0000750000212700021270000000000005227255265016273 5ustar cammcammhol88-2.02.19940316/Library/finite_sets/OLD/Makefile0000640000212700021270000000340104747567416017744 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: finite_sets # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o *_ml.l @echo "===> library finite_sets: all object code deleted" clobber: rm -f *_ml.o *_ml.l *.th @echo "===> library finite_sets: all object code and theory files deleted" # ===================================================================== # Entries for individual files. # ===================================================================== finite_sets.th: mk_finite_sets.ml rm -f finite_sets.th echo 'set_flag(`abort_when_fail`,true);;'\ 'loadt `mk_finite_sets`;;' | ${Hol} set_ind_ml.o: finite_sets.th set_ind.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `finite_sets`;;'\ 'compilet `set_ind`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: finite_sets.th set_ind_ml.o @echo "===> library finite_sets rebuilt" hol88-2.02.19940316/Library/finite_sets/OLD/set_ind.ml0000640000212700021270000000322604747567773020276 0ustar cammcamm% ===================================================================== % % set_ind.ml : set induction. % % ===================================================================== % % BINDER_CONV conv "B x. tm[x]" applies conv to tm[x] % let BINDER_CONV conv = (RAND_CONV (ABS_CONV conv));; % DEPTH_FORALL_CONV : BINDER_CONV in depth % letrec DEPTH_FORALL_CONV conv tm = if (is_forall tm) then BINDER_CONV (DEPTH_FORALL_CONV conv) tm else conv tm;; let SET_INDUCT_TAC = let set_induction = theorem `finite_sets` `set_induction` in INDUCT_THEN set_induction ASSUME_TAC;; %---------------------------------------------------------------- Taken from T. Melham's INDUCT_THEN ----------------------------------------------------------------% let SET_INDUCT_2_TAC = let th = theorem `finite_sets` `set_induction_2` in \(A,t). (let x,body = dest_forall t in let tyi = snd(match (fst(dest_forall (concl th))) "\^x.T") in let spec = SPEC (mk_abs(x,body)) (INST_TYPE tyi th) in let spec' = DISCH_ALL (CONV_RULE (GEN_ALPHA_CONV x) (UNDISCH spec)) in let thm = CONV_RULE(RAND_CONV(BINDER_CONV BETA_CONV)) spec' in let th_tac = ASSUME_TAC in let tac = (MATCH_MP_TAC thm THEN REPEAT CONJ_TAC THEN FIRST [CONV_TAC (DEPTH_FORALL_CONV BETA_CONV); CONV_TAC (GEN_ALPHA_CONV x) THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_THEN (\th. CONV_TAC (DEPTH_FORALL_CONV BETA_CONV) THEN MAP_EVERY (th_tac o (CONV_RULE BETA_CONV)) (CONJUNCTS th))]) in (tac (A,t))) ? failwith `SET_INDUCT_2_TAC`;; hol88-2.02.19940316/Library/finite_sets/OLD/READ-ME0000640000212700021270000000137204653567400017233 0ustar cammcamm LIBRARY: sets DESCRIPTION: Definition of logical types for sets and derivation of theorems for sets. AUTHOR: P. J. Windley DATE: May 12, 1989 ADDITIONS: Phillipe Leveilley DATE: May 25, 1989 FILES: mk_sets.ml defines theory sets.th and proves properites about sets card.ml defines cardinality (added by Philippe Leveilley) sets.ml loads the library into hol TO REBUILD THE LIBRARY: 1) edit the pathnames in the Makefile (if necessary) 2) type "make clean" 3) type "make all" TO USE THE LIBRARY: load_library `sets`;; This makes the theory `sets` a new parent if you are in draft mode, or loads the theory otherwise. hol88-2.02.19940316/Library/finite_sets/OLD/finite_sets.doc0000640000212700021270000001423604546647746021321 0ustar cammcamm A Theory for Finite Sets P. J. Windley University of California, Davis May 12, 1989 The HOL theory "sets.th" provides a theory of finite sets for HOL. The theory is taken from chapter 10 of Manna and Waldinger's book "The Logical Basis for Computer Porgramming, VOL 1." The theory presented there was formalized inside HOL. The theory of sets has two constructors EMPTY, which constructs the empty set and INSERT which constructs a new set from an atom and another set. There are two induction theorems (and tactics). The first is the standard structural induction theorem returned from Tom Melham's type package: set_induction = |- !P. P EMPTY /\ (!s. P s ==> (!x. P(INSERT x s))) ==> (!s. P s) The second is more specific to set and is quite useful. It is derived from the first: set_induction_2 = |- !P. P EMPTY /\ (!s x. ~x IN s ==> P s ==> P(INSERT x s)) ==> (!s. P s) The two induction tactics are called SET_INDUCT_TAC and SET_INDUCT_2_TAC respectively. The following is a list of theorems and definitions contained in the theory of sets: SET_DISTINCT = |- !x s. ~(EMPTY = INSERT x s) SET_CASES_THM = |- !s. (s = EMPTY) \/ (?s' x. s = INSERT x s') IN = |- (!x. x IN EMPTY = F) /\ (!x y s. x IN (INSERT y s) = (x = y) \/ x IN s) COMPONENT = |- !x s. x IN (INSERT x s) NONEMPTY_MEMBER = |- !s. ~(s = EMPTY) = (?x. x IN s) ABSORPTION = |- !x s. x IN s ==> (INSERT x s = s) MEMBER_DECOMP = |- !x s. x IN s ==> (?t. (s = INSERT x t) /\ ~x IN t) SET_EQ = |- !s t. (s = t) = (!x. x IN s = x IN t) UNION = |- (!s. EMPTY UNION s = s) /\ (!x s1 s2. (INSERT x s1) UNION s2 = (x IN s2 => s1 UNION s2 | INSERT x(s1 UNION s2))) IN_UNION = |- !x s1 s2. x IN (s1 UNION s2) = x IN s1 \/ x IN s2 UNION_ASSOC = |- !s1 s2 s3. (s1 UNION s2) UNION s3 = s1 UNION (s2 UNION s3) UNION_IDENT = |- !s. s UNION s = s UNION_SYM = |- !s1 s2. s1 UNION s2 = s2 UNION s1 INTERSECT = |- (!s. EMPTY INTERSECT s = EMPTY) /\ (!x s1 s2. (INSERT x s1) INTERSECT s2 = (x IN s2 => INSERT x(s1 INTERSECT s2) | s1 INTERSECT s2)) IN_INTERSECT = |- !x s1 s2. x IN (s1 INTERSECT s2) = x IN s1 /\ x IN s2 INTERSECT_ASSOC = |- !s1 s2 s3. (s1 INTERSECT s2) INTERSECT s3 = s1 INTERSECT (s2 INTERSECT s3) INTERSECT_IDENT = |- !s. s INTERSECT s = s INTERSECT_SYM = |- !s1 s2. s1 INTERSECT s2 = s2 INTERSECT s1 UNION_OVER_INTERSECT = |- !s1 s2 s3. s1 INTERSECT (s2 UNION s3) = (s1 INTERSECT s2) UNION (s1 INTERSECT s3) INTERSECT_OVER_UNION = |- !s1 s2 s3. s1 UNION (s2 INTERSECT s3) = (s1 UNION s2) INTERSECT (s1 UNION s3) DISJOINT = |- !s t. DISJOINT s t = (s INTERSECT t = EMPTY) DISJOINT_MEMBER = |- !s t. DISJOINT s t = ~(?x. x IN s /\ x IN t) DELETE = |- (!x. EMPTY DELETE x = EMPTY) /\ (!x s y. (INSERT x s) DELETE y = ((x = y) => s DELETE y | INSERT x(s DELETE y))) DELETE_MEMBER = |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) DELETE_DECOMPOSITION = |- !s x. x IN s ==> (s = INSERT x(s DELETE x)) DELETE_ABSORPTION = |- !s x. ~x IN s ==> (s = s DELETE x) CHOICE = |- !s. CHOICE s = (@x. x IN s) REST = |- !s. REST s = s DELETE (CHOICE s) CHOICE_MEMBER = |- !s. ~(s = EMPTY) ==> (CHOICE s) IN s CHOICE_DECOMPOSITION = |- !s. ~(s = EMPTY) ==> (s = INSERT(CHOICE s)(REST s)) CHOICE_NON_MEMBER = |- !s. ~(s = EMPTY) ==> ~(CHOICE s) IN (REST s) DIFF = |- (!s. s DIFF EMPTY = s) /\ (!s t x. s DIFF (INSERT x t) = (s DELETE x) DIFF t) DIFF_MEMBER = |- !t s x. x IN (s DIFF t) = x IN s /\ ~x IN t SUBSET = |- (!s. EMPTY SUBSET s = T) /\ (!x s t. (INSERT x s) SUBSET t = x IN t /\ s SUBSET t) SUBSET_MEMBER = |- !s t. s SUBSET t = (!y. y IN s ==> y IN t) SUBSET_UNION = |- !s t. s SUBSET (s UNION t) /\ t SUBSET (s UNION t) SUBSET_INTERSECT = |- !s t. (s INTERSECT t) SUBSET s /\ (s INTERSECT t) SUBSET t SUBSET_DELETE = |- !s x. ~(s = EMPTY) ==> (s DELETE x) SUBSET s SUBSET_UNION_ABSORPTION = |- !s t. s SUBSET t = (s UNION t = t) SUBSET_INTERSECT_ABSORPTION = |- !s t. s SUBSET t = (s INTERSECT t = s) SUBSET_TRANS = |- !s1 s2 s3. s1 SUBSET s2 /\ s2 SUBSET s3 ==> s1 SUBSET s3 SUBSET_ANTISYM = |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) SUBSET_REFL = |- !s. s SUBSET s PSUBSET = |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) PSUBSET_TRANS = |- !s t. s PSUBSET t = (!x. x IN s ==> x IN t) /\ (?y. y IN t /\ ~y IN s) PSUBSET_REFL = |- !s. ~s PSUBSET s PSUBSET_REST = |- !s. ~(s = EMPTY) ==> (REST s) PSUBSET s MK_SET = |- (!f. MK_SET EMPTY f = EMPTY) /\ (!x s f. MK_SET(INSERT x s)f = (f x => INSERT x(MK_SET s f) | MK_SET s f)) MK_SET_MEMBER = |- !s x. x IN (MK_SET s f) = x IN s /\ f x MK_SET_TRUE = |- !s. MK_SET s(\x. T) = s MK_SET_FALSE = |- !s. MK_SET s(\x. F) = EMPTY MK_SET_INTERSECT = |- !s t. s INTERSECT t = MK_SET s(\x. x IN t) MK_SET_DELETE = |- !s y. s DELETE y = MK_SET s(\x. ~(x = y)) MK_SET_DIFF = |- !t s. s DIFF t = MK_SET s(\x. ~x IN t) MK_SET_OR = |- !s f g. MK_SET s(\x. f x \/ g x) = (MK_SET s f) UNION (MK_SET s g) MK_SET_AND = |- !s f g. MK_SET s(\x. f x /\ g x) = (MK_SET s f) INTERSECT (MK_SET s g) SING = |- !s. SING s = (?x. s = INSERT x EMPTY) SING_CHOICE = |- !x. CHOICE(INSERT x EMPTY) = x SING_REST = |- !s. SING s = ~(s = EMPTY) /\ (REST s = EMPTY) The following are the cardinality results (the theorem CARD is proved in the file card.ml composed by Philippe Leveilley): CARD = |- (CARD EMPTY = 0) /\ (!x s. CARD(INSERT x s) = (x IN s => CARD s | (CARD s) + 1)) CARD_EQ_0 = |- !s. (CARD s = 0) ==> (s = EMPTY) CARD_ABSORPTION = |- !s x. x IN s ==> (CARD(INSERT x s) = CARD s) CARD_INTERSECT = |- !s t. (CARD(s INTERSECT t)) <= (CARD s) /\ (CARD(s INTERSECT t)) <= (CARD t) CARD_UNION = |- !s t. (CARD(s UNION t)) + (CARD(s INTERSECT t)) = (CARD s) + (CARD t) CARD_SUBSET = |- !s t. s SUBSET t ==> (CARD s) <= (CARD t) CARD_PSUBSET = |- !s t. s PSUBSET t ==> (CARD s) < (CARD t) SING_CARD = |- !s. SING s = (CARD s = 1) hol88-2.02.19940316/Library/finite_sets/OLD/card.ml0000640000212700021270000002663204747562125017552 0ustar cammcamm%<_____________________________________________________________________ | | | TACTICS | %_____________________________________________________________________>% %< to change the goal "P==>Q" into "~Q==>~P" >% % --------------------------------------------------------------------- % % revised, to remove dependency on taut library. [TFM 91.01.24] % % load_library `taut`;; % % let CONTRAP_THM = TAUT_RULE "(P==>Q)=(~Q==>~P)";; % % let CONTRAP_TAC = ONCE_REWRITE_TAC[CONTRAP_THM];; % % --------------------------------------------------------------------- % let CONTRAP_TAC = CONV_TAC (ONCE_DEPTH_CONV CONTRAPOS_CONV);; %< --------------------------------------------------------------------- "( t => t1 | t2)" ===================== {~t} "t2" {t} "t1" DELETED: built-in COND_CASES_TAC now does this. [TFM 90.05.14] let COND_CASES_2_TAC = COND_CASES_TAC THENL [%< T >% POP_ASSUM (ASSUME_TAC o EQT_ELIM); %< F >% POP_ASSUM (ASSUME_TAC o NOT_INTRO o fst o EQ_IMP_RULE)] ;; --------------------------------------------------------------------- >% %<______________________________________________________________________ | | | giving a definition for cardinality | |______________________________________________________________________>% let HAS_CARD = new_prim_rec_definition (`HAS_CARD`, "(HAS_CARD (s:(*)set) 0 = (s=EMPTY)) /\ (HAS_CARD (s:(*)set) (SUC n) = (?x. x IN s /\ HAS_CARD (s DELETE x) n))");; let CARD_DEF = new_definition (`CARD_DEF`, "CARD (s:(*)set) = (@n. HAS_CARD s n)");; %<______________________________________________________________________ | | | useful lemmas | |______________________________________________________________________>% let SELECT_0 = save_thm (`SELECT_0`, SELECT_RULE (EXISTS ("?n. n=0","0") (REFL "0")));; %< it is the DELETE_ABSORPTION theorem where (s DELETE x) and s have been swapped >% let DELETE_ABS = prove_thm (`DELETE_ABS`, "!(x:*) s. ~(x IN s) ==> (s DELETE x = s)", REPEAT STRIP_TAC THEN REWRITE_TAC [SET_EQ; DELETE_MEMBER] THEN GEN_TAC THEN ASM_CASES_TAC "x':*=x" THEN ASM_REWRITE_TAC []);; let MEMBER_IMP_NONEMPTY = prove_thm (`MEMBER_IMP_NONEMPTY`, "!(x:*) s. x IN s ==> ~(s = EMPTY)", REPEAT GEN_TAC THEN CONTRAP_TAC THEN REWRITE_TAC [] THEN DISCH_TAC THEN ASM_REWRITE_TAC [IN]);; let IN_DEL_IMP = save_thm (`IN_DEL_IMP`, GEN "y:*" (GEN "x:*" (snd (EQ_IMP_RULE (SPEC_ALL DELETE_MEMBER)))));; let lemme3 = prove_thm (`lemme3`, "!(x:*) x' s. (x IN s /\ x' IN s) ==> (s DELETE x = EMPTY) ==> (s DELETE x' = EMPTY)", REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC "x':*=x" THENL [ %< x'=x >% ASM_REWRITE_TAC []; %< ~x'=x >% IMP_RES_TAC IN_DEL_IMP THEN IMP_RES_TAC MEMBER_IMP_NONEMPTY THEN ASM_REWRITE_TAC[] ]);; let IN_INSERT= prove_thm (`IN_INSERT`, "!(x:*) s. x IN s ==>(!y. x IN (INSERT y s))", REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [IN]);; let NOT_IN_SAME_SET= prove_thm (`NOT_IN_SAME_SET`, "!(x:*) y s. y IN s /\ ~x IN s ==> ~(x=y)", REPEAT GEN_TAC THEN ASM_CASES_TAC "(x:*)=y" THEN ASM_REWRITE_TAC[NOT_AND]);; let lemme3a= prove_thm (`lemme3a`, "!(x:*) x' s. x IN s /\ x' IN s ==> (s DELETE x' = EMPTY) ==> (s DELETE x = EMPTY)", ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[lemme3]);; let NOT_SYM = prove_thm (`NOT_SYM`, "!(x:*) y. ~(x=y) ==> ~(y=x)", REPEAT GEN_TAC THEN CONTRAP_TAC THEN REWRITE_TAC [EQ_SYM]);; let DEL_DEL = prove_thm (`DEL_DEL`, "!(x:*) x' s. (s DELETE x) DELETE x' = (s DELETE x') DELETE x ", REPEAT GEN_TAC THEN REWRITE_TAC [SET_EQ; DELETE_MEMBER] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] );; let DISTINCT_SET = prove_thm (`DISTINCT_SET`, "!(x:*) s. ~(INSERT x s = EMPTY)", REPEAT GEN_TAC THEN ASSUME_TAC (SPEC_ALL SET_DISTINCT) THEN IMP_RES_TAC NOT_SYM);; %<______________________________________________________________________ | | | induction lemma for HAS_CARD definition | |______________________________________________________________________>% %<================= < base step <=================>% let CARD_EMPTY_lem = prove_thm (`CARD_EMPTY_lem`, "!n. HAS_CARD (EMPTY:(*)set) n = (n=0)", INDUCT_TAC THEN REWRITE_TAC [HAS_CARD;NOT_SUC;IN]);; %<================= induction step <=================>% %< we first prove that, when you remove an < element from a set, you decrease its < cardinal by one >% let CARD_DEL = prove_thm (`CARD_DEL`, "!n (x:*) s. (x IN s /\ HAS_CARD s(SUC n) ==> HAS_CARD(s DELETE x)n) /\ (x IN s /\ HAS_CARD(s DELETE x)n ==> HAS_CARD s(SUC n))", INDUCT_TAC THENL [ %< base step >% REWRITE_TAC [HAS_CARD] THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC lemme3a; EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[] ]; %< inductive step >% REWRITE_TAC [SPECL ["(s:(*)set)"; "SUC n"] (CONJUNCT2 HAS_CARD)] THEN REPEAT STRIP_TAC THEN POP_ASSUM MP_TAC THENL [ %< subgoal 1 >% ASM_CASES_TAC "x:*=x'" THENL [ %< x=x' >% ASM_REWRITE_TAC[]; %< ~x=x' >% IMP_RES_TAC NOT_SYM THEN IMP_RES_TAC IN_DEL_IMP THEN DISCH_TAC THEN RES_TAC THEN REWRITE_TAC [HAS_CARD] THEN EXISTS_TAC "x':*" THEN ONCE_REWRITE_TAC [DEL_DEL] THEN ASM_REWRITE_TAC [] ]; %< subgoal 2 >% DISCH_TAC THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[] ] ] );; %< rewriting the theorem above by changing the double implication into an equivalence >% let CARD_DEL_THM = prove_thm (`CARD_DEL_THM`, "!(x:*) s n. (x IN s) ==> (HAS_CARD s (SUC n) = HAS_CARD (s DELETE x) n)", REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN (IMP_RES_TAC CARD_DEL) THEN ASM_REWRITE_TAC []);; %< then follows the induction theorem for HAS_CARD >% let HAS_CARD_INDUCT= prove_thm (`HAS_CARD_INDUCT`, "!s (x:*). ~x IN s ==> (!n. HAS_CARD (INSERT x s) (SUC n) = HAS_CARD s n)", REPEAT STRIP_TAC THEN ASSUME_TAC (SPEC_ALL COMPONENT) THEN IMP_RES_TAC CARD_DEL_THM THEN IMP_RES_TAC DELETE_ABS THEN ASM_REWRITE_TAC [DELETE]);; %<______________________________________________________________________ | | | the induction theorem for CARD definition | |______________________________________________________________________>% %< to prove that (CARD: s-> CARD s ) is a function, we need to prove that there exists a unique n such as (HAS_CARD s n) for a given set s >% %< unique >% let UNIQUE_CARD = prove_thm (`UNIQUE_CARD`, "!(s:(*)set) n p. HAS_CARD s n ==> HAS_CARD s p ==> (n=p)", SET_INDUCT_2_TAC THEN REPEAT INDUCT_TAC THEN IMP_RES_TAC HAS_CARD_INDUCT THEN ASM_REWRITE_TAC[CARD_EMPTY_lem; NOT_SUC; CONJUNCT1 HAS_CARD; DISTINCT_SET; INV_SUC_EQ] );; %< exists >% let CARD_EX = prove_thm (`CARD_EX`, "!s:(*)set. ?n. HAS_CARD s n", SET_INDUCT_2_TAC THENL [ %< base >% EXISTS_TAC "0" THEN REWRITE_TAC [HAS_CARD]; %< induction step >% ASSUME_TAC (SELECT_RULE (ASSUME "?n. HAS_CARD (s:(*)set) n")) THEN EXISTS_TAC "SUC (@n. HAS_CARD (s:(*)set) n)" THEN REWRITE_TAC [HAS_CARD] THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[DELETE;IN] THEN ASSUME_TAC DELETE_ABS THEN RES_TAC THEN ASM_REWRITE_TAC[] ] );; %<================= < base step <=================>% let CARD_EMPTY = prove_thm (`CARD_EMPTY`, "CARD (EMPTY:(*)set) = 0", REWRITE_TAC [ CARD_DEF ; CARD_EMPTY_lem ; SELECT_0 ]);; let EMPTY_0_EQ = prove_thm (`EMPTY_0_EQ`, "!s:(*)set. (CARD s = 0) = (s = EMPTY)", GEN_TAC THEN EQ_TAC THENL [ %< ==> >% REWRITE_TAC [ CARD_DEF ] THEN DISCH_TAC THEN ASSUME_TAC (SELECT_RULE (SPEC_ALL CARD_EX)) THEN UNDISCH_TAC "HAS_CARD (s:(*)set)(@n. HAS_CARD s n)" THEN ASM_REWRITE_TAC [ HAS_CARD ]; %< <== >% DISCH_TAC THEN ASM_REWRITE_TAC [CARD_EMPTY] ] );; %<================= induction step <=================>% %< when rewriting CARD_INDUCT_THM with the definition of HAS_CARD we will find "(@n. HAS_CARD (INSERT x s) n)=SUC ...". Therefore we need to prove that such an n is the SUC of something... >% %< ... first, n is not 0... >% let INSERT_CARD = prove_thm (`INSERT_CARD`, "!(x:*) s n. HAS_CARD (INSERT x s) n ==> ~(n=0)", REPEAT GEN_TAC THEN ASM_CASES_TAC "n=0" THEN ASM_REWRITE_TAC[HAS_CARD;DISTINCT_SET;NOT_SUC]);; %< ... hence there exists an n' such as (HAS_CARD s (SUC n')) Thus, our n will be (SUC n') >% let EX_SUC_CARD = prove_thm (`EX_SUC_CARD`, "!(x:*) s. ?n. HAS_CARD(INSERT x s)(SUC n)", REPEAT GEN_TAC THEN ASSUME_TAC (SELECT_RULE (SPEC "INSERT (x:*) s" CARD_EX)) THEN IMP_RES_TAC INSERT_CARD THEN DISJ_CASES_TAC (SPEC "@n. HAS_CARD (INSERT (x:*) s) n" num_CASES) THENL [RES_TAC ;EXISTS_TAC "@n. (@n'. HAS_CARD (INSERT (x:*) s) n') = SUC n" THEN POP_ASSUM (\t. ASM_REWRITE_TAC [SYM (SELECT_RULE t)]) ] );; %< all the work is done, we just have to rewrite and < use the existence theorem through SELECT_RULE < Then we will have something like < "HAS_CARD s n = HAS_CARD s n'" < which is solved by the uniqueness theorem >% % Proof rewritten for HOL version 1.12 [TFM 91.01.23] % let CARD_INDUCT_THM = prove_thm (`CARD_INDUCT_THM`, "!(x:*) s. ~x IN s ==> (CARD (INSERT x s) = SUC (CARD s))", REPEAT STRIP_TAC THEN REWRITE_TAC[CARD_DEF] THEN IMP_RES_TAC HAS_CARD_INDUCT THEN FIRST_ASSUM (\th g. REWRITE_TAC [SYM(SPEC_ALL th)] g) THEN ASSUME_TAC (SELECT_RULE (SPEC "INSERT (x:*) s" CARD_EX)) THEN ASSUME_TAC (SELECT_RULE (SPEC_ALL EX_SUC_CARD)) THEN IMP_RES_TAC UNIQUE_CARD );; %< as (INSERT x s = s) if x IN s we have Phil Windley's axiom with CARD_EMPTY and CARD_INDUCT_THM >% let CARD = prove_thm (`CARD`, "(CARD (EMPTY:(*)set) = 0) /\ (!(x:*) s. CARD (INSERT x s) = (x IN s => CARD s | SUC (CARD s)))", REPEAT STRIP_TAC THENL [%< first conjuction term >% REWRITE_TAC[CARD_EMPTY]; %< second one >% COND_CASES_TAC THENL [%< x IN s >% IMP_RES_TAC ABSORPTION THEN ASM_REWRITE_TAC[]; %< ~ x IN s >% IMP_RES_TAC CARD_INDUCT_THM ] ] );; hol88-2.02.19940316/Library/finite_sets/OLD/finite_sets.ml0000640000212700021270000000410104747556505021145 0ustar cammcamm% ===================================================================== % % FILE : finite_sets.ml % % DESCRIPTION : loads the library "sets" into hol. % % % % DATE : 91.01.23 % % ===================================================================== % % --------------------------------------------------------------------- % % Put the pathname to the library finite_sets onto the search path. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/finite_sets/` in print_string `Updating search path`; print_newline(); set_search_path (union (search_path()) [path]);; % --------------------------------------------------------------------- % % Load (or attempt to load) the theory finite_sets % % --------------------------------------------------------------------- % if draft_mode() then (print_string `Declaring theory finite_sets a new parent`; print_newline(); new_parent `finite_sets`) else (load_theory `finite_sets` ? (print_string `Defining ML function load_finite_sets`; print_newline() ; loadf `load_finite_sets`));; % --------------------------------------------------------------------- % % Load compiled code if possible % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `finite_sets`)) then let path st = library_pathname() ^ `/finite_sets/` ^ st in load(path `set_ind`, get_flag_value `print_lib`);; % --------------------------------------------------------------------- % % Set up autoloading of definitions and theorems from finite_sets.th % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `finite_sets`)) then let defs = map fst (definitions `finite_sets`) in map (\name. autoload_theory(`definition`,`finite_sets`,name)) defs; let thms = map fst (theorems `finite_sets`) in map (\name. autoload_theory(`theorem`,`finite_sets`,name)) thms; delete_cache `finite_sets`; ();; hol88-2.02.19940316/Library/finite_sets/OLD/mk_finite_sets.ml0000640000212700021270000013013704747555617021650 0ustar cammcamm%---------------------------------------------------------------- File: mk_finite_sets.ml (previously sets.ml -- MJCG) Description: Defines a new type for finite sets and proves properties of sets. The theory is a formalization of the theory of sets presented in chapter 10 of Manna and Waldingers "The Logical Basis of Computer Programming, VOL 1." The axiomatization is definitional. An induction principle is defined but no recursive definitions are allowed. Authors: (c) P. J. Windley 1989 (c) Philippe Leveiley 1989 Date: May 12, 1989 Cardinality definition added 25 may 1989 Usage: After making sets a parent theory, execute "loadf `sets.ml`;;". Ensure that sets.ml and sets.th are both in the current load path. ----------------------------------------------------------------% set_flag (`sticky`, true);; % system `rm finite_sets.th`;; DELETED [TFM 91.01.23] % new_theory `finite_sets`;; %---------------------------------------------------------------- rules ----------------------------------------------------------------% % BINDER_CONV conv "B x. tm[x]" applies conv to tm[x] % let BINDER_CONV conv = (RAND_CONV (ABS_CONV conv));; % DEPTH_FORALL_CONV : BINDER_CONV in depth % letrec DEPTH_FORALL_CONV conv tm = if (is_forall tm) then BINDER_CONV (DEPTH_FORALL_CONV conv) tm else conv tm;; let SYM_RULE = (CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)) ? failwith `SYM_RULE`;; %---------------------------------------------------------------- tactics ----------------------------------------------------------------% let SWAP_TOP_ASSUMP_TAC = POP_ASSUM (\th1. POP_ASSUM (\th2 . (ASSUME_TAC th1 THEN ASSUME_TAC th2)));; let POP_TOP_ASSUMP_TAC = POP_ASSUM (K ALL_TAC);; %---------------------------------------------------------------- lemmas ----------------------------------------------------------------% let NOT_EQ_REV = TAC_PROOF (([], "!(x:bool) y . (~x = y) = (x = ~y)"), REPEAT GEN_TAC THEN MAP_EVERY BOOL_CASES_TAC ["x:bool"; "y:bool"] THEN REWRITE_TAC [] );; let CONJ_DISJ_DISTRIB = TAC_PROOF (([],"!p q r. p /\ (q \/ r) = (p /\ q) \/ (p /\ r)"), REPEAT GEN_TAC THEN MAP_EVERY BOOL_CASES_TAC ["p"; "q"; "r"] THEN REWRITE_TAC [] );; let DISJ_CONJ_DISTRIB = TAC_PROOF (([],"!p q r. p \/ (q /\ r) = (p \/ q) /\ (p \/ r)"), REPEAT GEN_TAC THEN MAP_EVERY BOOL_CASES_TAC ["p"; "q"; "r"] THEN REWRITE_TAC [] );; let N_LEQ_SUC_M = TAC_PROOF (([],"! n m . (n <= (SUC m)) = ((n <= m) \/ (n = (SUC m)))"), REWRITE_TAC[LESS_OR_EQ; LESS_THM; SPECL ["n=m"; "nbool). ----------------------------------------------------------------% let EMPTY_REP_DEF = new_definition (`EMPTY_REP_DEF`, "EMPTY_REP = \x:*.F" );; let INSERT_REP_DEF = new_definition (`INSERT_REP_DEF`, "! (x:*) (s:*->bool) . INSERT_REP x s = (\y:* . (y = x) \/ (s y))" );; %---------------------------------------------------------------- let IS_SET_REP = new_definition (`IS_SET_REP`, "IS_SET_REP (s:*->bool) = ? x t .(s = EMPTY_REP) \/ (s = INSERT_REP x t)" );; ----------------------------------------------------------------% let IS_SET_REP = new_definition (`IS_SET_REP`, "IS_SET_REP (s:*->bool) = !P:((*->bool)->bool) . P EMPTY_REP /\ (!n x. P n ==> P(INSERT_REP x n)) ==> P s" );; let SET_REP_EXISTS = TAC_PROOF (([], "?(x:*->bool) . IS_SET_REP x"), PURE_REWRITE_TAC [IS_SET_REP] THEN EXISTS_TAC "EMPTY_REP:*->bool" THEN REPEAT STRIP_TAC );; let set_TY_DEF = new_type_definition (`set`, "IS_SET_REP:(*->bool)->bool", SET_REP_EXISTS);; %---------------------------------------------------------------- set_TY_DEF = |- ?rep. TYPE_DEFINITION IS_SET_REP rep ----------------------------------------------------------------% let set_ISO_DEF = define_new_type_bijections `set_ISO_DEF` `ABS_set` `REP_set` set_TY_DEF;; let R_11 = prove_rep_fn_one_one set_ISO_DEF and R_ONTO = prove_rep_fn_onto set_ISO_DEF and A_11 = prove_abs_fn_one_one set_ISO_DEF and A_ONTO = prove_abs_fn_onto set_ISO_DEF and A_R = CONJUNCT1 set_ISO_DEF and R_A = CONJUNCT2 set_ISO_DEF;; %---------------------------------------------------------------- R_11 = |- !a a'. (REP_set a = REP_set a') = (a = a') R_ONTO = |- !r. IS_SET_REP r = (?a. r = REP_set a) A_11 = |- !r r'. IS_SET_REP r ==> IS_SET_REP r' ==> ((ABS_set r = ABS_set r') = (r = r')) A_ONTO = |- !a. ?r. (a = ABS_set r) /\ IS_SET_REP r A_R = |- !a. ABS_set(REP_set a) = a R_A = |- !r. IS_SET_REP r = (REP_set(ABS_set r) = r) ----------------------------------------------------------------% let EMPTY_DEF = new_definition (`EMPTY_DEF`, "EMPTY = (ABS_set \x:*.F)" );; let EMPTY_DEF_LEMMA = TAC_PROOF (([], "EMPTY = (ABS_set (EMPTY_REP:*->bool))"), REWRITE_TAC [EMPTY_DEF; EMPTY_REP_DEF] );; let IN_DEF = new_infix_definition (`IN`, "$IN (x:*) (s:(*)set) = (REP_set s) x" );; let INSERT_DEF = new_definition (`INSERT_DEF`, "! (x:*) (s:(*)set) . INSERT x s = (ABS_set (\y:* . (y = x) \/ ((REP_set s) y)))" );; let INSERT_DEF_LEMMA = TAC_PROOF (([], "!s x. INSERT x s = (ABS_set (INSERT_REP x (REP_set s)))"), REWRITE_TAC [INSERT_DEF; INSERT_REP_DEF] );; let IS_SET_REP_EMPTY = TAC_PROOF (([], "IS_SET_REP (EMPTY_REP:*->bool)"), REWRITE_TAC [IS_SET_REP; EMPTY_REP_DEF; ] THEN REPEAT STRIP_TAC );; let R_A_lemma_1 = TAC_PROOF (([], "REP_set (ABS_set (\x. F)) = (\x.F)"), ACCEPT_TAC (REWRITE_RULE [ (REWRITE_RULE [EMPTY_REP_DEF] (SPEC_ALL IS_SET_REP_EMPTY))] (SPEC "\x.F" R_A)) );; let IS_SET_INSERT_REP = TAC_PROOF (([],"! x s.(IS_SET_REP s) ==> IS_SET_REP (INSERT_REP x s)"), PURE_REWRITE_TAC [IS_SET_REP; EMPTY_REP_DEF; INSERT_REP_DEF] THEN REPEAT STRIP_TAC THEN POP_ASSUM (\th . ASSUME_TAC (SPECL ["s"; "x"] th) THEN ASSUME_TAC th) THEN RES_TAC THEN RES_TAC );; let IS_SET_REP_INSERT_REP = TAC_PROOF (([],"! x s. IS_SET_REP (INSERT_REP x (REP_set s))"), REPEAT GEN_TAC THEN MATCH_MP_TAC IS_SET_INSERT_REP THEN REWRITE_TAC[R_ONTO] THEN EXISTS_TAC "s" THEN REFL_TAC );; let R_A_lemma_2 = TAC_PROOF (([], "!s x. REP_set (ABS_set (\y. (y = x) \/ REP_set s y)) = (\y. (y = x) \/ REP_set s y)"), REPEAT STRIP_TAC THEN ACCEPT_TAC (REWRITE_RULE [ (REWRITE_RULE [INSERT_REP_DEF] (SPEC_ALL IS_SET_REP_INSERT_REP))] (SPEC "(\y. (y = x) \/ REP_set s y)" R_A)) );; let R_A_lemma = CONJ R_A_lemma_1 R_A_lemma_2;; let REP_LEMMA = TAC_PROOF (([], "IS_SET_REP (REP_set (s:(*)set))"), REWRITE_TAC [R_ONTO] THEN EXISTS_TAC "s:(*)set" THEN REFL_TAC );; %---------------------------------------------------------------- prove some basic properties of sets ----------------------------------------------------------------% let im_lemma = TAC_PROOF (([], "(\y. (y = x) \/ (y = x) \/ REP_set s y) = (\y. (y = x) \/ REP_set s y)"), CONV_TAC (ONCE_DEPTH_CONV FUN_EQ_CONV) THEN GEN_TAC THEN BETA_TAC THEN BOOL_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let INSERT_MULTIPLICITY = prove_thm (`INSERT_MULTIPLICITY`, "! x s . INSERT x (INSERT x s) = INSERT x s", REPEAT GEN_TAC THEN REWRITE_TAC [INSERT_DEF;IN_DEF; R_11;A_11;A_R; R_A_lemma] THEN BETA_TAC THEN REWRITE_TAC [im_lemma] );; let lemma1 = TAC_PROOF (([], "(\y'. (y' = x) \/ (y' = y) \/ REP_set s y') = (\y'. (y' = y) \/ (y' = x) \/ REP_set s y')"), CONV_TAC (ONCE_DEPTH_CONV FUN_EQ_CONV) THEN GEN_TAC THEN BETA_TAC THEN BOOL_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let INSERT_ASSOC = prove_thm (`INSERT_ASSOC`, "! x y s . INSERT x (INSERT y s) = INSERT y (INSERT x s)", REPEAT GEN_TAC THEN ASM_REWRITE_TAC [INSERT_DEF;IN_DEF; R_11;A_R;R_A_lemma_2;] THEN BETA_TAC THEN ASM_REWRITE_TAC [] THEN ASM_CASES_TAC "x = y" THEN ASM_REWRITE_TAC [] THEN POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ASM_REWRITE_TAC [] THEN SUBST1_TAC lemma1 THEN REFL_TAC );; %---------------------------------------------------------------- set equality ----------------------------------------------------------------% let SET_EQ = prove_thm (`SET_EQ`, "! s1 s2 . (s1 = s2) = !x.(x IN s1) = (x IN s2)", REPEAT STRIP_TAC THEN EQ_TAC THENL [ % 1 % REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] ; % 2 % REWRITE_TAC [IN_DEF] THEN REPEAT STRIP_TAC THEN POP_ASSUM (\th . ACCEPT_TAC (REWRITE_RULE [R_11] (EXT th))) ] );; %---------------------------------------------------------------- Set Membership this is a hack, a cleaner proof exists ----------------------------------------------------------------% let IN = prove_thm (`IN`, "(!x. x IN EMPTY = F) /\ (!x y s . x IN (INSERT y s) = (x = y) \/ x IN s)", REWRITE_TAC [IN_DEF; EMPTY_DEF; INSERT_DEF; R_11;A_11;A_R;R_A_lemma] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC "REP_set s y" THEN ASM_REWRITE_TAC [R_A_lemma_2] THENL [ % 1 % ASM_CASES_TAC "x = y" THEN BETA_TAC THEN ASM_REWRITE_TAC [] ; % 2 % BETA_TAC THEN REFL_TAC ] );; %---------------------------------------------------------------- induction -- this parallels the derivation of induction by T. Melham for natural numbers. ----------------------------------------------------------------% let ind_lemma_1 = TAC_PROOF (([],"!P. P EMPTY_REP /\ (!(s:*->bool) x. (P s ==> P (INSERT_REP x s))) ==> (!(s:*->bool). IS_SET_REP s ==> P s)"), PURE_ONCE_REWRITE_TAC [IS_SET_REP] THEN REPEAT STRIP_TAC THEN RES_TAC );; let lemma = TAC_PROOF (([], "(A ==> A /\ B) = (A ==> B)"), ASM_CASES_TAC "A:bool" THEN ASM_REWRITE_TAC [] );; let ind_lemma_2 = TAC_PROOF (([],"!P. P EMPTY_REP /\ (!(s:*->bool) x. (IS_SET_REP s /\ P s ==> P (INSERT_REP x s))) ==> (!(s:*->bool). IS_SET_REP s ==> P s)"), GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPEC "\s:*->bool. IS_SET_REP s /\ P s" ind_lemma_1) THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC [lemma;IS_SET_REP_EMPTY] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THENL [IMP_RES_THEN MATCH_ACCEPT_TAC IS_SET_INSERT_REP; RES_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; let lemma1 = TAC_PROOF (([], "(! s:*->bool. IS_SET_REP s ==> P(ABS_set s)) = (! s. P s)"), EQ_TAC THEN REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "s:(*)set" A_ONTO) THEN RES_TAC THEN ASM_REWRITE_TAC [] );; % --------------------------------------------------------------------- % % NB: set_induction modified, because it was NOT in the standard form % % expected by INDUCT_THEN. [TFM 90.06.24] % % --------------------------------------------------------------------- % let set_induction = prove_thm (`set_induction`, "!P. (P EMPTY /\ (!s. P s ==> !x:*. P(INSERT x s))) ==> !s. P s", GEN_TAC THEN STRIP_TAC THEN MP_TAC (SPEC "\s:*->bool. P(ABS_set s):bool" ind_lemma_2) THEN BETA_TAC THEN ASM_REWRITE_TAC [(SYM_RULE EMPTY_DEF_LEMMA); lemma1] THEN DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC [R_ONTO] THEN REPEAT GEN_TAC THEN CONV_TAC ANTE_CONJ_CONV THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC [A_R; (SYM_RULE (SPEC_ALL INSERT_DEF_LEMMA))] THEN STRIP_TAC THEN RES_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC );; let SET_INDUCT_TAC = INDUCT_THEN set_induction ASSUME_TAC;; %---------------------------------------------------------------- SET_CASES_THM = |- !s. (s = EMPTY) \/ (?s' x. s = INSERT x s') ----------------------------------------------------------------% let SET_CASES_THM = save_thm(`SET_CASES_THM`, prove_cases_thm set_induction);; let SET_CASES_TAC t = DISJ_CASES_THEN STRIP_ASSUME_TAC (SPEC t SET_CASES_THM);; %---------------------------------------------------------------- SET_DISTINCT ----------------------------------------------------------------% let SET_DISTINCT = prove_thm (`SET_DISTINCT`, "!(x:*) s. ~(EMPTY = INSERT x s)", REPEAT GEN_TAC THEN REWRITE_TAC [SET_EQ; IN] THEN CONV_TAC (TOP_DEPTH_CONV NOT_FORALL_CONV) THEN EXISTS_TAC "x" THEN REWRITE_TAC [] );; %---------------------------------------------------------------- some properties of INSERT and EMPTY ----------------------------------------------------------------% let COMPONENT = prove_thm (`COMPONENT`, "! (x:*) s . x IN INSERT x s", REWRITE_TAC [IN] );; let NONEMPTY_MEMBER = prove_thm (`NONEMPTY_MEMBER`, "!s. ~(s = EMPTY) = ? x:* . x IN s", SET_INDUCT_TAC THEN REWRITE_TAC [IN] THEN REWRITE_TAC [SYM_RULE SET_DISTINCT] THEN GEN_TAC THEN EXISTS_TAC "x" % [TFM 90.06.24] % THEN REWRITE_TAC [] );; let ABSORPTION = prove_thm (`ABSORPTION`, "! x s . x IN s ==> (INSERT x s = s)", GEN_TAC THEN SET_INDUCT_TAC THEN REWRITE_TAC [IN; INSERT_MULTIPLICITY] THEN GEN_TAC % [TFM 90.06.24] % THEN ASM_CASES_TAC "x = x'" THEN ASM_REWRITE_TAC [INSERT_MULTIPLICITY] THEN STRIP_TAC THEN RES_TAC THEN SUBST1_TAC (SPECL["x";"x'";"s"] INSERT_ASSOC) THEN ASM_REWRITE_TAC [] );; let set_induction_2 = prove_thm (`set_induction_2`, "!P. P EMPTY /\ (!s .!x. (~(x IN s) ==> (P s ==> P(INSERT x s)))) ==> (!s. P s)", GEN_TAC THEN STRIP_TAC THEN SET_INDUCT_TAC THEN ASM_REWRITE_TAC [] THEN REPEAT GEN_TAC THEN SWAP_TOP_ASSUMP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SPECL ["s"; "x"] th)) THEN ASSUME_TAC (SPEC_ALL ABSORPTION) THEN ASM_CASES_TAC "x IN s" THEN RES_TAC THEN ASM_REWRITE_TAC [] );; %---------------------------------------------------------------- Taken from T. Melham's INDUCT_THEN (pre-1.12 version! [TFM 90.06.24]) ----------------------------------------------------------------% let SET_INDUCT_2_TAC (A,t) = (let x,body = dest_forall t in let th = set_induction_2 in let tyi = snd(match (fst(dest_forall (concl th))) "\^x.T") in let spec = SPEC (mk_abs(x,body)) (INST_TYPE tyi th) in let spec' = DISCH_ALL (CONV_RULE (GEN_ALPHA_CONV x) (UNDISCH spec)) in let thm = CONV_RULE(RAND_CONV(BINDER_CONV BETA_CONV)) spec' in let th_tac = ASSUME_TAC in let tac = (MATCH_MP_TAC thm THEN REPEAT CONJ_TAC THEN FIRST [CONV_TAC (DEPTH_FORALL_CONV BETA_CONV); CONV_TAC (GEN_ALPHA_CONV x) THEN REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_THEN (\th. CONV_TAC (DEPTH_FORALL_CONV BETA_CONV) THEN MAP_EVERY (th_tac o (CONV_RULE BETA_CONV)) (CONJUNCTS th))]) in (tac (A,t))) ? failwith `INDUCT_THEN`;; %---------------------------------------------------------------- member decomposition (there has to be a nicer proof) totally rewritten for version 12 resolution tools [TFM 91.01.23] ----------------------------------------------------------------% let MEMBER_DECOMP = prove_thm (`MEMBER_DECOMP`, "!s x. x IN s ==> ? t. ((s = INSERT x t) /\ ~(x IN t))", SET_INDUCT_2_TAC THEN REWRITE_TAC [IN] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "s:(*)set" THEN ASM_REWRITE_TAC []; RES_TAC THEN EXISTS_TAC "INSERT x t" THEN ASM_REWRITE_TAC [IN] THEN CONJ_TAC THENL [MATCH_ACCEPT_TAC INSERT_ASSOC; DISCH_THEN SUBST_ALL_TAC THEN RES_TAC]]);; %---------------------------------------------------------------- set union ----------------------------------------------------------------% let UNION_P = new_definition (`UNION_P`, "!(t:(*)set) s1 s2 . UNION_P t s1 s2 = !x . x IN t = x IN s1 \/ x IN s2" );; let UNION_DEF = new_infix_definition (`UNION_DEF`, "$UNION (s1:(*)set) s2 = @ t . UNION_P t s1 s2" );; let UNION_MEMBER_LEMMA = TAC_PROOF (([], "! (s1:(*)set) s2 . UNION_P (s1 UNION s2) s1 s2"), REWRITE_TAC [UNION_DEF] THEN REWRITE_TAC [SYM_RULE UNION_P] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN REPEAT GEN_TAC THEN REWRITE_TAC [UNION_P] THEN SPEC_TAC ("s1","s1") THEN SET_INDUCT_2_TAC THENL [ % 1 % REWRITE_TAC [IN] THEN EXISTS_TAC "s2" THEN REWRITE_TAC [] ; % 2 % UNDISCH_TAC "?t. !x'. x' IN t = x' IN s1 \/ x' IN s2" THEN REPEAT STRIP_TAC THEN EXISTS_TAC "(INSERT x t)" THEN GEN_TAC THEN REWRITE_TAC [IN] THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] ] );; let IN_UNION = save_thm (`IN_UNION`, REWRITE_RULE [UNION_P] UNION_MEMBER_LEMMA);; let UNION_EMPTY_LEMMA = TAC_PROOF (([], "! s:(*)set . EMPTY UNION s = s"), REWRITE_TAC [SET_EQ; IN_UNION;IN] );; let UNION_INSERT_LEMMA = TAC_PROOF (([], "! (x:*) (s1:(*)set) s2 . (INSERT x s1) UNION s2 = x IN s2 => s1 UNION s2 | (INSERT x (s1 UNION s2))"), REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC [SET_EQ; IN_UNION;IN] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let UNION = save_thm (`UNION`, CONJ UNION_EMPTY_LEMMA UNION_INSERT_LEMMA);; let UNION_ASSOC = prove_thm (`UNION_ASSOC`, "! (s1:(*)set) (s2:(*)set) (s3:(*)set) . (s1 UNION s2) UNION s3 = s1 UNION (s2 UNION s3)", SET_INDUCT_TAC THEN ASM_REWRITE_TAC [UNION] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [IN; IN_UNION] THEN ASM_CASES_TAC "x IN s3" THEN ASM_REWRITE_TAC [UNION] );; let UNION_IDENT = prove_thm (`UNION_IDENT`, "! (s:(*)set) . s UNION s = s", GEN_TAC THEN REWRITE_TAC [SET_EQ;IN_UNION] );; let UNION_SYM = prove_thm (`UNION_SYM`, "! (s1:(*)set) (s2:(*)set) . (s1 UNION s2) = (s2 UNION s1)", REPEAT GEN_TAC THEN REWRITE_TAC [SET_EQ; IN_UNION] THEN GEN_TAC THEN SUBST1_TAC (SPECL ["x IN s1"; "x IN s2"] DISJ_SYM) THEN REFL_TAC );; %---------------------------------------------------------------- set intersection ----------------------------------------------------------------% let INTERSECT_P = new_definition (`INTERSECT_P`, "!(t:(*)set) s1 s2 . INTERSECT_P t s1 s2 = !x . x IN t = x IN s1 /\ x IN s2" );; let INTERSECT_DEF = new_infix_definition (`INTERSECT_DEF`, "$INTERSECT (s1:(*)set) s2 = @ t . INTERSECT_P t s1 s2" );; let INTERSECT_MEMBER_LEMMA = TAC_PROOF (([], "! (s1:(*)set) s2 . INTERSECT_P (s1 INTERSECT s2) s1 s2"), REWRITE_TAC [INTERSECT_DEF] THEN REWRITE_TAC [SYM_RULE INTERSECT_P] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN REPEAT GEN_TAC THEN REWRITE_TAC [INTERSECT_P] THEN SPEC_TAC ("s1","s1") THEN SET_INDUCT_2_TAC THENL [ % 1 % REWRITE_TAC [IN] THEN EXISTS_TAC "EMPTY:(*)set" THEN REWRITE_TAC [IN] ; % 2 % POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC "x IN s2" THENL [ % 2.1 % EXISTS_TAC "(INSERT x t)" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ; % 2.2 % EXISTS_TAC "t" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ] THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] ] );; let IN_INTERSECT = save_thm (`IN_INTERSECT`, REWRITE_RULE [INTERSECT_P] INTERSECT_MEMBER_LEMMA);; let INTERSECT_EMPTY_LEMMA = TAC_PROOF (([], "! s:(*)set . EMPTY INTERSECT s = EMPTY"), REWRITE_TAC [SET_EQ; IN_INTERSECT;IN] );; let INTERSECT_INSERT_LEMMA = TAC_PROOF (([], "! (x:*) (s1:(*)set) s2 . (INSERT x s1) INTERSECT s2 = x IN s2 => (INSERT x (s1 INTERSECT s2)) | s1 INTERSECT s2"), REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC [SET_EQ; IN_INTERSECT;IN] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let INTERSECT = save_thm (`INTERSECT`, CONJ INTERSECT_EMPTY_LEMMA INTERSECT_INSERT_LEMMA);; let INTERSECT_ASSOC = prove_thm (`INTERSECT_ASSOC`, "! (s1:(*)set) (s2:(*)set) (s3:(*)set) . (s1 INTERSECT s2) INTERSECT s3 = s1 INTERSECT (s2 INTERSECT s3)", SET_INDUCT_TAC THEN ASM_REWRITE_TAC [INTERSECT] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [IN; IN_INTERSECT] THEN ASM_CASES_TAC "x IN s3" THEN ASM_REWRITE_TAC [INTERSECT] );; let INTERSECT_IDENT = prove_thm (`INTERSECT_IDENT`, "! (s:(*)set) . s INTERSECT s = s", GEN_TAC THEN REWRITE_TAC [SET_EQ;IN_INTERSECT] );; let INTERSECT_SYM = prove_thm (`INTERSECT_SYM`, "! (s1:(*)set) (s2:(*)set) . (s1 INTERSECT s2) = (s2 INTERSECT s1)", REPEAT GEN_TAC THEN REWRITE_TAC [SET_EQ; IN_INTERSECT] THEN GEN_TAC THEN SUBST1_TAC (SPECL ["x IN s1"; "x IN s2"] CONJ_SYM) THEN REFL_TAC );; %---------------------------------------------------------------- distributivity of union and intersection ----------------------------------------------------------------% let UNION_OVER_INTERSECT = prove_thm (`UNION_OVER_INTERSECT`, "! (s1:(*)set) s2 s3 . (s1 INTERSECT (s2 UNION s3)) = ((s1 INTERSECT s2) UNION (s1 INTERSECT s3))", REWRITE_TAC [SET_EQ; IN_INTERSECT;IN_UNION] THEN REPEAT GEN_TAC THEN SUBST1_TAC (SPECL ["x IN s1"; "x IN s2"; "x IN s3"] CONJ_DISJ_DISTRIB) THEN REFL_TAC );; let INTERSECT_OVER_UNION = prove_thm (`INTERSECT_OVER_UNION`, "! (s1:(*)set) s2 s3 . (s1 UNION (s2 INTERSECT s3)) = ((s1 UNION s2) INTERSECT (s1 UNION s3))", REWRITE_TAC [SET_EQ; IN_UNION;IN_INTERSECT] THEN REPEAT GEN_TAC THEN SUBST1_TAC (SPECL ["x IN s1"; "x IN s2"; "x IN s3"] DISJ_CONJ_DISTRIB) THEN REFL_TAC );; %---------------------------------------------------------------- disjoint ----------------------------------------------------------------% let DISJOINT = new_definition (`DISJOINT`, "! (s:(*)set) t. DISJOINT s t = (s INTERSECT t = EMPTY)" );; let DISJOINT_MEMBER = prove_thm (`DISJOINT_MEMBER`, "! s t. (DISJOINT s t) = ~(? x . x IN s /\ x IN t)", REWRITE_TAC [DISJOINT] THEN SET_INDUCT_2_TAC THEN REWRITE_TAC [IN;INTERSECT] THEN GEN_TAC THEN COND_CASES_TAC THENL [% subgoal 1 % REWRITE_TAC [(SYM_RULE SET_DISTINCT)] THEN EXISTS_TAC "x" THEN ASM_REWRITE_TAC [] ; % subgoal 2 % SWAP_TOP_ASSUMP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SPEC_ALL th)) THEN ASM_REWRITE_TAC [NOT_EQ_REV] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [% subgoal 1 % EXISTS_TAC "x'" THEN ASM_REWRITE_TAC [] ; % subgoal 2 % MAP_EVERY UNDISCH_TAC ["x' IN t"] THEN ASM_REWRITE_TAC [] ; % subgoal 3 % EXISTS_TAC "x'" THEN ASM_REWRITE_TAC [] ] ] );; %---------------------------------------------------------------- deletion ----------------------------------------------------------------% let DELETE_P = new_definition (`DELETE_P`, "!(t:(*)set) s (y:*). DELETE_P t s y= !x . x IN t = x IN s /\ ~(x = y)" );; let DELETE_DEF = new_infix_definition (`DELETE_DEF`, "$DELETE (s:(*)set) y = @ t . DELETE_P t s y" );; let DELETE_MEMBER_LEMMA = TAC_PROOF (([], "! (s:(*)set) y . DELETE_P (s DELETE y) s y"), REWRITE_TAC [DELETE_DEF] THEN REWRITE_TAC [SYM_RULE DELETE_P] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN REPEAT GEN_TAC THEN REWRITE_TAC [DELETE_P] THEN SPEC_TAC ("s","s") THEN SET_INDUCT_2_TAC THENL [ % 1 % EXISTS_TAC "EMPTY:(*)set" THEN REWRITE_TAC [IN] ; % 2 % POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC "x = y" THEN ASM_REWRITE_TAC [] THENL [ % 2.1 % EXISTS_TAC "s" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ; % 2.2 % EXISTS_TAC "(INSERT x t)" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ] THEN POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ASM_CASES_TAC "x' = y" THEN ASM_REWRITE_TAC [] ] );; % Previously DELETE_MEMBER was saved with name IN_DELETE (MJCG 25 May 89) % let DELETE_MEMBER = save_thm (`DELETE_MEMBER`, REWRITE_RULE [DELETE_P] DELETE_MEMBER_LEMMA);; let DELETE_EMPTY_LEMMA = TAC_PROOF (([], "! y:* . EMPTY DELETE y = EMPTY"), REWRITE_TAC [SET_EQ; DELETE_MEMBER;IN] );; let DELETE_INSERT_LEMMA = TAC_PROOF (([], "! (x:*) (s:(*)set) y . (INSERT x s) DELETE y = ((x = y) => s DELETE y | (INSERT x (s DELETE y)))"), REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC [SET_EQ; DELETE_MEMBER;IN] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let DELETE = save_thm (`DELETE`, CONJ DELETE_EMPTY_LEMMA DELETE_INSERT_LEMMA);; let DELETE_DECOMPOSITION = prove_thm (`DELETE_DECOMPOSITION`, "! s x . x IN s ==> (s = (INSERT x (s DELETE x)))", REPEAT STRIP_TAC THEN REWRITE_TAC [SET_EQ;DELETE_MEMBER] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [IN; DELETE_MEMBER] );; let DELETE_ABSORPTION = prove_thm (`DELETE_ABSORPTION`, "! s x . ~(x IN s) ==> (s = s DELETE x)", REPEAT STRIP_TAC THEN REWRITE_TAC [SET_EQ; DELETE_MEMBER] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; %---------------------------------------------------------------- choice and rest (delayed so that they are definitional) ----------------------------------------------------------------% let CHOICE = new_definition (`CHOICE`, "! s:(*)set . CHOICE s = @ x . x IN s" );; let REST = new_definition (`REST`, "! s:(*)set . REST s = s DELETE (CHOICE s)" );; let CHOICE_MEMBER = prove_thm (`CHOICE_MEMBER`, "! s:(*)set . ~(s = EMPTY) ==> (CHOICE s) IN s", SET_INDUCT_2_TAC THEN REWRITE_TAC [IN; (SYM_RULE SET_DISTINCT)] THEN ASM_CASES_TAC "s = EMPTY:(*)set" THEN RES_TAC THEN ASM_REWRITE_TAC [IN] THEN REWRITE_TAC [CHOICE; IN] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN EXISTS_TAC "x" THEN REWRITE_TAC [] );; let CHOICE_DECOMPOSITION = prove_thm (`CHOICE_DECOMPOSITION`, "! s:(*)set . ~(s = EMPTY) ==> (s = (INSERT (CHOICE s) (REST s)))", REPEAT STRIP_TAC THEN REWRITE_TAC [CHOICE; REST] THEN ASSUME_TAC (REWRITE_RULE [CHOICE] (SPEC_ALL CHOICE_MEMBER)) THEN ASSUME_TAC (SPECL ["s"; "@ x . x IN s"] DELETE_DECOMPOSITION) THEN RES_TAC THEN RES_TAC );; let CHOICE_NON_MEMBER = prove_thm (`CHOICE_NON_MEMBER`, "! s:(*)set . ~(s = EMPTY) ==> ~((CHOICE s) IN (REST s))", REPEAT GEN_TAC THEN REWRITE_TAC [CHOICE; REST; DELETE_MEMBER] );; %---------------------------------------------------------------- set difference ----------------------------------------------------------------% let DIFF_P = new_definition (`DIFF_P`, "!(t:(*)set) s1 s2. DIFF_P t s1 s2= !x . x IN t = x IN s1 /\ ~(x IN s2)" );; let DIFF_DEF = new_infix_definition (`DIFF_DEF`, "$DIFF (s:(*)set) y = @ t . DIFF_P t s y" );; let DIFF_EXISTS = TAC_PROOF (([], "!(s1:(*)set) s2 .? t:(*)set . DIFF_P t s1 s2"), REPEAT GEN_TAC THEN REWRITE_TAC [DIFF_P] THEN SPEC_TAC ("s1","s1") THEN SET_INDUCT_2_TAC THENL [ % 1 % EXISTS_TAC "EMPTY:(*)set" THEN REWRITE_TAC [IN] ; % 2 % POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC "x IN s2" THEN ASM_REWRITE_TAC [] THENL [ % 2.1 % EXISTS_TAC "t" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ; % 2.2 % EXISTS_TAC "(INSERT x t)" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ] THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] ] );; let DIFF_MEMBER_LEMMA = TAC_PROOF (([], "! (s1:(*)set) s2. DIFF_P (s1 DIFF s2) s1 s2"), REWRITE_TAC [DIFF_DEF] THEN REWRITE_TAC [SYM_RULE DIFF_P] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN ACCEPT_TAC DIFF_EXISTS );; let DIFF_MEMBER = save_thm (`IN_DIFF`, REWRITE_RULE [DIFF_P] DIFF_MEMBER_LEMMA);; let DIFF_EMPTY_LEMMA = TAC_PROOF (([], "! s:(*)set . s DIFF EMPTY = s"), REWRITE_TAC [SET_EQ; DIFF_MEMBER;IN] );; let DIFF_INSERT_LEMMA = TAC_PROOF (([], "! (s:(*)set) t (x:*). s DIFF (INSERT x t) = (s DELETE x) DIFF t"), REPEAT GEN_TAC THEN REWRITE_TAC [SET_EQ; DIFF_MEMBER;IN; DELETE_MEMBER] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let DIFF = save_thm (`DIFF`, CONJ DIFF_EMPTY_LEMMA DIFF_INSERT_LEMMA);; %---------------------------------------------------------------- subsets ----------------------------------------------------------------% let SUBSET_MEMBER = new_infix_definition (`SUBSET_MEMBER`, "! (s:(*)set) (t:(*)set) . $SUBSET s t = (! y. y IN s ==> y IN t)" );; let SUBSET_EMPTY_LEMMA = TAC_PROOF (([], "! (s:(*)set). (EMPTY SUBSET s = T)"), REWRITE_TAC [SET_EQ; SUBSET_MEMBER;IN] );; let SUBSET_INSERT_LEMMA = TAC_PROOF (([], "!(x:*) (s:(*)set) t .(((INSERT x s) SUBSET t) = x IN t /\ (SUBSET s t))"), REPEAT GEN_TAC THEN REWRITE_TAC [SUBSET_MEMBER;IN] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ % 1 % POP_ASSUM (\th. ACCEPT_TAC (REWRITE_RULE [] (SPEC "x" th))) ; % 2 % RES_TAC ;% 3 % ASM_REWRITE_TAC [] ; % 4 % RES_TAC ] );; let SUBSET = save_thm (`SUBSET`, CONJ SUBSET_EMPTY_LEMMA SUBSET_INSERT_LEMMA);; let SUBSET_UNION = prove_thm (`SUBSET_UNION`, "! (s:(*)set) t . s SUBSET (s UNION t) /\ (t SUBSET (s UNION t))", REPEAT GEN_TAC THEN CONJ_TAC THEN REWRITE_TAC [SUBSET_MEMBER; IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] );; let SUBSET_INTERSECT = prove_thm (`SUBSET_INTERSECT`, "! (s:(*)set) t . (s INTERSECT t) SUBSET s /\ ((s INTERSECT t) SUBSET t)", REPEAT GEN_TAC THEN CONJ_TAC THEN REWRITE_TAC [SUBSET_MEMBER; IN_INTERSECT] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] );; let SUBSET_DELETE = prove_thm (`SUBSET_DELETE`, "!(s:(*)set) x. ~(s = EMPTY) ==> (s DELETE x) SUBSET s ", REPEAT STRIP_TAC THEN REWRITE_TAC [SUBSET_MEMBER; DELETE_MEMBER] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] );; let SUBSET_UNION_ABSORPTION = prove_thm (`SUBSET_UNION_ABSORPTION`, "! (s:(*)set) t . s SUBSET t = (s UNION t = t)", REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ % 1 % POP_ASSUM MP_TAC THEN SPEC_TAC ("s", "s") THEN SET_INDUCT_2_TAC THEN REWRITE_TAC [SUBSET; UNION] THEN ASM_CASES_TAC "x IN t" THEN ASM_REWRITE_TAC [] ; % 2 % POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ONCE_ASM_REWRITE_TAC [] THEN REWRITE_TAC [SUBSET_UNION] ] );; let SUBSET_INTERSECT_ABSORPTION = prove_thm (`SUBSET_INTERSECT_ABSORPTION`, "! (s:(*)set) t . s SUBSET t = (s INTERSECT t = s)", REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [ % 1 % POP_ASSUM MP_TAC THEN SPEC_TAC ("s", "s") THEN SET_INDUCT_2_TAC THEN REWRITE_TAC [SUBSET; INTERSECT] THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] ; % 2 % POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ONCE_ASM_REWRITE_TAC [] THEN REWRITE_TAC [SUBSET_INTERSECT] ] );; let SUBSET_TRANS = prove_thm (`SUBSET_TRANS`, "! (s1:(*)set) s2 s3 . (s1 SUBSET s2) /\ ( s2 SUBSET s3) ==> s1 SUBSET s3", REWRITE_TAC [SUBSET_UNION_ABSORPTION] THEN REPEAT STRIP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ONCE_ASM_REWRITE_TAC [] THEN POP_ASSUM (K ALL_TAC) THEN ASM_REWRITE_TAC [(SYM_RULE UNION_ASSOC)] );; let SUBSET_ANTISYM = prove_thm (`SUBSET_ANTISYM`, "! (s:(*)set) t . (s SUBSET t) /\ (t SUBSET s) ==> (s = t)", REWRITE_TAC [SUBSET_UNION_ABSORPTION] THEN REPEAT STRIP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ONCE_ASM_REWRITE_TAC [] THEN POP_TOP_ASSUMP_TAC THEN ASM_REWRITE_TAC [UNION_SYM] );; let SUBSET_REFL = prove_thm (`SUBSET_REFL`, "! (s:(*)set) . s SUBSET s", REWRITE_TAC [SUBSET_UNION_ABSORPTION; UNION_IDENT] );; %---------------------------------------------------------------- proper subset ----------------------------------------------------------------% let PSUBSET = new_infix_definition (`PSUBSET`, "! (s:(*)set) t . PSUBSET s t = (s SUBSET t) /\ ~(s = t)" );; let PSUBSET_TRANS = prove_thm (`PSUBSET_TRANS`, "! (s:(*)set) t . s PSUBSET t = (! x . x IN s ==> x IN t) /\ (? y . y IN t /\ ~(y IN s))", REPEAT GEN_TAC THEN REWRITE_TAC [PSUBSET; SUBSET_MEMBER] THEN REWRITE_TAC [SET_EQ] THEN CONV_TAC (TOP_DEPTH_CONV NOT_FORALL_CONV) THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC [] THENL [ % 1 % EXISTS_TAC "x" THEN POP_ASSUM MP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SPEC "x" th)) THEN POP_ASSUM MP_TAC THEN MAP_EVERY BOOL_CASES_TAC ["x IN s"; "x IN t"] THEN REWRITE_TAC [] ; % 2 % EXISTS_TAC "y" THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN MAP_EVERY BOOL_CASES_TAC ["y IN s"; "y IN t"] THEN REWRITE_TAC [] ] );; let PSUBSET_REFL = prove_thm (`PSUBSET_REFL`, "! s:(*)set . ~(s PSUBSET s)", REWRITE_TAC [PSUBSET] );; let PSUBSET_REST = prove_thm (`PSUBSET_REST`, "! s:(*)set . ~(s = EMPTY) ==> ((REST s) PSUBSET s)", REWRITE_TAC [REST; PSUBSET] THEN GEN_TAC THEN STRIP_TAC THEN ASSUME_TAC (SPECL ["s"; "(CHOICE s):*"] SUBSET_DELETE) THEN RES_TAC THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [SET_EQ; DELETE_MEMBER] THEN ASSUME_TAC (SPEC_ALL CHOICE_MEMBER) THEN RES_TAC THEN CONV_TAC (TOP_DEPTH_CONV NOT_FORALL_CONV) THEN EXISTS_TAC "(CHOICE s):*" THEN ASM_REWRITE_TAC [] );; %---------------------------------------------------------------- set constructor ----------------------------------------------------------------% let MK_SET_P = new_definition (`MK_SET_P`, "!(t:(*)set) s (f:*->bool). MK_SET_P t s f= !x . x IN t = x IN s /\ f x" );; let MK_SET_DEF = new_definition (`MK_SET_DEF`, "MK_SET (s:(*)set) y = @ t . MK_SET_P t s y" );; let MK_SET_EXISTS = TAC_PROOF (([], "!(s:(*)set) (f:*->bool).? t:(*)set . MK_SET_P t s f"), REPEAT GEN_TAC THEN REWRITE_TAC [MK_SET_P] THEN SPEC_TAC ("s","s") THEN SET_INDUCT_2_TAC THENL [ % 1 % EXISTS_TAC "EMPTY:(*)set" THEN REWRITE_TAC [IN] ; % 2 % POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC THEN ASM_CASES_TAC "(f:*->bool) x" THEN ASM_REWRITE_TAC [] THENL [ % 2.1 % EXISTS_TAC "(INSERT x t)" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ; % 2.2 % EXISTS_TAC "t" THEN GEN_TAC THEN ASM_REWRITE_TAC [IN] ] THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] ] );; let MK_SET_MEMBER_LEMMA = TAC_PROOF (([], "! (s:(*)set) (f:*->bool). MK_SET_P (MK_SET s f) s f"), REWRITE_TAC [MK_SET_DEF] THEN REWRITE_TAC [SYM_RULE MK_SET_P] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN ACCEPT_TAC MK_SET_EXISTS );; let MK_SET_MEMBER = save_thm (`IN_MK_SET`, REWRITE_RULE [MK_SET_P] MK_SET_MEMBER_LEMMA);; let MK_SET_EMPTY_LEMMA = TAC_PROOF (([], "! f:*->bool . MK_SET (EMPTY:(*)set) f = EMPTY"), REWRITE_TAC [SET_EQ; MK_SET_MEMBER;IN] );; let MK_SET_INSERT_LEMMA = TAC_PROOF (([], "! (x:*) (s:(*)set) (f:*->bool). MK_SET (INSERT x s) f = (f x => INSERT x (MK_SET s f) | MK_SET s f)"), REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC [SET_EQ; MK_SET_MEMBER;IN; DELETE_MEMBER] THEN GEN_TAC THEN ASM_CASES_TAC "x' = x" THEN ASM_REWRITE_TAC [] );; let MK_SET = save_thm (`MK_SET`, CONJ MK_SET_EMPTY_LEMMA MK_SET_INSERT_LEMMA);; let MK_SET_TRUE = prove_thm (`MK_SET_TRUE`, "! s:(*)set . MK_SET s (\x:*.T) = s", SET_INDUCT_TAC THEN REWRITE_TAC [MK_SET] THEN ASM_REWRITE_TAC [] );; let MK_SET_FALSE = prove_thm (`MK_SET_FALSE`, "! s:(*)set . MK_SET s (\x:*.F) = EMPTY", SET_INDUCT_TAC THEN REWRITE_TAC [MK_SET] THEN ASM_REWRITE_TAC [] );; let MK_SET_INTERSECT = prove_thm (`MK_SET_INTERSECT`, "! s t. s INTERSECT t = (MK_SET s (\x:*. x IN t))", SET_INDUCT_TAC THEN REWRITE_TAC [MK_SET; INTERSECT] THEN REPEAT GEN_TAC THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN POP_ASSUM (\th. ASSUME_TAC (SPEC_ALL th)) THEN ASM_REWRITE_TAC [] );; let MK_SET_DELETE = prove_thm (`MK_SET_DELETE`, "! s y . s DELETE y = (MK_SET s (\x:*. ~(x = y)))", SET_INDUCT_TAC THEN REWRITE_TAC [MK_SET; DELETE] THEN REPEAT GEN_TAC THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN POP_ASSUM (\th. ASSUME_TAC (SPEC_ALL th)) THEN ASM_CASES_TAC "x = y" THEN ASM_REWRITE_TAC [] );; let MK_SET_DIFF = prove_thm (`MK_SET_DIFF`, "! t s . s DIFF t = (MK_SET s (\x:*. ~(x IN t)))", SET_INDUCT_TAC THEN REWRITE_TAC [MK_SET; DIFF] THEN REPEAT GEN_TAC THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THENL [% 1 % REWRITE_TAC [IN; MK_SET_TRUE] ; % 2 % REWRITE_TAC [IN; MK_SET_DELETE] THEN REWRITE_TAC [DE_MORGAN_THM] THEN POP_ASSUM (\th. ASSUME_TAC (SPEC "(MK_SET s(\x'. ~(x' = x)))" th)) THEN ASM_REWRITE_TAC [] THEN REWRITE_TAC [SET_EQ; MK_SET_MEMBER] THEN GEN_TAC THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [(SYM_RULE CONJ_ASSOC)] ] );; let MK_SET_OR = prove_thm (`MK_SET_OR`, "! s f g . MK_SET s (\x . (f x) \/ (g x)) = (MK_SET s f) UNION (MK_SET s g)", REPEAT GEN_TAC THEN REWRITE_TAC [SET_EQ; MK_SET_MEMBER; IN_UNION] THEN GEN_TAC THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [CONJ_DISJ_DISTRIB] );; let MK_SET_AND = prove_thm (`MK_SET_AND`, "! s f g . MK_SET s (\x . (f x) /\ (g x)) = (MK_SET s f) INTERSECT (MK_SET s g)", GEN_TAC THEN REWRITE_TAC [SET_EQ; MK_SET_MEMBER; IN_INTERSECT] THEN REPEAT GEN_TAC THEN CONV_TAC (TOP_DEPTH_CONV BETA_CONV) THEN BOOL_CASES_TAC " x IN s" THEN REWRITE_TAC [(SYM_RULE CONJ_ASSOC)] );; %---------------------------------------------------------------- singleton sets ----------------------------------------------------------------% let SING = new_definition (`SING`, "! s:(*)set . SING(s) = ? x . s = (INSERT x EMPTY)" );; let SING_CHOICE = prove_thm (`SING_CHOICE`, "! (x:*) . (CHOICE (INSERT x EMPTY)) = x", GEN_TAC THEN REWRITE_TAC [CHOICE; IN] THEN CONV_TAC (TOP_DEPTH_CONV SELECT_CONV) THEN EXISTS_TAC "x" THEN REFL_TAC );; % Proof of SING_REST rewritten for version 12 [TFM 91.01.23] % let SING_REST = prove_thm (`SING_REST`, "! s:(*)set . SING s = ~(s = EMPTY) /\ (REST s = EMPTY)", PURE_ONCE_REWRITE_TAC [SING;REST] THEN GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (STRIP_THM_THEN SUBST1_TAC) THEN REWRITE_TAC [SING_CHOICE;DELETE] THEN DISCH_THEN (ASSUME_TAC o SYM) THEN IMP_RES_TAC SET_DISTINCT; STRIP_TAC THEN EXISTS_TAC "(CHOICE s):*" THEN IMP_RES_TAC CHOICE_MEMBER THEN IMP_RES_THEN (\th. SUBST_OCCS_TAC [[1],th]) DELETE_DECOMPOSITION THEN ASM_REWRITE_TAC []]);; loadt `card`;; % This loads in a definition from Philippe Leveilley and his proof from this definition of Phil Windley's axiom CARD % %---------------------------------------------------------------- Obsolete comment: cardinality If you must use cardinality, realize that it uses new_axiom. I'm fairly certain that this leads to no inconsistancies, but I'm not guarenteeing anything. The axiom below is now replaced by the theorem with the same name proved in card.ml. This file was created by Philippe Leveilley. let CARD = new_axiom (`CARD`, "(CARD (EMPTY:(*)set) = 0) /\ ! (x:*) (s:(*)set) . CARD (INSERT x s) = (x IN s => (CARD s) | SUC (CARD s))" );; ----------------------------------------------------------------% let CARD_EQ_0 = prove_thm (`CARD_EQ_0`, "! s:(*)set . (CARD s = 0) ==> (s = EMPTY)", SET_INDUCT_2_TAC THEN ASM_REWRITE_TAC [CARD; num_CONV "1"; ADD_CLAUSES; NOT_SUC] );; let CARD_ABSORPTION = prove_thm (`CARD_ABSORPTION`, "! (s:(*)set) x. x IN s ==> (((CARD (INSERT x s)):num) = (CARD s))", REPEAT GEN_TAC THEN STRIP_TAC THEN ASSUME_TAC (SPEC_ALL ABSORPTION) THEN RES_TAC THEN ASM_REWRITE_TAC [] );; let CARD_INTERSECT = prove_thm (`CARD_INTERSECT`, "! (s:(*)set) t . (CARD (s INTERSECT t)) <= (CARD s) /\ (CARD (s INTERSECT t)) <= (CARD t)", REPEAT GEN_TAC THEN CONJ_TAC THENL [ % 1 % SPEC_TAC ("s", "s") THEN SET_INDUCT_2_TAC THEN REWRITE_TAC [INTERSECT; CARD] THENL [ % 1.1 % REWRITE_TAC [LESS_OR_EQ; (ONCE_REWRITE_RULE [DISJ_SYM] LESS_0_CASES)] ; % 1.2 % ASM_CASES_TAC "x IN t" THEN ASM_REWRITE_TAC [CARD] THENL [ ASM_REWRITE_TAC [IN_INTERSECT; num_CONV "1"; ADD_CLAUSES; LESS_OR_EQ; LESS_MONO_EQ;INV_SUC_EQ] THEN ASM_REWRITE_TAC [(SYM_RULE LESS_OR_EQ)] ; ASM_REWRITE_TAC [(SYM_RULE ADD1); N_LEQ_SUC_M] ] ] ; % 2 % SPEC_TAC ("t", "t") THEN ONCE_REWRITE_TAC [INTERSECT_SYM] THEN SET_INDUCT_2_TAC THEN REWRITE_TAC [INTERSECT; CARD] THENL [ % 2.1 % REWRITE_TAC [LESS_OR_EQ; (ONCE_REWRITE_RULE [DISJ_SYM] LESS_0_CASES)] ; % 2.2 % ASM_CASES_TAC "x IN s" THEN ASM_REWRITE_TAC [CARD] THENL [ ASM_REWRITE_TAC [IN_INTERSECT; num_CONV "1"; ADD_CLAUSES; LESS_OR_EQ; LESS_MONO_EQ;INV_SUC_EQ] THEN ASM_REWRITE_TAC [(SYM_RULE LESS_OR_EQ)] ; ASM_REWRITE_TAC [(SYM_RULE ADD1); N_LEQ_SUC_M] ] ] ] );; let CARD_UNION = prove_thm (`CARD_UNION`, "! (s:(*)set) t . CARD (s UNION t) + CARD (s INTERSECT t) = CARD s + CARD t", SET_INDUCT_2_TAC THEN REWRITE_TAC [CARD; INTERSECT; UNION] THENL [ % 1 % GEN_TAC THEN SUBST1_TAC (SPECL ["(CARD (t:(*)set)):num"; "0"] ADD_SYM) THEN REFL_TAC ; % 2 % GEN_TAC THEN ASM_CASES_TAC "x IN t" THEN ASM_REWRITE_TAC [CARD; IN_INTERSECT; IN_UNION] THEN ASM_REWRITE_TAC [(SYM_RULE ADD1); ADD_CLAUSES; INV_SUC_EQ] ] );; let CARD_SUBSET = prove_thm (`CARD_SUBSET`, "! (s:(*)set) t . s SUBSET t ==> CARD s <= CARD t", REPEAT GEN_TAC THEN REWRITE_TAC [SUBSET_INTERSECT_ABSORPTION] THEN STRIP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SYM_RULE th)) THEN ONCE_ASM_REWRITE_TAC [] THEN REWRITE_TAC [CARD_INTERSECT] );; let PSUBSET_LEMMA_1 = TAC_PROOF (([], "! (s:(*)set) t . (? x . ~ x IN s /\ (INSERT x s) SUBSET t) ==> CARD s < CARD t"), REPEAT STRIP_TAC THEN ASSUME_TAC CARD_SUBSET THEN RES_TAC THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC [CARD; (SYM_RULE ADD1); OR_LESS] );; let PSUBSET_LEMMA_2 = TAC_PROOF (([], "! (s:(*)set) t . s PSUBSET t ==> (? x . ~ x IN s /\ (INSERT x s) SUBSET t)"), REPEAT GEN_TAC THEN REWRITE_TAC [PSUBSET] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [SUBSET] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC [SET_EQ] THEN CONV_TAC (TOP_DEPTH_CONV NOT_FORALL_CONV) THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x" THEN SWAP_TOP_ASSUMP_TAC THEN POP_ASSUM (\th. ASSUME_TAC (SPEC "x" (REWRITE_RULE [SUBSET_MEMBER] th))) THEN POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN BOOL_CASES_TAC "x IN t" THEN REWRITE_TAC [] );; % Proof revised for version 1.12 [TFM 91.01.23] % let CARD_PSUBSET = prove_thm (`CARD_PSUBSET`, "! (s:(*)set) t . s PSUBSET t ==> CARD s < CARD t", REPEAT STRIP_TAC THEN IMP_RES_TAC PSUBSET_LEMMA_2 THEN IMP_RES_TAC PSUBSET_LEMMA_1);; let SING_CARD = prove_thm (`SING_CARD`, "! s:(*)set . SING(s) = (CARD(s) = 1)", GEN_TAC THEN REWRITE_TAC [SING] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [% 1 % ASM_REWRITE_TAC [CARD; IN; num_CONV "1"; ADD_CLAUSES] ; % 2 % POP_ASSUM MP_TAC THEN SPEC_TAC ("s","s") THEN SET_INDUCT_2_TAC THEN ASM_REWRITE_TAC [CARD; num_CONV "1"; ADD_CLAUSES; INV_SUC_EQ; (SYM_RULE NOT_SUC); ] THEN STRIP_TAC THEN EXISTS_TAC "x" THEN ASSUME_TAC CARD_EQ_0 THEN RES_TAC THEN ASM_REWRITE_TAC [] ] );; quit();; % Needed for Common Lisp % hol88-2.02.19940316/Library/finite_sets/OLD/load_finite_sets.ml0000640000212700021270000000230604751051137022133 0ustar cammcamm% ===================================================================== % % FILE : load_finite_sets.ml % % DESCRIPTION : creates a function that loads the contents of the % % library "finite_sets" into hol. % % % % AUTHOR : T. Melham % % DATE : 91.01.24 % % ===================================================================== % % --------------------------------------------------------------------- % % define the function load_finite_sets. % % --------------------------------------------------------------------- % let load_finite_sets (v:void) = if (mem `finite_sets` (ancestry())) then (print_string `Loading contents of finite_sets...`; print_newline(); let path st = library_pathname() ^ `/finite_sets/` ^ st in load(path `set_ind`, get_flag_value `print_lib`); let defs = map fst (definitions `finite_sets`) in map (\st. autoload_theory(`definition`,`finite_sets`,st)) defs; let thms = map fst (theorems `finite_sets`) in map (\st. autoload_theory(`theorem`,`finite_sets`,st)) thms; delete_cache `finite_sets`; ()) else failwith `theory finite_sets not an ancestor of the current theory`;; hol88-2.02.19940316/Library/finite_sets/LOG0000640000212700021270000003600505223612640016214 0ustar cammcammrm -f *_ml.o *_ml.l *.th ===> library finite_sets: object code and theory files deleted rm -f finite_sets.th echo 'set_flag(`abort_when_fail`,true);;'\ 'loadt `mk_finite_sets`;;' | ../../hol __ _ _ __ __ _ __ _ _ __ _ |___ | | /_\ |__ |__ | | |__| | | | | |__ |__ / \ __| __| | |__ | | |__| |__ HOL88 Version 2.01 (Franz: pre-release), built on Jun 25 1992 #false : bool () : void IS_SET_REP = "\s. !P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> P s" : term IS_SET_REP_EMPTY = |- (\s. !P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> P s) (\x. F) INSERTION_PRESERVES_IS_SET_REP = |- !s. (\s. !P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> P s) s ==> (!x. (\s. !P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> P s) (\y. (y = x) \/ s y)) REP_INDUCT = |- !P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. (\s. !P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> P s) s ==> P s) IS_SET_REP_EXISTS = |- ?IS_SET_REP. IS_SET_REP(\x. F) /\ (!s. IS_SET_REP s ==> (!x. IS_SET_REP(\y. (y = x) \/ s y))) /\ (!P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. IS_SET_REP s ==> P s)) IS_SET_REP = |- IS_SET_REP(\x. F) /\ (!s. IS_SET_REP s ==> (!x. IS_SET_REP(\y. (y = x) \/ s y))) /\ (!P. P(\x. F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. IS_SET_REP s ==> P s)) STRONG_SET_REP_INDUCT = |- !P. P(\x. F) /\ (!t. IS_SET_REP t ==> P t ==> (!x. P(\y. (y = x) \/ t y))) ==> (!s. IS_SET_REP s ==> P s) EXISTENCE_THM = |- ?s. IS_SET_REP s set_TY_DEF = |- ?rep. TYPE_DEFINITION IS_SET_REP rep EXISTENCE_LEMMA = |- ?EMPTY INSERT IN. (!x. ~IN x EMPTY) /\ (!x y s. IN x(INSERT y s) = (x = y) \/ IN x s) /\ (!x s. INSERT x(INSERT x s) = INSERT x s) /\ (!x y s. INSERT x(INSERT y s) = INSERT y(INSERT x s)) /\ (!P. P EMPTY /\ (!s. P s ==> (!e. P(INSERT e s))) ==> (!s. P s)) FINITE_SET_DEF = |- (!x. ~x IN EMPTY) /\ (!x y s. x IN (y INSERT s) = (x = y) \/ x IN s) /\ (!x s. x INSERT (x INSERT s) = x INSERT s) /\ (!x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)) /\ (!P. P EMPTY /\ (!s. P s ==> (!e. P(e INSERT s))) ==> (!s. P s)) () : void NOT_IN_EMPTY = |- !x. ~x IN {} IN_INSERT = |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s INSERT_INSERT = |- !x s. x INSERT (x INSERT s) = x INSERT s INSERT_COMM = |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) |- !x. ~x IN {} |- !x y s. x IN (y INSERT s) = (x = y) \/ x IN s |- !x s. x INSERT (x INSERT s) = x INSERT s |- !x y s. x INSERT (y INSERT s) = y INSERT (x INSERT s) COMPONENT = |- !x s. x IN (x INSERT s) NOT_EMPTY_INSERT = |- !x s. ~({} = x INSERT s) NOT_INSERT_EMPTY = |- !x s. ~(x INSERT s = {}) lemma = |- !x s. x IN s ==> (x INSERT s = s) ABSORPTION = |- !x s. x IN s = (x INSERT s = s) SET_INDUCT = |- !P. P{} /\ (!s. P s ==> (!e. ~e IN s ==> P(e INSERT s))) ==> (!s. P s) SET_INDUCT_TAC = - : tactic File set_ind.ml loaded () : void DECOMPOSITION = |- !s x. x IN s = (?t. (s = x INSERT t) /\ ~x IN t) MEMBER_NOT_EMPTY = |- !s. (?x. x IN s) = ~(s = {}) lemma = |- !s t. (!x. x IN s = x IN t) ==> (s = t) EXTENSION = |- !s t. (s = t) = (!x. x IN s = x IN t) NOT_EQUAL_SETS = |- !s t. ~(s = t) = (?x. x IN t = ~x IN s) SET_CASES = |- !s. (s = {}) \/ (?x t. (s = x INSERT t) /\ ~x IN t) SUBSET_DEF = |- !s t. s SUBSET t = (!x. x IN s ==> x IN t) SUBSET_TRANS = |- !s t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u SUBSET_REFL = |- !s. s SUBSET s SUBSET_ANTISYM = |- !s t. s SUBSET t /\ t SUBSET s ==> (s = t) EMPTY_SUBSET = |- !s. {} SUBSET s SUBSET_EMPTY = |- !s. s SUBSET {} = (s = {}) INSERT_SUBSET = |- !x s t. (x INSERT s) SUBSET t = x IN t /\ s SUBSET t SUBSET_INSERT = |- !x s. ~x IN s ==> (!t. s SUBSET (x INSERT t) = s SUBSET t) PSUBSET_DEF = |- !s t. s PSUBSET t = s SUBSET t /\ ~(s = t) PSUBSET_TRANS = |- !s t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u PSUBSET_IRREFL = |- !s. ~s PSUBSET s NOT_PSUBSET_EMPTY = |- !s. ~s PSUBSET {} PSUBSET_INSERT_SUBSET = |- !s t. s PSUBSET t = (?x. ~x IN s /\ (x INSERT s) SUBSET t) lemma = |- ~(a = b) = (b = ~a) PSUBSET_MEMBER = |- !s t. s PSUBSET t = s SUBSET t /\ (?y. y IN t /\ ~y IN s) UNION_EXISTS = |- !s t. ?u. !x. x IN u = x IN s \/ x IN t IN_UNION = |- !s t x. x IN (s UNION t) = x IN s \/ x IN t UNION_ASSOC = |- !s t u. (s UNION t) UNION u = s UNION (t UNION u) UNION_IDEMPOT = |- !s. s UNION s = s UNION_COMM = |- !s t. s UNION t = t UNION s SUBSET_UNION = |- (!s t. s SUBSET (s UNION t)) /\ (!s t. s SUBSET (t UNION s)) SUBSET_UNION_ABSORPTION = |- !s t. s SUBSET t = (s UNION t = t) UNION_EMPTY = |- (!s. {} UNION s = s) /\ (!s. s UNION {} = s) EMPTY_UNION = |- !s t. (s UNION t = {}) = (s = {}) /\ (t = {}) INSERT_UNION = |- !x s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t)) INSERT_UNION_EQ = |- !x s t. (x INSERT s) UNION t = x INSERT (s UNION t) INTER_EXISTS = |- !s t. ?i. !x. x IN i = x IN s /\ x IN t IN_INTER = |- !s t x. x IN (s INTER t) = x IN s /\ x IN t INTER_ASSOC = |- !s t u. (s INTER t) INTER u = s INTER (t INTER u) INTER_IDEMPOT = |- !s. s INTER s = s INTER_COMM = |- !s t. s INTER t = t INTER s INTER_SUBSET = |- (!s t. (s INTER t) SUBSET s) /\ (!s t. (t INTER s) SUBSET s) SUBSET_INTER_ABSORPTION = |- !s t. s SUBSET t = (s INTER t = s) INTER_EMPTY = |- (!s. {} INTER s = {}) /\ (!s. s INTER {} = {}) INSERT_INTER = |- !x s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t) UNION_OVER_INTER = |- !s t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u) INTER_OVER_UNION = |- !s t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u) DISJOINT_DEF = |- !s t. DISJOINT s t = (s INTER t = {}) IN_DISJOINT = |- !s t. DISJOINT s t = ~(?x. x IN s /\ x IN t) DISJOINT_SYM = |- !s t. DISJOINT s t = DISJOINT t s DISJOINT_EMPTY = |- !s. DISJOINT{}s /\ DISJOINT s{} DISJOINT_EMPTY_REFL = |- !s. (s = {}) = DISJOINT s s DISJOINT_INSERT = |- !x s t. DISJOINT(x INSERT s)t = DISJOINT s t /\ ~x IN t DISJOINT_UNION = |- !s t u. DISJOINT(s UNION t)u = DISJOINT s u /\ DISJOINT t u DIFF_EXISTS = |- !s t. ?d. !x. x IN d = x IN s /\ ~x IN t IN_DIFF = |- !s t x. x IN (s DIFF t) = x IN s /\ ~x IN t DIFF_EMPTY = |- !s. s DIFF {} = s EMPTY_DIFF = |- !s. {} DIFF s = {} DIFF_DIFF = |- !s t. (s DIFF t) DIFF t = s DIFF t DIFF_EQ_EMPTY = |- !s. s DIFF s = {} DELETE_DEF = |- !s x. s DELETE x = s DIFF {x} IN_DELETE = |- !s x y. x IN (s DELETE y) = x IN s /\ ~(x = y) DELETE_NON_ELEMENT = |- !x s. ~x IN s = (s DELETE x = s) IN_DELETE_EQ = |- !s x x'. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x)) EMPTY_DELETE = |- !x. {} DELETE x = {} DELETE_DELETE = |- !x s. (s DELETE x) DELETE x = s DELETE x DELETE_COMM = |- !x y s. (s DELETE x) DELETE y = (s DELETE y) DELETE x DELETE_SUBSET = |- !x s. (s DELETE x) SUBSET s SUBSET_DELETE = |- !x s t. s SUBSET (t DELETE x) = ~x IN s /\ s SUBSET t SUBSET_INSERT_DELETE = |- !x s t. s SUBSET (x INSERT t) = (s DELETE x) SUBSET t DIFF_INSERT = |- !s t x. s DIFF (x INSERT t) = (s DELETE x) DIFF t DELETE_INSERT = |- !x y s. (x INSERT s) DELETE y = ((x = y) => s DELETE y | x INSERT (s DELETE y)) INSERT_DELETE = |- !x s. x IN s ==> (x INSERT (s DELETE x) = s) DELETE_INTER = |- !s t x. (s DELETE x) INTER t = (s INTER t) DELETE x DISJOINT_DELETE_SYM = |- !s t x. DISJOINT(s DELETE x)t = DISJOINT(t DELETE x)s CHOICE_EXISTS = |- ?CHOICE. !s. ~(s = {}) ==> (CHOICE s) IN s CHOICE_DEF = |- !s. ~(s = {}) ==> (CHOICE s) IN s REST_DEF = |- !s. REST s = s DELETE (CHOICE s) CHOICE_NOT_IN_REST = |- !s. ~(CHOICE s) IN (REST s) CHOICE_INSERT_REST = |- !s. ~(s = {}) ==> ((CHOICE s) INSERT (REST s) = s) REST_SUBSET = |- !s. (REST s) SUBSET s lemma = |- (P /\ Q = P) = P ==> Q REST_PSUBSET = |- !s. ~(s = {}) ==> (REST s) PSUBSET s SING_DEF = |- !s. SING s = (?x. s = {x}) SING = |- !x. SING{x} IN_SING = |- !x y. x IN {y} = (x = y) NOT_SING_EMPTY = |- !x. ~({x} = {}) NOT_EMPTY_SING = |- !x. ~({} = {x}) EQUAL_SING = |- !x y. ({x} = {y}) = (x = y) DISJOINT_SING_EMPTY = |- !x. DISJOINT{x}{} INSERT_SING_UNION = |- !s x. x INSERT s = {x} UNION s SING_DELETE = |- !x. {x} DELETE x = {} DELETE_EQ_SING = |- !s x. x IN s ==> ((s DELETE x = {}) = (s = {x})) CHOICE_SING = |- !x. CHOICE{x} = x REST_SING = |- !x. REST{x} = {} SING_IFF_EMPTY_REST = |- !s. SING s = ~(s = {}) /\ (REST s = {}) IMAGE_EXISTS = |- !f s. ?t. !y. y IN t = (?x. (y = f x) /\ x IN s) IN_IMAGE = |- !f s y. y IN (IMAGE f s) = (?x. (y = f x) /\ x IN s) IMAGE_IN = |- !x s. x IN s ==> (!f. (f x) IN (IMAGE f s)) IMAGE_EMPTY = |- !f. IMAGE f{} = {} IMAGE_ID = |- !s. IMAGE(\x. x)s = s Theorem o_THM autoloading from theory `combin` ... o_THM = |- !f g x. (f o g)x = f(g x) IMAGE_COMPOSE = |- !f g s. IMAGE(f o g)s = IMAGE f(IMAGE g s) IMAGE_INSERT = |- !f x s. IMAGE f(x INSERT s) = (f x) INSERT (IMAGE f s) IMAGE_EQ_EMPTY = |- !s f. (IMAGE f s = {}) = (s = {}) IMAGE_DELETE = |- !f x s. ~x IN s ==> (IMAGE f(s DELETE x) = IMAGE f s) IMAGE_UNION = |- !f s t. IMAGE f(s UNION t) = (IMAGE f s) UNION (IMAGE f t) IMAGE_SUBSET = |- !s t. s SUBSET t ==> (!f. (IMAGE f s) SUBSET (IMAGE f t)) IMAGE_INTER = |- !f s t. (IMAGE f(s INTER t)) SUBSET ((IMAGE f s) INTER (IMAGE f t)) INJ_DEF = |- !f s t. INJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) INJ_ID = |- !s. INJ(\x. x)s s INJ_COMPOSE = |- !f g s t u. INJ f s t /\ INJ g t u ==> INJ(g o f)s u INJ_EMPTY = |- !f. (!s. INJ f{}s) /\ (!s. INJ f s{} = (s = {})) SURJ_DEF = |- !f s t. SURJ f s t = (!x. x IN s ==> (f x) IN t) /\ (!x. x IN t ==> (?y. y IN s /\ (f y = x))) SURJ_ID = |- !s. SURJ(\x. x)s s SURJ_COMPOSE = |- !f g s t u. SURJ f s t /\ SURJ g t u ==> SURJ(g o f)s u SURJ_EMPTY = |- !f. (!s. SURJ f{}s = (s = {})) /\ (!s. SURJ f s{} = (s = {})) IMAGE_SURJ = |- !f s t. SURJ f s t = (IMAGE f s = t) BIJ_DEF = |- !f s t. BIJ f s t = INJ f s t /\ SURJ f s t BIJ_ID = |- !s. BIJ(\x. x)s s BIJ_EMPTY = |- !f. (!s. BIJ f{}s = (s = {})) /\ (!s. BIJ f s{} = (s = {})) BIJ_COMPOSE = |- !f g s t u. BIJ f s t /\ BIJ g t u ==> BIJ(g o f)s u lemma1 = |- !f s. (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) = (!y. y IN s ==> (!x. x IN s /\ (f x = f y) = y IN s /\ (x = y))) lemma2 = |- !f s. ?g. !t. INJ f s t ==> (!x. x IN s ==> (g(f x) = x)) LINV_DEF = |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) lemma3 = |- !f s. ?g. !t. SURJ f s t ==> (!x. x IN t ==> (f(g x) = x)) RINV_DEF = |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) card_rel_def = "(!s. R s 0 = (s = {})) /\ (!s n. R s(SUC n) = (?x. x IN s /\ R(s DELETE x)n))" : term Theorem num_Axiom autoloading from theory `prim_rec` ... num_Axiom = |- !e f. ?! fn. (fn 0 = e) /\ (!n. fn(SUC n) = f(fn n)n) CARD_REL_EXISTS = |- ?R. (!s. R s 0 = (s = {})) /\ (!s n. R s(SUC n) = (?x. x IN s /\ R(s DELETE x)n)) CARD_REL_DEL_LEMMA = .. |- !n s x. x IN s ==> R(s DELETE x)n ==> (!y. y IN s ==> R(s DELETE y)n) Theorem INV_SUC_EQ autoloading from theory `prim_rec` ... INV_SUC_EQ = |- !m n. (SUC m = SUC n) = (m = n) Theorem NOT_SUC autoloading from theory `num` ... NOT_SUC = |- !n. ~(SUC n = 0) CARD_REL_UNIQUE = .. |- !n s. R s n ==> (!m. R s m ==> (n = m)) CARD_REL_EXISTS_LEMMA = .. |- !s. ?n. R s n CARD_REL_THM = .. |- !m s. ((@n. R s n) = m) = R s m CARD_EXISTS = |- ?CARD. (CARD{} = 0) /\ (!s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s))) CARD_DEF = |- (CARD{} = 0) /\ (!s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s))) CARD_EMPTY = |- CARD{} = 0 CARD_INSERT = |- !s x. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)) CARD_EQ_0 = |- !s. (CARD s = 0) = (s = {}) Theorem num_CASES autoloading from theory `arithmetic` ... num_CASES = |- !m. (m = 0) \/ (?n. m = SUC n) Theorem SUC_SUB1 autoloading from theory `arithmetic` ... SUC_SUB1 = |- !m. (SUC m) - 1 = m CARD_DELETE = |- !s x. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s) Theorem LESS_MONO_EQ autoloading from theory `arithmetic` ... LESS_MONO_EQ = |- !m n. (SUC m) < (SUC n) = m < n Definition LESS_OR_EQ autoloading from theory `arithmetic` ... LESS_OR_EQ = |- !m n. m <= n = m < n \/ (m = n) lemma1 = |- !n m. (SUC n) <= (SUC m) = n <= m Theorem LESS_THM autoloading from theory `prim_rec` ... LESS_THM = |- !m n. m < (SUC n) = (m = n) \/ m < n lemma2 = |- !n m. n <= (SUC m) = n <= m \/ (n = SUC m) Theorem LESS_EQ_REFL autoloading from theory `arithmetic` ... LESS_EQ_REFL = |- !m. m <= m CARD_INTER_LESS_EQ = |- !s t. (CARD(s INTER t)) <= (CARD s) Theorem ADD_CLAUSES autoloading from theory `arithmetic` ... ADD_CLAUSES = |- (0 + m = m) /\ (m + 0 = m) /\ ((SUC m) + n = SUC(m + n)) /\ (m + (SUC n) = SUC(m + n)) CARD_UNION = |- !s t. (CARD(s UNION t)) + (CARD(s INTER t)) = (CARD s) + (CARD t) lemma = |- !n m. n <= (SUC m) = n <= m \/ (n = SUC m) Theorem LESS_0 autoloading from theory `prim_rec` ... LESS_0 = |- !n. 0 < (SUC n) CARD_SUBSET = |- !s t. t SUBSET s ==> (CARD t) <= (CARD s) Theorem LESS_EQ autoloading from theory `arithmetic` ... LESS_EQ = |- !m n. m < n = (SUC m) <= n CARD_PSUBSET = |- !s t. t PSUBSET s ==> (CARD t) < (CARD s) CARD_SING = |- !x. CARD{x} = 1 SING_IFF_CARD1 = |- !s. SING s = (CARD s = 1) Theorem SUB_PLUS autoloading from theory `arithmetic` ... SUB_PLUS = |- !a b c. a - (b + c) = (a - b) - c Theorem SUB_0 autoloading from theory `arithmetic` ... SUB_0 = |- !m. (0 - m = 0) /\ (m - 0 = m) CARD_DIFF = |- !t s. CARD(s DIFF t) = (CARD s) - (CARD(s INTER t)) Theorem NOT_LESS autoloading from theory `arithmetic` ... NOT_LESS = |- !m n. ~m < n = n <= m Theorem SUB_LESS_0 autoloading from theory `arithmetic` ... SUB_LESS_0 = |- !n m. m < n = 0 < (n - m) LESS_CARD_DIFF = |- !t s. (CARD t) < (CARD s) ==> 0 < (CARD(s DIFF t)) echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `finite_sets`;;'\ 'compilet `set_ind`;;'\ 'quit();;' | ../../hol __ _ _ __ __ _ __ _ _ __ _ |___ | | /_\ |__ |__ | | |__| | | | | |__ |__ / \ __| __| | |__ | | |__| |__ HOL88 Version 2.01 (Franz: pre-release), built on Jun 25 1992 #false : bool Theory finite_sets loaded () : void SET_INDUCT_TAC = - : tactic Calling Lisp compiler File set_ind compiled () : void #echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `finite_sets`;;'\ 'compilet `fset_conv`;;'\ 'quit();;' | ../../hol __ _ _ __ __ _ __ _ _ __ _ |___ | | /_\ |__ |__ | | |__| | | | | |__ |__ / \ __| __| | |__ | | |__| |__ HOL88 Version 2.01 (Franz: pre-release), built on Jun 25 1992 #false : bool Theory finite_sets loaded () : void IN_CONV = - : (conv -> conv) DELETE_CONV = - : (conv -> conv) UNION_CONV = - : (conv -> conv) INSERT_CONV = - : (conv -> conv) IMAGE_CONV = - : (conv -> conv -> conv) Calling Lisp compiler File fset_conv compiled () : void #===> library finite_sets rebuilt hol88-2.02.19940316/Library/finite_sets/finite_sets.log0000640000212700021270000000302605157737711020701 0ustar cammcammThis is TeX, C Version 3.0 (format=lplain 90.7.30) 12 MAR 1992 20:31 **finite_sets (Manual/finite_sets.tex LaTeX Version 2.09 <7 Dec 1989> (/usr/lib/tex/macros/book.sty Document Style `book' <24 Nov 89>. (/usr/lib/tex/macros/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/fleqn.sty \mathindent=\dimen100 ) ! I can't find file `../../../Manual/LaTeX/alltt.sty'. \relax ... l.7 ... ../../../Manual/LaTeX/layout]{book} Please type another input file name: ! I can't find file `.tex'. \relax ... l.7 ... ../../../Manual/LaTeX/layout]{book} Please type another input file name: ! Emergency stop. \relax ... l.7 ... ../../../Manual/LaTeX/layout]{book} End of file on the terminal! Here is how much of TeX's memory you used: 155 strings out of 4463 1587 string characters out of 63169 26627 words of memory out of 262141 2111 multiletter control sequences out of 9500 18996 words of font info for 72 fonts, out of 72000 for 255 14 hyphenation exceptions out of 607 12i,0n,17p,173b,15s stack positions out of 300i,100n,60p,3000b,4000s No pages of output. hol88-2.02.19940316/Library/finite_sets/mk_finite_sets.ml0000640000212700021270000020062605321731664021216 0ustar cammcamm% ===================================================================== % % LIBRARY: finite_sets (prior to version 1.12 called "sets") % % FILE: mk_sets.ml % % % % DESCRIPTION: Defines a new type for finite sets and proves properties % % of sets. The theory is a formalization of the theory of sets % % presented in chapter 10 of Manna and Waldingers "The Logical Basis of % % Computer Programming, VOL 1." % % % % AUTHORS: Phil Windley, Philippe Leveilley % % DATE: 12 May, 1989 % % % % REVISED: Tom Melham (extensively revised and extended) % % DATE: February 1992 % % ===================================================================== % % --------------------------------------------------------------------- % % Create the new theory. % % --------------------------------------------------------------------- % new_theory `finite_sets`;; % ===================================================================== % % Type definition. % % % % The representing type is *->bool. The representation of the empty % % set is the abstraction \x.F. The insertion operation is represented % % by \x s. (\e. e = x \/ s e), which gives the representation of the % % set obtained by adding the element x to the set s. % % ===================================================================== % % --------------------------------------------------------------------- % % A predicate s:*->bool represents a finite set iff it is in the % % intersection of all classes of such predicates that contain the % % representation of empty and are closed under the representation of % % insert operation. Hence s:*->bool is finite if it can be obtained % % by applying a finite sequence of insert operations to the empty set. % % The following proofs derive the existence of a predicate IS_SET_REP % % that expresses this definition. % % --------------------------------------------------------------------- % % --------------------------------------------------------------------- % % Abbreviation for IS_SET_REP. % % --------------------------------------------------------------------- % let IS_SET_REP = "\s:*->bool. !P. P (\x.F) /\ (!t. P t ==> !x. P(\y. (y=x) \/ t y)) ==> P s";; % --------------------------------------------------------------------- % % The predicate \x.F represents the empty set (IS_SET_REP holds of it). % % --------------------------------------------------------------------- % let IS_SET_REP_EMPTY = TAC_PROOF (([], "^IS_SET_REP (\x:*.F)"), CONV_TAC BETA_CONV THEN REPEAT STRIP_TAC);; % --------------------------------------------------------------------- % % Set representations are closed under the insertion function. % % --------------------------------------------------------------------- % let INSERTION_PRESERVES_IS_SET_REP = TAC_PROOF (([], "!s:*->bool. ^IS_SET_REP s ==> !x. ^IS_SET_REP (\y.(y=x) \/ s y)"), CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC THEN RES_THEN MATCH_ACCEPT_TAC);; % --------------------------------------------------------------------- % % IS_SET_REP is true of the smallest such class of sets. % % --------------------------------------------------------------------- % let REP_INDUCT = TAC_PROOF (([], "!P. (P(\x:*.F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y)))) ==> !s:*->bool. ^IS_SET_REP s ==> P s"), CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN RES_TAC);; % --------------------------------------------------------------------- % % IS_SET_REP is precisely the predicate with these three properties. % % --------------------------------------------------------------------- % let IS_SET_REP_EXISTS = TAC_PROOF (([], "?IS_SET_REP:(*->bool)->bool. (IS_SET_REP \x.F) /\ (!s. IS_SET_REP s ==> !x. IS_SET_REP (\y.(y=x) \/ s y)) /\ (!P. (P(\x:*.F) /\ (!t. P t ==> (!x. P(\y. (y = x) \/ t y)))) ==> !s:*->bool. IS_SET_REP s ==> P s)"), EXISTS_TAC IS_SET_REP THEN REPEAT CONJ_TAC THENL [ACCEPT_TAC IS_SET_REP_EMPTY; ACCEPT_TAC INSERTION_PRESERVES_IS_SET_REP; ACCEPT_TAC REP_INDUCT]);; % --------------------------------------------------------------------- % % Define IS_SET_REP to be this predicate. % % --------------------------------------------------------------------- % let IS_SET_REP = new_specification `IS_SET_REP` [`constant`,`IS_SET_REP`] IS_SET_REP_EXISTS;; % --------------------------------------------------------------------- % % A slightly stronger induction theorem. % % --------------------------------------------------------------------- % let STRONG_SET_REP_INDUCT = TAC_PROOF (([], "!P:(*->bool)->bool. (P(\x:*. F) /\ (!t. IS_SET_REP t ==> P t ==> (!x. P(\y. (y = x) \/ t y)))) ==> (!s. IS_SET_REP s ==> P s)"), let [th1;th2;th3] = CONJUNCTS IS_SET_REP in GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN let th4 = BETA_RULE (SPEC "\s:*->bool. IS_SET_REP s /\ P s" th3) in let th5 = CONJUNCT2 (UNDISCH (SPEC "s:*->bool" (UNDISCH th4))) in let th6 = DISCH "IS_SET_REP (s:*->bool)" th5 in MATCH_MP_TAC (DISCH_ALL th6) THEN CONJ_TAC THENL [ASM_REWRITE_TAC [th1]; REPEAT STRIP_TAC THENL [IMP_RES_TAC th2; RES_TAC] THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; % --------------------------------------------------------------------- % % Theorem stating that the representing type is non empty. % % --------------------------------------------------------------------- % let EXISTENCE_THM = TAC_PROOF (([], "?(s:*->bool) . IS_SET_REP s"), EXISTS_TAC "\x:*.F" THEN REWRITE_TAC [IS_SET_REP]);; % --------------------------------------------------------------------- % % Now, make the type definition. % % --------------------------------------------------------------------- % let set_TY_DEF = new_type_definition (`set`,"IS_SET_REP:(*->bool)->bool", EXISTENCE_THM);; % ========================================================================== % % Abstract characterization of the type (*)set. This consists of three % % constants EMPTY, IN, and INSERT which satisfy: % % % % NOT_IN_EMPTY |- !x. ~(IN x EMPTY)) % % IN_INSERT |- !x y s. IN x (INSERT y s) = ((x=y) \/ IN x s) % % INSERT_INSERT |- !x s. INSERT x (INSERT x s) = INSERT x s % % INSERT_COMM |- !x y s. INSERT x (INSERT y s) = INSERT y (INSERT x s) % % SET_INDUCT |- !P:(*)set->bool. % % (P EMPTY /\ !s. P s ==> !e. P(INSERT e s)) % % ==> !s. P s % % ========================================================================== % let EXISTENCE_LEMMA = TAC_PROOF (([], "?EMPTY:(*)set. ?INSERT:*->(*)set->(*)set. ?IN:*->(*)set->bool. (!x. ~(IN x EMPTY)) /\ (!x y s. IN x (INSERT y s) = ((x=y) \/ IN x s)) /\ (!x s. INSERT x (INSERT x s) = INSERT x s) /\ (!x y s. INSERT x (INSERT y s) = INSERT y (INSERT x s)) /\ (!P:(*)set->bool. (P EMPTY /\ !s. P s ==> !e. P(INSERT e s)) ==> !s. P s)"), let thm = MATCH_MP ABS_REP_THM set_TY_DEF in STRIP_ASSUME_TAC thm THEN EXISTS_TAC "abs (\x:*.F) :(*)set" THEN EXISTS_TAC "\x:*. \s:(*)set. abs (\y. (y=x) \/ (rep s y)):(*)set" THEN EXISTS_TAC "\x:*. \s:(*)set. (rep s:*->bool) x" THEN CONV_TAC (DEPTH_CONV BETA_CONV) THEN let [th1;th2;th3] = CONJUNCTS IS_SET_REP in REPEAT (CONJ_TAC ORELSE GEN_TAC) THENL [ASSUME_TAC th1 THEN RES_THEN SUBST1_TAC THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC; let th4 = SYM(BETA_CONV "(\y':*. (y' = y) \/ rep (s:(*)set) y') x") in SUBST1_TAC th4 THEN AP_THM_TAC THEN FIRST_ASSUM (\th. REWRITE_TAC [SYM (SPEC "r:*->bool" th)]) THEN MATCH_MP_TAC th2 THEN ASM_REWRITE_TAC []; FIRST_ASSUM (\th. let th4 = SPEC "rep (s:(*)set):*->bool" th in let as1 = ASSUME "!a:(*)set.abs(rep a:*->bool) = a" in let th5 = SPEC "x:*" (MATCH_MP th2 (REWRITE_RULE [as1] th4)) in ASSUME_TAC th5 THEN RES_THEN SUBST1_TAC THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REWRITE_TAC [DISJ_ASSOC]); FIRST_ASSUM (\th. let th4 = SPEC "rep (s:(*)set):*->bool" th in let as1 = ASSUME "!a:(*)set.abs(rep a:*->bool) = a" in let th5 = MATCH_MP th2 (REWRITE_RULE [as1] th4) in ASSUME_TAC (SPEC "x:*" th5) THEN ASSUME_TAC (SPEC "y:*" th5) THEN RES_THEN SUBST1_TAC THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN PURE_ONCE_REWRITE_TAC [DISJ_ASSOC] THEN let disj = ISPEC "x:* = y" DISJ_SYM in CONV_TAC (RAND_CONV (ONCE_DEPTH_CONV (REWR_CONV disj))) THEN REFL_TAC); REPEAT STRIP_TAC THEN let th4 = STRONG_SET_REP_INDUCT in let th5 = BETA_RULE (SPEC "\r:*->bool. P(abs r:(*)set):bool" th4) in let th6 = SPEC "rep (s:(*)set):*->bool" (UNDISCH th5) in MP_TAC (DISCH_ALL th6) THEN ASM_REWRITE_TAC [] THEN DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC []]);; % --------------------------------------------------------------------- % % Now, define EMPTY, IN and INSERT. % % --------------------------------------------------------------------- % let FINITE_SET_DEF = new_specification `FINITE_SET_DEF` [`constant`,`EMPTY`;`infix`,`INSERT`;`infix`,`IN`] EXISTENCE_LEMMA;; % --------------------------------------------------------------------- % % Set up the {x1,...,xn} notation. % % --------------------------------------------------------------------- % define_finite_set_syntax(`EMPTY`,`INSERT`);; % --------------------------------------------------------------------- % % Save the first four conjuncts of FINITE_SET_DEF under separate names. % % --------------------------------------------------------------------- % let [NOT_IN_EMPTY;IN_INSERT;INSERT_INSERT;INSERT_COMM;_] = CONJUNCTS FINITE_SET_DEF;; save_thm(`NOT_IN_EMPTY`,NOT_IN_EMPTY);; save_thm(`IN_INSERT`,IN_INSERT);; save_thm(`INSERT_INSERT`,INSERT_INSERT);; save_thm(`INSERT_COMM`,INSERT_COMM);; % ===================================================================== % % Basic theorems needed to prove EXTENSION. % % ===================================================================== % let COMPONENT = prove_thm (`COMPONENT`, "!x:*.!s. x IN (x INSERT s)", REWRITE_TAC [IN_INSERT]);; let NOT_EMPTY_INSERT = prove_thm (`NOT_EMPTY_INSERT`, "!x:*. !s. ~({} = x INSERT s)", REPEAT GEN_TAC THEN DISCH_THEN (MP_TAC o (AP_TERM "IN (x:*)")) THEN REWRITE_TAC [IN_INSERT;NOT_IN_EMPTY]);; let NOT_INSERT_EMPTY = save_thm (`NOT_INSERT_EMPTY`, CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) NOT_EMPTY_INSERT);; let lemma = TAC_PROOF (([], "!x:*. !s. x IN s ==> (x INSERT s = s)"), let ind = el 5 (CONJUNCTS FINITE_SET_DEF) in GEN_TAC THEN INDUCT_THEN ind ASSUME_TAC THENL [REWRITE_TAC [NOT_IN_EMPTY]; PURE_ONCE_REWRITE_TAC [IN_INSERT] THEN REPEAT STRIP_TAC THENL [ASM_REWRITE_TAC [INSERT_INSERT]; PURE_ONCE_REWRITE_TAC [INSERT_COMM] THEN RES_THEN SUBST1_TAC THEN REFL_TAC]]);; let ABSORPTION = prove_thm (`ABSORPTION`, "!x:*. !s. x IN s = (x INSERT s = s)", REPEAT GEN_TAC THEN EQ_TAC THENL [MATCH_ACCEPT_TAC lemma; DISCH_THEN (SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC COMPONENT]);; % ===================================================================== % % Finite set induction: strong form. % % ===================================================================== % let SET_INDUCT = prove_thm (`SET_INDUCT`, "!P:(*)set->bool. (P EMPTY /\ !s. P s ==> !e. ~(e IN s) ==> P(INSERT e s)) ==> !s. P s", let ind = el 5 (CONJUNCTS FINITE_SET_DEF) in REPEAT STRIP_TAC THEN MATCH_MP_TAC ind THEN REPEAT STRIP_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ASM_CASES_TAC "(e:*) IN s" THENL [IMP_RES_THEN SUBST1_TAC ABSORPTION THEN FIRST_ASSUM ACCEPT_TAC; RES_TAC]]);; % --------------------------------------------------------------------- % % Load the set induction tactic in... uncompiled. % % --------------------------------------------------------------------- % loadt `set_ind.ml`;; % ===================================================================== % % Axiom of extension. % % ===================================================================== % % --------------------------------------------------------------------- % % First, prove DECOMPOSITION. % % --------------------------------------------------------------------- % let DECOMPOSITION = prove_thm (`DECOMPOSITION`, "!s:(*)set. !x. x IN s = ?t. (s = x INSERT t) /\ ~x IN t", REPEAT GEN_TAC THEN EQ_TAC THENL [MAP_EVERY (SPEC_TAC o (\x.(x,x))) ["x:*";"s:(*)set"] THEN SET_INDUCT_TAC THENL [REWRITE_TAC [NOT_IN_EMPTY]; PURE_ONCE_REWRITE_TAC [IN_INSERT] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "s:(*)set" THEN ASM_REWRITE_TAC []; RES_TAC THEN EXISTS_TAC "(e:*) INSERT t" THEN FIRST_ASSUM SUBST1_TAC THEN CONJ_TAC THENL [MATCH_ACCEPT_TAC INSERT_COMM; ASM_REWRITE_TAC [IN_INSERT] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC]]]; STRIP_TAC THEN ASM_REWRITE_TAC [IN_INSERT]]);; % --------------------------------------------------------------------- % % And prove MEMBER_NOT_EMPTY % % --------------------------------------------------------------------- % let MEMBER_NOT_EMPTY = prove_thm (`MEMBER_NOT_EMPTY`, "!s:(*)set. (?x. x IN s) = ~(s = {})", SET_INDUCT_TAC THENL [REWRITE_TAC [NOT_IN_EMPTY]; REWRITE_TAC [NOT_INSERT_EMPTY;IN_INSERT] THEN EXISTS_TAC "e:*" THEN REWRITE_TAC []]);; % --------------------------------------------------------------------- % % Now, the axiom of EXTENSION. % % --------------------------------------------------------------------- % let lemma = TAC_PROOF (([], "!s t. (!x:*. x IN s = x IN t) ==> (s = t)"), SET_INDUCT_TAC THENL [REWRITE_TAC [NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV FORALL_NOT_CONV) THEN REWRITE_TAC [MEMBER_NOT_EMPTY] THEN GEN_TAC THEN DISCH_THEN (ACCEPT_TAC o SYM); REPEAT STRIP_TAC THEN ASSUME_TAC (SPECL ["e:*";"s:(*)set"] COMPONENT) THEN RES_TAC THEN IMP_RES_TAC DECOMPOSITION THEN SUBST_ALL_TAC (ASSUME "t = (e:*) INSERT t'") THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN FIRST_ASSUM (\th. let eqn = REWRITE_RULE [IN_INSERT] (SPEC "x:*" th) in ASSUME_TAC (GEN_ALL eqn)) THEN EQ_TAC THEN STRIP_TAC THEN RES_TAC THEN SUBST_ALL_TAC (ASSUME "x:* = e") THEN RES_TAC]);; let EXTENSION = prove_thm (`EXTENSION`, "!s t. (s=t) = (!x:*. x IN s = x IN t)", REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC; MATCH_ACCEPT_TAC lemma]);; let NOT_EQUAL_SETS = prove_thm (`NOT_EQUAL_SETS`, "!s:(*)set. !t. ~(s = t) = ?x. x IN t = ~x IN s", PURE_ONCE_REWRITE_TAC [EXTENSION] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN ASM_CASES_TAC "(x:*) IN s" THEN ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]; STRIP_TAC THEN EXISTS_TAC "x:*" THEN ASM_CASES_TAC "(x:*) IN s" THEN ASM_REWRITE_TAC []]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let NUM_SET_WOP = prove_thm (`NUM_SET_WOP`, "!s. (?n. n IN s) = ?n. n IN s /\ (!m. m IN s ==> n <= m)", REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [let th = BETA_RULE (ISPEC "\n:num. n IN s" WOP) in IMP_RES_THEN (X_CHOOSE_THEN "N:num" STRIP_ASSUME_TAC) th THEN EXISTS_TAC "N:num" THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC [GSYM NOT_LESS]]; EXISTS_TAC "n:num" THEN FIRST_ASSUM ACCEPT_TAC]);; % --------------------------------------------------------------------- % % Cases theorem for EMPTY and INSERT. % % --------------------------------------------------------------------- % let SET_CASES = prove_thm (`SET_CASES`, "!s:(*)set. (s = {}) \/ ?x:*. ?t. ((s = x INSERT t) /\ ~x IN t)", SET_INDUCT_TAC THENL [DISJ1_TAC THEN REFL_TAC; DISJ2_TAC THEN MAP_EVERY EXISTS_TAC ["e:*";"s:(*)set"] THEN ASM_REWRITE_TAC []]);; % ===================================================================== % % Set inclusion. % % ===================================================================== % let SUBSET_DEF = new_infix_definition (`SUBSET_DEF`, "SUBSET s t = !x:*. x IN s ==> x IN t");; let SUBSET_TRANS = prove_thm (`SUBSET_TRANS`, "!(s:(*)set) t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u", REWRITE_TAC [SUBSET_DEF] THEN REPEAT STRIP_TAC THEN REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN FIRST_ASSUM ACCEPT_TAC);; let SUBSET_REFL = prove_thm (`SUBSET_REFL`, "!(s:(*)set). s SUBSET s", REWRITE_TAC[SUBSET_DEF]);; let SUBSET_ANTISYM = prove_thm (`SUBSET_ANTISYM`, "!(s:(*)set) t. (s SUBSET t) /\ (t SUBSET s) ==> (s = t)", REWRITE_TAC [SUBSET_DEF; EXTENSION] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; let EMPTY_SUBSET = prove_thm (`EMPTY_SUBSET`, "!s:(*)set. EMPTY SUBSET s", REWRITE_TAC [SUBSET_DEF;NOT_IN_EMPTY]);; let SUBSET_EMPTY = prove_thm (`SUBSET_EMPTY`, "!s:(*)set. s SUBSET EMPTY = (s = EMPTY)", PURE_REWRITE_TAC [SUBSET_DEF;NOT_IN_EMPTY] THEN REWRITE_TAC [EXTENSION;NOT_IN_EMPTY]);; let INSERT_SUBSET = prove_thm (`INSERT_SUBSET`, "!x:*. !s t. (x INSERT s) SUBSET t = (x IN t /\ s SUBSET t)", REWRITE_TAC [IN_INSERT;SUBSET_DEF] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM MATCH_MP_TAC THEN DISJ1_TAC THEN REFL_TAC; FIRST_ASSUM MATCH_MP_TAC THEN DISJ2_TAC THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC []; RES_TAC]);; let SUBSET_INSERT = prove_thm (`SUBSET_INSERT`, "!x:*. !s. ~(x IN s) ==> !t. s SUBSET (x INSERT t) = s SUBSET t", PURE_REWRITE_TAC [SUBSET_DEF;IN_INSERT] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THEN let tac th g = SUBST_ALL_TAC th g ? STRIP_ASSUME_TAC th g in RES_THEN (STRIP_THM_THEN tac) THEN RES_TAC; REPEAT STRIP_TAC THEN DISJ2_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; % ===================================================================== % % Proper subset. % % ===================================================================== % let PSUBSET_DEF = new_infix_definition (`PSUBSET_DEF`, "PSUBSET (s:(*)set) t = (s SUBSET t /\ ~(s = t))");; let PSUBSET_TRANS = prove_thm (`PSUBSET_TRANS`, "!s:(*)set. !t u. (s PSUBSET t /\ t PSUBSET u) ==> (s PSUBSET u)", PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [IMP_RES_TAC SUBSET_TRANS; DISCH_THEN SUBST_ALL_TAC THEN IMP_RES_TAC SUBSET_ANTISYM THEN RES_TAC]);; let PSUBSET_IRREFL = prove_thm (`PSUBSET_IRREFL`, "!s:(*)set. ~(s PSUBSET s)", REWRITE_TAC [PSUBSET_DEF;SUBSET_REFL]);; let NOT_PSUBSET_EMPTY = prove_thm (`NOT_PSUBSET_EMPTY`, "!s:(*)set. ~(s PSUBSET EMPTY)", REWRITE_TAC [PSUBSET_DEF;SUBSET_EMPTY;NOT_AND]);; let PSUBSET_INSERT_SUBSET = prove_thm (`PSUBSET_INSERT_SUBSET`, "!s t. s PSUBSET t = ?x:*. ~(x IN s) /\ (x INSERT s) SUBSET t", PURE_REWRITE_TAC [PSUBSET_DEF;NOT_EQUAL_SETS] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ASM_CASES_TAC "(x:*) IN s" THENL [ASM_CASES_TAC "(x:*) IN t" THENL [RES_TAC; IMP_RES_TAC SUBSET_DEF THEN RES_TAC]; EXISTS_TAC "x:*" THEN RES_TAC THEN ASM_REWRITE_TAC [INSERT_SUBSET]]; IMP_RES_TAC INSERT_SUBSET; IMP_RES_TAC INSERT_SUBSET THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]]);; let lemma = TAC_PROOF(([], "~(a:bool = b) = (b = ~a)"), BOOL_CASES_TAC "b:bool" THEN REWRITE_TAC[]);; let PSUBSET_MEMBER = prove_thm (`PSUBSET_MEMBER`, "!s:(*)set. !t. s PSUBSET t = (s SUBSET t /\ ?y. y IN t /\ ~y IN s)", REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN PURE_ONCE_REWRITE_TAC [EXTENSION;SUBSET_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN PURE_ONCE_REWRITE_TAC [lemma] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [RES_TAC; EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC [] THEN ASM_CASES_TAC "(x:*) IN s" THENL [RES_TAC THEN RES_TAC;FIRST_ASSUM ACCEPT_TAC]; RES_TAC; EXISTS_TAC "y:*" THEN ASM_REWRITE_TAC[]]);; % ===================================================================== % % Union. % % ===================================================================== % let UNION_EXISTS = TAC_PROOF (([], "!s t. ?u. !x:*. x IN u = x IN s \/ x IN t"), SET_INDUCT_TAC THEN GEN_TAC THENL [EXISTS_TAC "t:(*)set" THEN REWRITE_TAC [NOT_IN_EMPTY]; FIRST_ASSUM (STRIP_ASSUME_TAC o SPEC "t:(*)set") THEN EXISTS_TAC "(e:*) INSERT u" THEN ASM_REWRITE_TAC [IN_INSERT;DISJ_ASSOC]]);; let IN_UNION = let th1 = CONV_RULE SKOLEM_CONV UNION_EXISTS in new_specification `IN_UNION` [`infix`,`UNION`] th1;; let UNION_ASSOC = prove_thm (`UNION_ASSOC`, "!(s:(*)set) t u. (s UNION t) UNION u = s UNION (t UNION u)", REWRITE_TAC [EXTENSION; IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let UNION_IDEMPOT = prove_thm (`UNION_IDEMPOT`, "!(s:(*)set). s UNION s = s", REWRITE_TAC[EXTENSION; IN_UNION]);; let UNION_COMM = prove_thm (`UNION_COMM`, "!(s:(*)set) t. s UNION t = t UNION s", REWRITE_TAC[EXTENSION; IN_UNION] THEN REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC DISJ_SYM);; let SUBSET_UNION = prove_thm (`SUBSET_UNION`, "(!s:(*)set. !t. s SUBSET (s UNION t)) /\ (!s:(*)set. !t. s SUBSET (t UNION s))", PURE_REWRITE_TAC [SUBSET_DEF;IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; let SUBSET_UNION_ABSORPTION = prove_thm (`SUBSET_UNION_ABSORPTION`, "!s:(*)set. !t. s SUBSET t = (s UNION t = t)", REWRITE_TAC [SUBSET_DEF;EXTENSION;IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [RES_TAC;ASM_REWRITE_TAC[];RES_TAC]);; let UNION_EMPTY = prove_thm (`UNION_EMPTY`, "(!s:(*)set. EMPTY UNION s = s) /\ (!s:(*)set. s UNION EMPTY = s)", REWRITE_TAC [IN_UNION;EXTENSION;NOT_IN_EMPTY]);; let EMPTY_UNION = prove_thm (`EMPTY_UNION`, "!s:(*)set. !t. (s UNION t = EMPTY) = ((s = EMPTY) /\ (t = EMPTY))", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_UNION;DE_MORGAN_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC);; let INSERT_UNION = prove_thm (`INSERT_UNION`, "!x:*. !s t. (x INSERT s) UNION t = (x IN t => s UNION t | x INSERT (s UNION t))", REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [EXTENSION;IN_UNION;IN_INSERT] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC []);; let INSERT_UNION_EQ = prove_thm (`INSERT_UNION_EQ`, "!x:*. !s t. (x INSERT s) UNION t = x INSERT (s UNION t)", REPEAT GEN_TAC THEN REWRITE_TAC [EXTENSION;IN_UNION;IN_INSERT;DISJ_ASSOC]);; % ===================================================================== % % Intersection. % % ===================================================================== % let INTER_EXISTS = TAC_PROOF (([], "!s t. ?i. !x:*. x IN i = x IN s /\ x IN t"), SET_INDUCT_TAC THEN GEN_TAC THENL [EXISTS_TAC "{}:(*)set" THEN REWRITE_TAC [NOT_IN_EMPTY]; FIRST_ASSUM (STRIP_ASSUME_TAC o SPEC "t:(*)set") THEN ASM_CASES_TAC "(e:*) IN t" THENL [EXISTS_TAC "(e:*) INSERT i" THEN GEN_TAC THEN ASM_CASES_TAC "x:* = e" THEN ASM_REWRITE_TAC [IN_INSERT]; EXISTS_TAC "i:(*)set" THEN GEN_TAC THEN ASM_CASES_TAC "x:* = e" THEN ASM_REWRITE_TAC [IN_INSERT]]]);; let IN_INTER = let th1 = CONV_RULE SKOLEM_CONV INTER_EXISTS in new_specification `IN_INTER` [`infix`,`INTER`] th1;; let INTER_ASSOC = prove_thm (`INTER_ASSOC`, "!(s:(*)set) t u. (s INTER t) INTER u = s INTER (t INTER u)", REWRITE_TAC [EXTENSION; IN_INTER; CONJ_ASSOC]);; let INTER_IDEMPOT = prove_thm (`INTER_IDEMPOT`, "!(s:(*)set). s INTER s = s", REWRITE_TAC[EXTENSION; IN_INTER]);; let INTER_COMM = prove_thm (`INTER_COMM`, "!(s:(*)set) t. s INTER t = t INTER s", REWRITE_TAC[EXTENSION; IN_INTER] THEN REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC CONJ_SYM);; let INTER_SUBSET = prove_thm (`INTER_SUBSET`, "(!s:(*)set. !t. (s INTER t) SUBSET s) /\ (!s:(*)set. !t. (t INTER s) SUBSET s)", PURE_REWRITE_TAC [SUBSET_DEF;IN_INTER] THEN REPEAT STRIP_TAC);; let SUBSET_INTER_ABSORPTION = prove_thm (`SUBSET_INTER_ABSORPTION`, "!s:(*)set. !t. s SUBSET t = (s INTER t = s)", REWRITE_TAC [SUBSET_DEF;EXTENSION;IN_INTER] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM ACCEPT_TAC; RES_TAC; RES_TAC]);; let INTER_EMPTY = prove_thm (`INTER_EMPTY`, "(!s:(*)set. EMPTY INTER s = EMPTY) /\ (!s:(*)set. s INTER EMPTY = EMPTY)", REWRITE_TAC [IN_INTER;EXTENSION;NOT_IN_EMPTY]);; let INSERT_INTER = prove_thm (`INSERT_INTER`, "!x:*. !s t. (x INSERT s) INTER t = (x IN t => x INSERT (s INTER t) | s INTER t)", REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [EXTENSION;IN_INTER;IN_INSERT] THEN GEN_TAC THEN EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC []; STRIP_TAC THEN ASM_REWRITE_TAC []; PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN DISCH_THEN (CONJUNCTS_THEN MP_TAC) THEN STRIP_TAC THEN ASM_REWRITE_TAC []; STRIP_TAC THEN ASM_REWRITE_TAC []]);; % ===================================================================== % % Distributivity % % ===================================================================== % let UNION_OVER_INTER = prove_thm (`UNION_OVER_INTER`, "!s:(*)set. !t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u)", REWRITE_TAC [EXTENSION;IN_INTER;IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let INTER_OVER_UNION = prove_thm (`INTER_OVER_UNION`, "!s:(*)set. !t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u)", REWRITE_TAC [EXTENSION;IN_INTER;IN_UNION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; % ===================================================================== % % Disjoint sets. % % ===================================================================== % let DISJOINT_DEF = new_definition (`DISJOINT_DEF`, "DISJOINT (s:(*)set) t = ((s INTER t) = EMPTY)");; let IN_DISJOINT = prove_thm (`IN_DISJOINT`, "!s:(*)set. !t. DISJOINT s t = ~(?x. x IN s /\ x IN t)", REWRITE_TAC [DISJOINT_DEF;EXTENSION;IN_INTER;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REPEAT GEN_TAC THEN REFL_TAC);; let DISJOINT_SYM = prove_thm (`DISJOINT_SYM`, "!s:(*)set. !t. DISJOINT s t = DISJOINT t s", PURE_ONCE_REWRITE_TAC [DISJOINT_DEF] THEN REPEAT GEN_TAC THEN SUBST1_TAC (SPECL ["s:(*)set";"t:(*)set"] INTER_COMM) THEN REFL_TAC);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_EMPTY = prove_thm (`DISJOINT_EMPTY`, "!s:(*)set. DISJOINT EMPTY s /\ DISJOINT s EMPTY", REWRITE_TAC [DISJOINT_DEF;INTER_EMPTY]);; let DISJOINT_EMPTY_REFL = prove_thm (`DISJOINT_EMPTY_REFL`, "!s:(*)set. (s = EMPTY) = (DISJOINT s s)", REWRITE_TAC [DISJOINT_DEF;INTER_IDEMPOT]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_INSERT = prove_thm (`DISJOINT_INSERT`, "!(x:*) s t. DISJOINT (x INSERT s) t = (DISJOINT s t) /\ ~(x IN t)", REWRITE_TAC [IN_DISJOINT;IN_INSERT] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN REWRITE_TAC [DE_MORGAN_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [(let v = genvar ":*" in let GTAC = X_GEN_TAC v in DISCH_THEN (\th. CONJ_TAC THENL [GTAC;ALL_TAC] THEN MP_TAC th) THENL [DISCH_THEN (STRIP_ASSUME_TAC o SPEC v) THEN ASM_REWRITE_TAC []; DISCH_THEN (MP_TAC o SPEC "x:*") THEN REWRITE_TAC[]]); REPEAT STRIP_TAC THEN ASM_CASES_TAC "x':* = x" THENL [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_UNION = prove_thm (`DISJOINT_UNION`, "!s:(*)set. !t u. DISJOINT (s UNION t) u = DISJOINT s u /\ DISJOINT t u", REWRITE_TAC [IN_DISJOINT;IN_UNION] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV AND_FORALL_CONV) THEN REWRITE_TAC [DE_MORGAN_THM;RIGHT_AND_OVER_OR] THEN REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_THEN (\th. GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "x:*" th)) THEN ASM_REWRITE_TAC []);; % ===================================================================== % % Set difference % % ===================================================================== % let DIFF_EXISTS = TAC_PROOF (([], "!s t. ?d. !x:*. x IN d = x IN s /\ ~x IN t"), SET_INDUCT_TAC THEN GEN_TAC THENL [EXISTS_TAC "{}:(*)set" THEN REWRITE_TAC [NOT_IN_EMPTY]; FIRST_ASSUM (STRIP_ASSUME_TAC o SPEC "t:(*)set") THEN ASM_CASES_TAC "(e:*) IN t" THENL [EXISTS_TAC "d:(*)set" THEN GEN_TAC THEN ASM_CASES_TAC "x:* = e" THEN ASM_REWRITE_TAC [IN_INSERT]; EXISTS_TAC "e INSERT (d:(*)set)" THEN GEN_TAC THEN ASM_CASES_TAC "x:* = e" THEN ASM_REWRITE_TAC [IN_INSERT]]]);; let IN_DIFF = let th1 = CONV_RULE SKOLEM_CONV DIFF_EXISTS in new_specification `IN_DIFF` [`infix`,`DIFF`] th1;; let DIFF_EMPTY = prove_thm (`DIFF_EMPTY`, "!s:(*)set. s DIFF EMPTY = s", GEN_TAC THEN REWRITE_TAC [NOT_IN_EMPTY;IN_DIFF;EXTENSION]);; let EMPTY_DIFF = prove_thm (`EMPTY_DIFF`, "!s:(*)set. EMPTY DIFF s = EMPTY", GEN_TAC THEN REWRITE_TAC [NOT_IN_EMPTY;IN_DIFF;EXTENSION]);; let DIFF_DIFF = prove_thm (`DIFF_DIFF`, "!s:(*)set. !t. (s DIFF t) DIFF t = s DIFF t", REWRITE_TAC [EXTENSION;IN_DIFF;SYM(SPEC_ALL CONJ_ASSOC)]);; let DIFF_EQ_EMPTY = prove_thm (`DIFF_EQ_EMPTY`, "!s:(*)set. s DIFF s = EMPTY", REWRITE_TAC [EXTENSION;IN_DIFF;NOT_IN_EMPTY;DE_MORGAN_THM] THEN PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN REWRITE_TAC [EXCLUDED_MIDDLE]);; % ===================================================================== % % Removal of an element % % ===================================================================== % let DELETE_DEF = new_infix_definition (`DELETE_DEF`, "DELETE s (x:*) = s DIFF {x}");; let IN_DELETE = prove_thm (`IN_DELETE`, "!s. !x:*. !y. x IN (s DELETE y) = (x IN s /\ ~(x = y))", PURE_ONCE_REWRITE_TAC [DELETE_DEF] THEN REWRITE_TAC [IN_DIFF;IN_INSERT;NOT_IN_EMPTY]);; let DELETE_NON_ELEMENT = prove_thm (`DELETE_NON_ELEMENT`, "!x:*. !s. ~x IN s = ((s DELETE x) = s)", PURE_REWRITE_TAC [EXTENSION;IN_DELETE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM (\th g. SUBST_ALL_TAC th g ? NO_TAC g) THEN RES_TAC; RES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REFL_TAC]);; let IN_DELETE_EQ = prove_thm (`IN_DELETE_EQ`, "!s x. !x':*. (x IN s = x' IN s) = (x IN (s DELETE x') = x' IN (s DELETE x))", REPEAT GEN_TAC THEN ASM_CASES_TAC "x:* = x'" THENL [ASM_REWRITE_TAC []; FIRST_ASSUM (ASSUME_TAC o NOT_EQ_SYM) THEN ASM_REWRITE_TAC [IN_DELETE]]);; let EMPTY_DELETE = prove_thm (`EMPTY_DELETE`, "!x:*. EMPTY DELETE x = EMPTY", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_DELETE]);; let DELETE_DELETE = prove_thm (`DELETE_DELETE`, "!x:*. !s. (s DELETE x) DELETE x = s DELETE x", REWRITE_TAC [EXTENSION;IN_DELETE;SYM(SPEC_ALL CONJ_ASSOC)]);; let DELETE_COMM = prove_thm (`DELETE_COMM`, "!x:*. !y. !s. (s DELETE x) DELETE y = (s DELETE y) DELETE x", PURE_REWRITE_TAC [EXTENSION;IN_DELETE;CONJ_ASSOC] THEN REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let DELETE_SUBSET = prove_thm (`DELETE_SUBSET`, "!x:*. !s. (s DELETE x) SUBSET s", PURE_REWRITE_TAC [SUBSET_DEF;IN_DELETE] THEN REPEAT STRIP_TAC);; let SUBSET_DELETE = prove_thm (`SUBSET_DELETE`, "!x:*. !s t. s SUBSET (t DELETE x) = (~(x IN s) /\ (s SUBSET t))", REWRITE_TAC [SUBSET_DEF;IN_DELETE;EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT STRIP_TAC THENL [ASSUME_TAC (REFL "x:*") THEN RES_TAC; RES_TAC]; REPEAT STRIP_TAC THENL [RES_TAC; FIRST_ASSUM (\th g. SUBST_ALL_TAC th g) THEN RES_TAC]]);; let SUBSET_INSERT_DELETE = prove_thm (`SUBSET_INSERT_DELETE`, "!x:*. !s t. s SUBSET (x INSERT t) = ((s DELETE x) SUBSET t)", REPEAT GEN_TAC THEN REWRITE_TAC [SUBSET_DEF;IN_INSERT;IN_DELETE] THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [RES_TAC THEN RES_TAC; ASM_CASES_TAC "x':* = x" THEN ASM_REWRITE_TAC[] THEN RES_TAC]);; let DIFF_INSERT = prove_thm (`DIFF_INSERT`, "!s t. !x:*. s DIFF (x INSERT t) = (s DELETE x) DIFF t", PURE_REWRITE_TAC [EXTENSION;IN_DIFF;IN_INSERT;IN_DELETE] THEN REWRITE_TAC [DE_MORGAN_THM;CONJ_ASSOC]);; let DELETE_INSERT = prove_thm (`DELETE_INSERT`, "!x:*. !y s. (x INSERT s) DELETE y = ((x=y) => s DELETE y | x INSERT (s DELETE y))", REWRITE_TAC [EXTENSION;IN_DELETE;IN_INSERT] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN DISCH_TAC THEN let tac th g = SUBST_ALL_TAC th g ? ASSUME_TAC th g in DISCH_THEN (STRIP_THM_THEN tac) THENL [ASM_REWRITE_TAC [IN_INSERT]; COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE;IN_INSERT]]; COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE;IN_INSERT] THENL [STRIP_TAC THEN ASM_REWRITE_TAC []; STRIP_TAC THEN ASM_REWRITE_TAC []]]);; let INSERT_DELETE = prove_thm (`INSERT_DELETE`, "!x:*. !s. x IN s ==> (x INSERT (s DELETE x) = s)", PURE_REWRITE_TAC [EXTENSION;IN_INSERT;IN_DELETE] THEN REPEAT GEN_TAC THEN DISCH_THEN (\th. GEN_TAC THEN MP_TAC th) THEN ASM_CASES_TAC "x':* = x" THEN ASM_REWRITE_TAC[]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DELETE_INTER = prove_thm (`DELETE_INTER`, "!s t. !x:*. (s DELETE x) INTER t = (s INTER t) DELETE x", PURE_ONCE_REWRITE_TAC [EXTENSION] THEN REPEAT GEN_TAC THEN REWRITE_TAC [IN_INTER;IN_DELETE] THEN EQ_TAC THEN REPEAT STRIP_TAC THEN FIRST [FIRST_ASSUM ACCEPT_TAC;RES_TAC]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let DISJOINT_DELETE_SYM = prove_thm (`DISJOINT_DELETE_SYM`, "!s t. !x:*. DISJOINT (s DELETE x) t = DISJOINT (t DELETE x) s", REWRITE_TAC [DISJOINT_DEF;EXTENSION;NOT_IN_EMPTY] THEN REWRITE_TAC [IN_INTER;IN_DELETE;DE_MORGAN_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THEN let X = "X:*" in DISCH_THEN (\th. X_GEN_TAC X THEN STRIP_ASSUME_TAC (SPEC X th)) THEN ASM_REWRITE_TAC []);; % ===================================================================== % % Choice % % ===================================================================== % let CHOICE_EXISTS = TAC_PROOF (([], "?CHOICE. !s:(*)set. ~(s = EMPTY) ==> (CHOICE s) IN s"), REWRITE_TAC [EXTENSION;NOT_IN_EMPTY] THEN EXISTS_TAC "\s. @x:*. x IN s" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV SELECT_CONV) THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN REWRITE_TAC []);; let CHOICE_DEF = new_specification `CHOICE_DEF` [`constant`,`CHOICE`] CHOICE_EXISTS;; % ===================================================================== % % The REST of a set after removing a chosen element. % % ===================================================================== % let REST_DEF = new_definition (`REST_DEF`, "REST (s:(*)set) = s DELETE (CHOICE s)");; let CHOICE_NOT_IN_REST = prove_thm (`CHOICE_NOT_IN_REST`, "!s:(*)set. ~(CHOICE s) IN (REST s)", REWRITE_TAC [IN_DELETE;REST_DEF]);; let CHOICE_INSERT_REST = prove_thm (`CHOICE_INSERT_REST`, "!s:(*)set. ~(s = EMPTY) ==> (((CHOICE s) INSERT (REST s)) = s)", REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [EXTENSION;IN_INSERT;REST_DEF;IN_DELETE] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [IMP_RES_TAC CHOICE_DEF THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC [EXCLUDED_MIDDLE]]);; let REST_SUBSET = prove_thm (`REST_SUBSET`, "!s:(*)set. (REST s) SUBSET s", REWRITE_TAC [SUBSET_DEF;REST_DEF;IN_DELETE] THEN REPEAT STRIP_TAC);; let lemma = TAC_PROOF(([], "(P /\ Q = P) = (P ==> Q)"), BOOL_CASES_TAC "P:bool" THEN REWRITE_TAC[]);; let REST_PSUBSET = prove_thm (`REST_PSUBSET`, "!s:(*)set. ~(s = EMPTY) ==> (REST s) PSUBSET s", REWRITE_TAC [PSUBSET_DEF;REST_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [EXTENSION;REST_DEF;IN_DELETE] THEN CONV_TAC NOT_FORALL_CONV THEN REWRITE_TAC [DE_MORGAN_THM;lemma;NOT_IMP] THEN EXISTS_TAC "CHOICE (s:(*)set)" THEN IMP_RES_TAC CHOICE_DEF THEN ASM_REWRITE_TAC []);; % ===================================================================== % % Singleton set. % % ===================================================================== % let SING_DEF = new_definition (`SING_DEF`, "SING s = ?x:*. s = {x}");; let SING = prove_thm (`SING`, "!x:*. SING {x}", PURE_ONCE_REWRITE_TAC [SING_DEF] THEN GEN_TAC THEN EXISTS_TAC "x:*" THEN REFL_TAC);; let IN_SING = prove_thm (`IN_SING`, "!x y. x IN {y:*} = (x = y)", REWRITE_TAC [IN_INSERT;NOT_IN_EMPTY]);; let NOT_SING_EMPTY = prove_thm (`NOT_SING_EMPTY`, "!x:*. ~({x} = EMPTY)", REWRITE_TAC [EXTENSION;IN_SING;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN EXISTS_TAC "x:*" THEN REWRITE_TAC[]);; let NOT_EMPTY_SING = prove_thm (`NOT_EMPTY_SING`, "!x:*. ~(EMPTY = {x})", REWRITE_TAC [EXTENSION;IN_SING;NOT_IN_EMPTY] THEN CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN EXISTS_TAC "x:*" THEN REWRITE_TAC[]);; let EQUAL_SING = prove_thm (`EQUAL_SING`, "!x:*. !y. ({x} = {y}) = (x = y)", REWRITE_TAC [EXTENSION;IN_SING] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (\th. REWRITE_TAC [SYM(SPEC_ALL th)]); DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC]);; let DISJOINT_SING_EMPTY = prove_thm (`DISJOINT_SING_EMPTY`, "!x:*. DISJOINT {x} EMPTY", REWRITE_TAC [DISJOINT_DEF;INTER_EMPTY]);; let INSERT_SING_UNION = prove_thm (`INSERT_SING_UNION`, "!s. !x:*. x INSERT s = {x} UNION s", REWRITE_TAC [EXTENSION;IN_INSERT;IN_UNION;NOT_IN_EMPTY]);; let SING_DELETE = prove_thm (`SING_DELETE`, "!x:*. {x} DELETE x = EMPTY", REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_DELETE;IN_INSERT] THEN PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN REWRITE_TAC [DE_MORGAN_THM;EXCLUDED_MIDDLE]);; let DELETE_EQ_SING = prove_thm (`DELETE_EQ_SING`, "!s. !x:*. (x IN s) ==> ((s DELETE x = EMPTY) = (s = {x}))", PURE_ONCE_REWRITE_TAC [EXTENSION] THEN REWRITE_TAC [NOT_IN_EMPTY;DE_MORGAN_THM;IN_INSERT;IN_DELETE] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM (\th g. STRIP_ASSUME_TAC (SPEC "x':*" th) g) THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC; let th = PURE_ONCE_REWRITE_RULE [DISJ_SYM] EXCLUDED_MIDDLE in DISCH_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC [th]]);; let CHOICE_SING = prove_thm (`CHOICE_SING`, "!x:*. CHOICE {x} = x", GEN_TAC THEN MP_TAC (MATCH_MP CHOICE_DEF (SPEC "x:*" NOT_SING_EMPTY)) THEN REWRITE_TAC [IN_SING]);; let REST_SING = prove_thm (`REST_SING`, "!x:*. REST {x} = EMPTY", REWRITE_TAC [CHOICE_SING;REST_DEF;SING_DELETE]);; let SING_IFF_EMPTY_REST = prove_thm (`SING_IFF_EMPTY_REST`, "!s:(*)set. SING s = ~(s = EMPTY) /\ (REST s = EMPTY)", PURE_ONCE_REWRITE_TAC [SING_DEF] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL [ASM_REWRITE_TAC [REST_SING] THEN REWRITE_TAC [EXTENSION;NOT_IN_EMPTY;IN_INSERT] THEN CONV_TAC NOT_FORALL_CONV THEN EXISTS_TAC "x:*" THEN REWRITE_TAC []; EXISTS_TAC "CHOICE s:*" THEN IMP_RES_THEN (SUBST1_TAC o SYM) CHOICE_INSERT_REST THEN ASM_REWRITE_TAC [EXTENSION;IN_SING;CHOICE_SING]]);; % ===================================================================== % % The image of a function on a set. % % ===================================================================== % let IMAGE_EXISTS = TAC_PROOF (([], "!f:*->**. !s:(*)set. ?t. !y. y IN t = ?x. (y = f x) /\ x IN s"), GEN_TAC THEN SET_INDUCT_TAC THENL [EXISTS_TAC "{}:(**)set" THEN REWRITE_TAC [NOT_IN_EMPTY]; FIRST_ASSUM (CHOOSE_THEN STRIP_ASSUME_TAC) THEN EXISTS_TAC "(f (e:*):**) INSERT t" THEN ASM_REWRITE_TAC [IN_INSERT] THEN GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "e:*" THEN ASM_REWRITE_TAC []; EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; DISJ2_TAC THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC []]]);; let IN_IMAGE = let th1 = CONV_RULE SKOLEM_CONV IMAGE_EXISTS in new_specification `IN_IMAGE` [`constant`,`IMAGE`] th1;; let IMAGE_IN = prove_thm (`IMAGE_IN`, "!x s. (x IN s) ==> !(f:*->**). f x IN (IMAGE f s)", PURE_ONCE_REWRITE_TAC [IN_IMAGE] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x:*" THEN CONJ_TAC THENL [REFL_TAC; FIRST_ASSUM ACCEPT_TAC]);; let IMAGE_EMPTY = prove_thm (`IMAGE_EMPTY`, "!f:*->**. IMAGE f EMPTY = EMPTY", REWRITE_TAC[EXTENSION;IN_IMAGE;NOT_IN_EMPTY]);; let IMAGE_ID = prove_thm (`IMAGE_ID`, "!s:* set. IMAGE (\x:*.x) s = s", REWRITE_TAC [EXTENSION;IN_IMAGE] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ALL_TAC;EXISTS_TAC "x:*"] THEN ASM_REWRITE_TAC []);; let IMAGE_COMPOSE = prove_thm (`IMAGE_COMPOSE`, "!f:**->***. !g:*->**. !s. IMAGE (f o g) s = IMAGE f (IMAGE g s)", PURE_REWRITE_TAC [EXTENSION;IN_IMAGE;o_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [EXISTS_TAC "g (x':*):**" THEN CONJ_TAC THENL [ALL_TAC;EXISTS_TAC "x':*"] THEN ASM_REWRITE_TAC []; EXISTS_TAC "x'':*" THEN ASM_REWRITE_TAC[]]);; let IMAGE_INSERT = prove_thm (`IMAGE_INSERT`, "!(f:*->**) x s. IMAGE f (x INSERT s) = f x INSERT (IMAGE f s)", PURE_REWRITE_TAC [EXTENSION;IN_INSERT;IN_IMAGE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [ALL_TAC;DISJ2_TAC THEN EXISTS_TAC "x'':*"; EXISTS_TAC "x:*";EXISTS_TAC "x'':*"] THEN ASM_REWRITE_TAC[]);; let IMAGE_EQ_EMPTY = prove_thm (`IMAGE_EQ_EMPTY`, "!s. !f:*->**. ((IMAGE f s) = EMPTY) = (s = EMPTY)", GEN_TAC THEN STRIP_ASSUME_TAC (SPEC "s:(*)set" SET_CASES) THEN ASM_REWRITE_TAC [IMAGE_EMPTY;IMAGE_INSERT;NOT_INSERT_EMPTY]);; let IMAGE_DELETE = prove_thm (`IMAGE_DELETE`, "!(f:*->**) x s. ~(x IN s) ==> (IMAGE f (s DELETE x) = (IMAGE f s))", REPEAT GEN_TAC THEN STRIP_TAC THEN PURE_REWRITE_TAC [EXTENSION;IN_DELETE;IN_IMAGE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN EXISTS_TAC "x'':*" THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC);; let IMAGE_UNION = prove_thm (`IMAGE_UNION`, "!(f:*->**) s t. IMAGE f (s UNION t) = (IMAGE f s) UNION (IMAGE f t)", PURE_REWRITE_TAC [EXTENSION;IN_UNION;IN_IMAGE] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [DISJ1_TAC;DISJ2_TAC;ALL_TAC;ALL_TAC] THEN EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []);; let IMAGE_SUBSET = prove_thm (`IMAGE_SUBSET`, "!s t. (s SUBSET t) ==> !f:*->**. (IMAGE f s) SUBSET (IMAGE f t)", PURE_REWRITE_TAC [SUBSET_DEF;IN_IMAGE] THEN REPEAT STRIP_TAC THEN RES_TAC THEN EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []);; let IMAGE_INTER = prove_thm (`IMAGE_INTER`, "!(f:*->**) s t. IMAGE f (s INTER t) SUBSET (IMAGE f s INTER IMAGE f t)", REPEAT GEN_TAC THEN REWRITE_TAC [SUBSET_DEF;IN_IMAGE;IN_INTER] THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x':*" THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let lemma = TAC_PROOF (([], "!s x. x IN s ==> !f:*->**. (f x) IN (IMAGE f s)"), REPEAT STRIP_TAC THEN PURE_ONCE_REWRITE_TAC [IN_IMAGE] THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]);; let SET_MINIMUM = prove_thm (`SET_MINIMUM`, "!s:(*)set. !M. (?x. x IN s) = ?x. x IN s /\ !y. y IN s ==> M x <= M y", REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [IMP_RES_THEN (ASSUME_TAC o ISPEC "M:*->num") lemma THEN let rule = REWRITE_RULE [IN_IMAGE] in IMP_RES_THEN (STRIP_ASSUME_TAC o rule) NUM_SET_WOP THEN EXISTS_TAC "x':*" THEN CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM (SUBST_ALL_TAC o SYM) THEN REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC "y:*" THEN CONJ_TAC THENL [REFL_TAC; FIRST_ASSUM ACCEPT_TAC]]; EXISTS_TAC "x:*" THEN FIRST_ASSUM ACCEPT_TAC]);; % ===================================================================== % % Injective functions on a set. % % ===================================================================== % let INJ_DEF = new_definition (`INJ_DEF`, "INJ (f:*->**) s t = (!x. x IN s ==> (f x) IN t) /\ (!x y. (x IN s /\ y IN s) ==> (f x = f y) ==> (x = y))");; let INJ_ID = prove_thm (`INJ_ID`, "!s. INJ (\x:*.x) s s", PURE_ONCE_REWRITE_TAC [INJ_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC);; let INJ_COMPOSE = prove_thm (`INJ_COMPOSE`, "!f:*->**. !g:**->***. !s t u. (INJ f s t /\ INJ g t u) ==> INJ (g o f) s u", PURE_REWRITE_TAC [INJ_DEF;o_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC; RES_TAC THEN RES_TAC]);; let INJ_EMPTY = prove_thm (`INJ_EMPTY`, "!f:*->**. (!s. INJ f {} s) /\ (!s. INJ f s {} = (s = {}))", REWRITE_TAC [INJ_DEF;NOT_IN_EMPTY;EXTENSION] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC);; % ===================================================================== % % Surjective functions on a set. % % ===================================================================== % let SURJ_DEF = new_definition (`SURJ_DEF`, "SURJ (f:*->**) s t = (!x. x IN s ==> (f x) IN t) /\ (!x. (x IN t) ==> ?y. y IN s /\ (f y = x))");; let SURJ_ID = prove_thm (`SURJ_ID`, "!s. SURJ (\x:*.x) s s", PURE_ONCE_REWRITE_TAC [SURJ_DEF] THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []);; let SURJ_COMPOSE = prove_thm (`SURJ_COMPOSE`, "!f:*->**. !g:**->***. !s t u. (SURJ f s t /\ SURJ g t u) ==> SURJ (g o f) s u", PURE_REWRITE_TAC [SURJ_DEF;o_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC; RES_TAC THEN RES_TAC THEN EXISTS_TAC "y'':*" THEN ASM_REWRITE_TAC []]);; let SURJ_EMPTY = prove_thm (`SURJ_EMPTY`, "!f:*->**. (!s. SURJ f {} s = (s = {})) /\ (!s. SURJ f s {} = (s = {}))", REWRITE_TAC [SURJ_DEF;NOT_IN_EMPTY;EXTENSION]);; let IMAGE_SURJ = prove_thm (`IMAGE_SURJ`, "!f:*->**. !s t. SURJ f s t = ((IMAGE f s) = t)", PURE_REWRITE_TAC [SURJ_DEF;EXTENSION;IN_IMAGE] THEN REPEAT GEN_TAC THEN EQ_TAC THENL [REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL [RES_TAC THEN ASM_REWRITE_TAC []; MAP_EVERY PURE_ONCE_REWRITE_TAC [[CONJ_SYM];[EQ_SYM_EQ]] THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]; DISCH_THEN (ASSUME_TAC o CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THENL [EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC []; EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []]]);; % ===================================================================== % % Bijective functions on a set. % % ===================================================================== % let BIJ_DEF = new_definition (`BIJ_DEF`, "BIJ (f:*->**) s t = INJ f s t /\ SURJ f s t");; let BIJ_ID = prove_thm (`BIJ_ID`, "!s. BIJ (\x:*.x) s s", REWRITE_TAC [BIJ_DEF;INJ_ID;SURJ_ID]);; let BIJ_EMPTY = prove_thm (`BIJ_EMPTY`, "!f:*->**. (!s. BIJ f {} s = (s = {})) /\ (!s. BIJ f s {} = (s = {}))", REWRITE_TAC [BIJ_DEF;INJ_EMPTY;SURJ_EMPTY]);; let BIJ_COMPOSE = prove_thm (`BIJ_COMPOSE`, "!f:*->**. !g:**->***. !s t u. (BIJ f s t /\ BIJ g t u) ==> BIJ (g o f) s u", PURE_REWRITE_TAC [BIJ_DEF] THEN REPEAT STRIP_TAC THENL [IMP_RES_TAC INJ_COMPOSE;IMP_RES_TAC SURJ_COMPOSE]);; % ===================================================================== % % Left and right inverses. % % ===================================================================== % let lemma1 = TAC_PROOF (([], "!f:*->**. !s. (!x y. x IN s /\ y IN s ==> (f x = f y) ==> (x = y)) = (!y. y IN s ==> !x.((x IN s /\ (f x = f y))=(y IN s /\ (x = y))))"), REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC THEN ASM_REWRITE_TAC []);; let lemma2 = TAC_PROOF (([], "!f:*->**. !s. ?g. !t. INJ f s t ==> !x:*. x IN s ==> (g(f x) = x)"), REPEAT GEN_TAC THEN PURE_REWRITE_TAC [INJ_DEF;lemma1] THEN EXISTS_TAC "\y:**. @x:*. x IN s /\ (f x = y)" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN (RES_THEN \th. REWRITE_TAC [th]) THEN ASM_REWRITE_TAC [] THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "x:*" THEN REFL_TAC);; % --------------------------------------------------------------------- % % LINV_DEF: % % |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) % % --------------------------------------------------------------------- % let LINV_DEF = let th1 = CONV_RULE (ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) lemma2 in let th2 = CONV_RULE SKOLEM_CONV th1 in new_specification `LINV_DEF` [`constant`,`LINV`] th2;; let lemma3 = TAC_PROOF (([], "!f:*->**. !s. ?g. !t. SURJ f s t ==> !x:**. x IN t ==> (f(g x) = x)"), REPEAT GEN_TAC THEN PURE_REWRITE_TAC [SURJ_DEF] THEN EXISTS_TAC "\y:**. @x:*. x IN s /\ (f x = y)" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN REPEAT STRIP_TAC THEN (\(A,g). let tm = mk_conj("^(rand(lhs g)) IN s",g) in SUBGOAL_THEN tm (\th. ACCEPT_TAC(CONJUNCT2 th))(A,g)) THEN CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; % --------------------------------------------------------------------- % % RINV_DEF: % % |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) % % --------------------------------------------------------------------- % let RINV_DEF = let th1 = CONV_RULE (ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) lemma3 in let th2 = CONV_RULE SKOLEM_CONV th1 in new_specification `RINV_DEF` [`constant`,`RINV`] th2;; % ===================================================================== % % Cardinality % % ===================================================================== % % --------------------------------------------------------------------- % % card_rel_def: defining equations for a relation "R s n", which means % % that the finite s has cardinality n. % % --------------------------------------------------------------------- % let card_rel_def = "(!s. R s 0 = (s = EMPTY)) /\ (!s n. R s (SUC n) = ?x:*. x IN s /\ R (s DELETE x) n)";; % --------------------------------------------------------------------- % % Prove that such a relation exists. % % --------------------------------------------------------------------- % let CARD_REL_EXISTS = prove_rec_fn_exists num_Axiom card_rel_def;; % --------------------------------------------------------------------- % % Now, prove that it doesn't matter which element we delete % % Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] % % --------------------------------------------------------------------- % let CARD_REL_DEL_LEMMA = TAC_PROOF ((conjuncts card_rel_def, "!n:num.!s.!x:*. x IN s ==> R (s DELETE x) n ==> !y:*. y IN s ==> R (s DELETE y) n"), INDUCT_TAC THENL [REPEAT GEN_TAC THEN DISCH_TAC THEN IMP_RES_TAC DELETE_EQ_SING THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [IN_SING] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [SING_DELETE]; ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN let th = (SPEC "y:* = x'" EXCLUDED_MIDDLE) in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th THENL [MP_TAC (SPECL ["s:(*)set";"x:*";"x':*"] IN_DELETE_EQ) THEN ASM_REWRITE_TAC [] THEN DISCH_TAC THEN PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC[]; let th = (SPEC "x:* = y" EXCLUDED_MIDDLE) in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th THENL [EXISTS_TAC "x':*" THEN ASM_REWRITE_TAC []; EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC [IN_DELETE] THEN RES_THEN (TRY o IMP_RES_THEN ASSUME_TAC) THEN PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [IN_DELETE] THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN FIRST_ASSUM ACCEPT_TAC]]]);; % --------------------------------------------------------------------- % % So "R s" specifies a unique number. % % --------------------------------------------------------------------- % let CARD_REL_UNIQUE = TAC_PROOF ((conjuncts card_rel_def, "!n:num. !s:(*)set. R s n ==> (!m. R s m ==> (n = m))"), INDUCT_TAC THEN ASM_REWRITE_TAC [] THENL [GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THENL [STRIP_TAC THEN REFL_TAC; ASM_REWRITE_TAC[NOT_SUC;NOT_IN_EMPTY]]; GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL [ASM_REWRITE_TAC [NOT_SUC;SYM(SPEC_ALL MEMBER_NOT_EMPTY)] THEN EXISTS_TAC "x:*" THEN FIRST_ASSUM ACCEPT_TAC; ASM_REWRITE_TAC [INV_SUC_EQ] THEN STRIP_TAC THEN IMP_RES_TAC CARD_REL_DEL_LEMMA THEN RES_TAC]]);; % --------------------------------------------------------------------- % % Now, ?n. R s n if s is finite. % % --------------------------------------------------------------------- % let CARD_REL_EXISTS_LEMMA = TAC_PROOF ((conjuncts card_rel_def, "!s:(*)set. ?n:num. R s n"), SET_INDUCT_TAC THENL [EXISTS_TAC "0" THEN ASM_REWRITE_TAC[]; FIRST_ASSUM (\th g. CHOOSE_THEN ASSUME_TAC th g) THEN EXISTS_TAC "SUC n" THEN ASM_REWRITE_TAC [] THEN EXISTS_TAC "e:*" THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC [DELETE_INSERT;IN_INSERT]]);; % --------------------------------------------------------------------- % % So (@n. R s n) = m iff R s m (\s.@n.R s n defines a function) % % Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] % % --------------------------------------------------------------------- % let CARD_REL_THM = TAC_PROOF ((conjuncts card_rel_def, "!m s.((@n:num. R (s:(*)set) n) = m) = R s m"), REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (SPEC "s:(*)set" CARD_REL_EXISTS_LEMMA) THEN EQ_TAC THENL [DISCH_THEN (SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "n:num" THEN FIRST_ASSUM MATCH_ACCEPT_TAC; STRIP_TAC THEN IMP_RES_THEN ASSUME_TAC CARD_REL_UNIQUE THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN CONV_TAC SELECT_CONV THEN EXISTS_TAC "n:num" THEN FIRST_ASSUM MATCH_ACCEPT_TAC]);; % --------------------------------------------------------------------- % % Now, prove the existence of the required cardinality function. % % --------------------------------------------------------------------- % let CARD_EXISTS = TAC_PROOF (([]," ?CARD. (CARD EMPTY = 0) /\ (!s. !x:*. CARD(x INSERT s) = (x IN s => CARD s | SUC(CARD s)))"), STRIP_ASSUME_TAC CARD_REL_EXISTS THEN EXISTS_TAC "\s:(*)set. @n:num. R s n" THEN CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONJ_TAC THENL [ASM_REWRITE_TAC [CARD_REL_THM]; REPEAT STRIP_TAC THEN COND_CASES_TAC THENL [IMP_RES_THEN SUBST1_TAC ABSORPTION THEN REFL_TAC; ASM_REWRITE_TAC [CARD_REL_THM] THEN EXISTS_TAC "x:*" THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC [IN_INSERT;DELETE_INSERT] THEN CONV_TAC SELECT_CONV THEN MATCH_ACCEPT_TAC CARD_REL_EXISTS_LEMMA]]);; % --------------------------------------------------------------------- % % Finally, introduce the CARD function via a constant specification. % % --------------------------------------------------------------------- % let CARD_DEF = new_specification `CARD_DEF` [`constant`,`CARD`] CARD_EXISTS;; % --------------------------------------------------------------------- % % Various cardinality results. % % --------------------------------------------------------------------- % let CARD_EMPTY = save_thm(`CARD_EMPTY`,CONJUNCT1 CARD_DEF);; let CARD_INSERT = save_thm(`CARD_INSERT`,CONJUNCT2 CARD_DEF);; let CARD_EQ_0 = prove_thm (`CARD_EQ_0`, "!s:(*)set. (CARD s = 0) = (s = EMPTY)", SET_INDUCT_TAC THENL [REWRITE_TAC [CARD_EMPTY]; ASM_REWRITE_TAC [CARD_INSERT;NOT_INSERT_EMPTY;NOT_SUC]]);; let CARD_DELETE = prove_thm (`CARD_DELETE`, "!s. !x:*. CARD(s DELETE x) = (x IN s => (CARD s) - 1 | CARD s)", SET_INDUCT_TAC THENL [REWRITE_TAC [EMPTY_DELETE;NOT_IN_EMPTY]; PURE_REWRITE_TAC [DELETE_INSERT;IN_INSERT] THEN REPEAT GEN_TAC THEN ASM_CASES_TAC "x:* = e" THENL [ASM_REWRITE_TAC [SUC_SUB1;CARD_DEF]; SUBST1_TAC (SPECL ["e:*";"x:*"] EQ_SYM_EQ) THEN ASM_REWRITE_TAC [CARD_DEF;IN_DELETE;SUC_SUB1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC [] THEN STRIP_ASSUME_TAC (SPEC "CARD(s:(*)set)" num_CASES) THENL [(let tac th g = SUBST_ALL_TAC th g ? ASSUME_TAC th g in REPEAT_GTCL IMP_RES_THEN tac CARD_EQ_0 THEN IMP_RES_TAC NOT_IN_EMPTY); ASM_REWRITE_TAC [SUC_SUB1]]]]);; let lemma1 = TAC_PROOF (([], "!n m. (SUC n <= SUC m) = (n <= m)"), REWRITE_TAC [LESS_OR_EQ;INV_SUC_EQ;LESS_MONO_EQ]);; let lemma2 = TAC_PROOF (([], "!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))"), REWRITE_TAC [LESS_OR_EQ;LESS_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let CARD_INTER_LESS_EQ = prove_thm (`CARD_INTER_LESS_EQ`, "!s:(*)set. !t. CARD (s INTER t) <= CARD s", SET_INDUCT_TAC THENL [REWRITE_TAC [CARD_DEF;INTER_EMPTY;LESS_EQ_REFL]; PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN GEN_TAC THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC [CARD_DEF;IN_INTER;lemma1]; ASM_REWRITE_TAC [CARD_DEF;lemma2]]]);; let CARD_UNION = prove_thm (`CARD_UNION`, "!s:(*)set. !t. (CARD (s UNION t) + CARD (s INTER t) = CARD s + CARD t)", SET_INDUCT_TAC THENL [REWRITE_TAC [UNION_EMPTY;INTER_EMPTY;CARD_DEF;ADD_CLAUSES]; REPEAT STRIP_TAC THEN REWRITE_TAC [INSERT_UNION;INSERT_INTER] THEN ASM_CASES_TAC "(e:*) IN t" THENL [ASM_REWRITE_TAC [IN_INTER;ADD_CLAUSES;CARD_DEF]; ASM_REWRITE_TAC [CARD_DEF;ADD_CLAUSES; INV_SUC_EQ; IN_UNION]]]);; let lemma = TAC_PROOF (([], "!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))"), REWRITE_TAC [LESS_OR_EQ;LESS_THM] THEN REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]);; let CARD_SUBSET = prove_thm (`CARD_SUBSET`, "!s:(*)set. !t. t SUBSET s ==> (CARD t <= CARD s)", SET_INDUCT_TAC THENL [REWRITE_TAC [SUBSET_EMPTY;CARD_EMPTY] THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [CARD_DEF;LESS_EQ_REFL]; ASM_REWRITE_TAC [CARD_INSERT;SUBSET_INSERT_DELETE] THEN REPEAT STRIP_TAC THEN RES_THEN MP_TAC THEN ASM_REWRITE_TAC [CARD_DELETE] THEN COND_CASES_TAC THENL [(let th = SPEC "CARD (t:(*)set)" num_CASES in REPEAT_TCL STRIP_THM_THEN SUBST_ALL_TAC th) THENL [REWRITE_TAC [LESS_OR_EQ;LESS_0]; REWRITE_TAC [SUC_SUB1;LESS_OR_EQ;LESS_MONO_EQ;INV_SUC_EQ]]; STRIP_TAC THEN ASM_REWRITE_TAC [lemma]]]);; let CARD_PSUBSET = prove_thm (`CARD_PSUBSET`, "!s:(*)set. !t. t PSUBSET s ==> (CARD t < CARD s)", REPEAT STRIP_TAC THEN IMP_RES_TAC PSUBSET_DEF THEN IMP_RES_THEN MP_TAC CARD_SUBSET THEN PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN DISCH_THEN (STRIP_THM_THEN (\th g. ACCEPT_TAC th g ? MP_TAC th g)) THEN IMP_RES_THEN STRIP_ASSUME_TAC PSUBSET_INSERT_SUBSET THEN IMP_RES_THEN MP_TAC CARD_SUBSET THEN IMP_RES_TAC INSERT_SUBSET THEN ASM_REWRITE_TAC [CARD_INSERT;LESS_EQ] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; let CARD_SING = prove_thm (`CARD_SING`, "!x:*. CARD {x} = 1", CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN REWRITE_TAC [CARD_EMPTY;CARD_INSERT;NOT_IN_EMPTY]);; let SING_IFF_CARD1 = prove_thm (`SING_IFF_CARD1`, "!s:(*)set. (SING s) = (CARD s = 1)", REWRITE_TAC [SING_DEF;num_CONV "1"] THEN GEN_TAC THEN EQ_TAC THENL [DISCH_THEN (CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC [CARD_SING;num_CONV "1"]; STRIP_ASSUME_TAC (SPEC "s:(*)set" SET_CASES) THENL [ASM_REWRITE_TAC [CARD_EMPTY;NOT_EQ_SYM(SPEC_ALL NOT_SUC)]; FIRST_ASSUM SUBST1_TAC THEN ASM_REWRITE_TAC [CARD_INSERT;INV_SUC_EQ;CARD_EQ_0] THEN DISCH_TAC THEN EXISTS_TAC "x:*" THEN ASM_REWRITE_TAC []]]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let CARD_DIFF = prove_thm (`CARD_DIFF`, "!t:(*)set. !s. CARD (s DIFF t) = (CARD s - CARD (s INTER t))", SET_INDUCT_TAC THEN REPEAT GEN_TAC THENL [REWRITE_TAC [DIFF_EMPTY;INTER_EMPTY;CARD_EMPTY;SUB_0]; PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN COND_CASES_TAC THENL [ASM_REWRITE_TAC [CARD_INSERT;IN_INTER;DIFF_INSERT;CARD_DELETE] THEN PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL SUB_PLUS)] THEN REWRITE_TAC [num_CONV "1";ADD_CLAUSES;DELETE_INTER] THEN MP_TAC (SPECL ["s':(*)set";"s:(*)set";"e:*"] IN_INTER) THEN ASM_REWRITE_TAC [DELETE_NON_ELEMENT] THEN DISCH_THEN SUBST1_TAC THEN SUBST1_TAC (SPECL ["s:(*)set";"s':(*)set"] INTER_COMM) THEN REFL_TAC; IMP_RES_TAC DELETE_NON_ELEMENT THEN PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN ASM_REWRITE_TAC [DIFF_INSERT]]]);; % --------------------------------------------------------------------- % % A theorem from homeier@org.aero.uniblab (Peter Homeier) % % --------------------------------------------------------------------- % let LESS_CARD_DIFF = prove_thm (`LESS_CARD_DIFF`, "!t:(*)set. !s. (CARD t < CARD s) ==> (0 < CARD(s DIFF t))", PURE_REWRITE_TAC [CARD_DIFF; GSYM SUB_LESS_0] THEN REPEAT STRIP_TAC THEN let th1 = SPECL ["s:(*)set";"t:(*)set"] CARD_INTER_LESS_EQ in let th2 = PURE_ONCE_REWRITE_RULE [LESS_OR_EQ] th1 in DISJ_CASES_THEN2 ACCEPT_TAC (SUBST_ALL_TAC o SYM) th2 THEN let th3 = SPECL ["t:(*)set";"s:(*)set"] CARD_INTER_LESS_EQ in let th4 = PURE_ONCE_REWRITE_RULE [INTER_COMM] th3 in IMP_RES_TAC (PURE_ONCE_REWRITE_RULE [GSYM NOT_LESS] th4));; quit();; % Needed for Common Lisp % hol88-2.02.19940316/Library/finite_sets/READ-ME0000640000212700021270000000351205304704405016603 0ustar cammcamm+ ===================================================================== + | | | LIBRARY : finite_sets | | | | DESCRIPTION : Theory of finite sets | | | | AUTHORS : Phil Windley, Philippe Leveilley | | DATE : 12 May, 1989 | | REVISED : T Melham, February 1992 for HOL version 2.01 | | | | NOTE : This library has been completely rewritten for HOL | | version 2.01. See the file "CHANGES". | + ===================================================================== + + --------------------------------------------------------------------- + | FILES: | + --------------------------------------------------------------------- + mk_finite_sets.ml creates the theory of sets fset_conv.ml conversions for finite sets set_ind.ml induction tactic for finite sets finite_sets.ml loadfile for the finite_sets library load_finite_sets.ml auxiliary loadfile for the finite_sets library + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clobber" 3) type "make all" + --------------------------------------------------------------------- + | | | TO USE THE LIBRARY: | | | + --------------------------------------------------------------------- + load_library `finite_sets` + --------------------------------------------------------------------- + | | | DOCUMENTATION: | | | + --------------------------------------------------------------------- + * User Manual: Manual/finite_sets.dvi * Changes since HOL version 2.0: ./CHANGES hol88-2.02.19940316/Library/finite_sets/set_ind.ml0000640000212700021270000000415505147526711017640 0ustar cammcamm% ===================================================================== % % FILE : set_ind.ml % % DESCRIPTION : Induction principle for finite sets. % % % % REWRITTEN : T Melham % % DATE : 92.02.15 % % ===================================================================== % % --------------------------------------------------------------------- % % % % "!s. P s" % % ========================== SET_INDUCT_TAC % % P EMPTY P (x INSERT t) % % [ "P s" % % [ "~x IN t"] % % % % --------------------------------------------------------------------- % let SET_INDUCT_TAC = let ithm = theorem `finite_sets` `SET_INDUCT` and check v = fst(dest_type(type_of v)) = `set` in let MK_IMP1 = let IMP = "==>" in \tm. AP_TERM (mk_comb(IMP,tm)) and MK_IMP2 = let IMP = "==>" in \th1 th2. MK_COMB(AP_TERM IMP th1,th2) in let sconv = let dest = (I # dest_imp) o dest_forall in \tm. let s,a,e,h,c = (I # (I # dest)) (dest tm) in let th1 = BETA_CONV a and th2 = BETA_CONV c in FORALL_EQ s (MK_IMP2 th1 (FORALL_EQ e (MK_IMP1 h th2))) in let conv = let CONJ = "/\" in \tm. let base,step = dest_conj tm in MK_COMB(AP_TERM CONJ (BETA_CONV base), sconv step) in let STAC = GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC in \A,g. (let s,conc = (assert check # I) (dest_forall g) in let (_,[ty]) = dest_type(type_of s) in let inst = INST_TYPE [ty,":*"] ithm in let sv = genvar (type_of s) in let pred = mk_abs(sv,(subst [sv,s] conc)) in let spec = SPEC s (UNDISCH (SPEC pred inst)) in let beta = GEN s (CONV_RULE BETA_CONV spec) in let disc = DISCH (hd(hyp beta)) beta in let ithm = CONV_RULE (RATOR_CONV(RAND_CONV conv)) disc in (MATCH_MP_TAC ithm THEN CONJ_TAC THENL [ALL_TAC; STAC])(A,g)) ? failwith `SET_INDUCT_TAC`;; hol88-2.02.19940316/Library/finite_sets/CHANGES0000640000212700021270000001036005147526715016653 0ustar cammcammNOTE CONCERNING REVISIONS TO THE finite_sets LIBRARY ---------------------------------------------------- The finite_sets library has been completely rewritten for HOL88 version 2.01. In particular, the library has been made as exactly parallel as possible to the sets and pred_sets libraries, with the same names for theorems, the same form of definitions, and a similar manual. Users of older versions of the library should note that: * the MK_SET mechanism has been deleted * some of the function constants have been made infixes * the constant INTERSECT is now called INTER * there are the following rough correspondences between the old and new theorems and definitions OLD NEW =========================== ============================== EMPTY_REP_DEF obsolete INSERT_REP_DEF obsolete IS_SET_REP slightly modified set_ISO_DEF obsolete EMPTY_DEF obsolete IN obsolete INSERT_DEF obsolete UNION_P obsolete UNION_DEF obsolete INTERSECT_P obsolete INTERSECT_DEF obsolete DISJOINT see DISJOINT_DEF DELETE_P obsolete DELETE_DEF obsolete CHOICE obsolete REST see REST_DEF DIFF_P obsolete DIFF_DEF obsolete SUBSET_MEMBER see SUBSET_DEF PSUBSET see PSUBSET_DEF MK_SET_P ********* MK_SET_DEF ********* SING see SING_DEF HAS_CARD obsolete CARD_DEF obsolete INSERT_MULTIPLICITY see INSERT_INSERT INSERT_ASSOC see INSERT_COMM SET_EQ see EXTENSION IN see NOT_IN_EMPTY, IN_INSERT set_induction see FINITE_SET_DEF SET_CASES_THM see SET_CASES SET_DISTINCT see NOT_EMPTY_INSERT NONEMPTY_MEMBER see MEMBER_NOT_EMPTY set_induction_2 see SET_INDUCT MEMBER_DECOMP see DECOMPOSITION UNION see UNION_EMPTY, INSERT_UNION UNION_IDENT see UNION_IDEMPOT UNION_SYM see UNION_COMM INTERSECT see INTER_EMPTY, INSERT_INTER INTERSECT_ASSOC see INTER_ASSOC INTERSECT_IDENT see INTER_IDEMPOT INTERSECT_SYM see INTER_COMM UNION_OVER_INTERSECT see UNION_OVER_INTER INTERSECT_OVER_UNION see INTER_OVER_UNION DISJOINT_MEMBER see IN_DISJOINT DELETE_MEMBER see IN_DELETE DELETE see EMPTY_DELETE, DELETE_INSERT DELETE_DECOMPOSITION see INSERT_DELETE DELETE_ABSORPTION see DELETE_NON_ELEMENT CHOICE_MEMBER see CHOICE_DEF CHOICE_DECOMPOSITION see CHOICE_INSERT_REST CHOICE_NON_MEMBER see CHOICE_NOT_IN_REST DIFF see DIFF_EMPTY, DIFF_INSERT SUBSET see EMPTY_SUBSET, INSERT_SUBSET SUBSET_INTERSECT see INTER_SUBSET SUBSET_DELETE obsolete SUBSET_INTERSECT_ABSORPTION see SUBSET_INTER_ABSORPTION PSUBSET_TRANS see PSUBSET_DEF PSUBSET_REFL see PSUBSET_IRREFL PSUBSET_REST see REST_PSUBSET IN_MK_SET ********** MK_SET ********** MK_SET_TRUE ********** MK_SET_FALSE ********** MK_SET_INTERSECT ********** MK_SET_DELETE ********** MK_SET_DIFF ********** MK_SET_OR ********** MK_SET_AND ********** SING_CHOICE see CHOICE_SING SING_REST see SING_IFF_EMPTY_REST SELECT_0 obsolete DELETE_ABS see DELETE_NON_ELEMENT MEMBER_IMP_NONEMPTY see MEMBER_NOT_EMPTY IN_DEL_IMP see IN_DELETE lemme3 obsolete IN_INSERT see IN_INSERT NOT_IN_SAME_SET obsolete lemme3a obsolete NOT_SYM obsolete DEL_DEL see DELETE_DELETE DISTINCT_SET see NOT_INSERT_EMPTY CARD_EMPTY_lem obsolete CARD_DEL obsolete CARD_DEL_THM obsolete HAS_CARD_INDUCT obsolete UNIQUE_CARD obsolete CARD_EX obsolete CARD_EMPTY see CARD_EMPTY, CARD_DEF EMPTY_0_EQ see CARD_EQ_0 INSERT_CARD obsolete EX_SUC_CARD obsolete CARD_INDUCT_THM obsolete CARD see CARD_DEF CARD_ABSORPTION see CARD_INSERT CARD_INTERSECT see CARD_INTER_LESS_EQ SING_CARD see SING_IFF_CARD1 The old version of finite_sets is contained in the directory OLD, which will eventually be deleted. T. Melham February 1992 hol88-2.02.19940316/Library/finite_sets/finite_sets.ml0000640000212700021270000000566105147526715020536 0ustar cammcamm% ===================================================================== % % FILE : finite_sets.ml % % DESCRIPTION : loads the library "finite_sets" into hol. % % % % AUTHOR : T. Melham % % DATE : 92.02.15 % % ===================================================================== % % --------------------------------------------------------------------- % % Put the pathname to the library finite_sets onto the search path. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/finite_sets/` in tty_write `Updating search path`; set_search_path (union (search_path()) [path]);; % --------------------------------------------------------------------- % % Add the help files to online help. % % --------------------------------------------------------------------- % let path = library_pathname() ^ `/finite_sets/help/entries/` in print_newline(); tty_write `Updating help search path`; set_help_search_path (union [path] (help_search_path()));; % --------------------------------------------------------------------- % % Load (or attempt to load) the theory finite_sets % % --------------------------------------------------------------------- % if draft_mode() then (print_newline(); print_string `Declaring theory finite_sets a new parent`; print_newline(); new_parent `finite_sets`) else (print_newline(); load_theory `finite_sets` ? (tty_write `Defining ML function load_finite_sets`; loadf `load_finite_sets`; print_newline()));; % --------------------------------------------------------------------- % % Activate parser/pretty-printer support for finite_sets (if possible). % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `finite_sets`)) then (define_finite_set_syntax(`EMPTY`,`INSERT`); set_flag(`print_set`,true); ());; % --------------------------------------------------------------------- % % Load compiled code if possible % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `finite_sets`)) then let path st = library_pathname() ^ `/finite_sets/` ^ st in load(path `set_ind`, get_flag_value `print_lib`); load(path `fset_conv`, get_flag_value `print_lib`);; % --------------------------------------------------------------------- % % Set up autoloading of definitions and theorems from finite_sets.th % % --------------------------------------------------------------------- % if (draft_mode() or (current_theory() = `finite_sets`)) then let defs = map fst (definitions `finite_sets`) in map (\name. autoload_theory(`definition`,`finite_sets`,name)) defs; let thms = map fst (theorems `finite_sets`) in map (\name. autoload_theory(`theorem`,`finite_sets`,name)) thms; delete_cache `finite_sets`; ();; hol88-2.02.19940316/Library/finite_sets/load_finite_sets.ml0000640000212700021270000000253705147526715021534 0ustar cammcamm% ===================================================================== % % FILE : load_finite_sets.ml % % DESCRIPTION : creates a function that loads the contents of the % % library "finite_sets" into hol. % % % % AUTHOR : T. Melham % % DATE : 92.02.15 % % ===================================================================== % % --------------------------------------------------------------------- % % define the function load_finite_sets. % % --------------------------------------------------------------------- % let load_finite_sets (v:void) = if (mem `finite_sets` (ancestry())) then (print_string `Loading contents of finite_sets...`; print_newline(); define_finite_set_syntax(`EMPTY`,`INSERT`); set_flag(`print_set`,true); let path st = library_pathname() ^ `/finite_sets/` ^ st in load(path `set_ind`, get_flag_value `print_lib`); load(path `fset_conv`, get_flag_value `print_lib`); let defs = map fst (definitions `finite_sets`) in map (\st. autoload_theory(`definition`,`finite_sets`,st)) defs; let thms = map fst (theorems `finite_sets`) in map (\st. autoload_theory(`theorem`,`finite_sets`,st)) thms; delete_cache `finite_sets`; ()) else failwith `theory finite_sets not an ancestor of the current theory`;; hol88-2.02.19940316/Library/finite_sets/fset_conv.ml0000640000212700021270000002261505147526750020205 0ustar cammcamm% ===================================================================== % % FILE : fset_conv.ml % % DESCRIPTION : Conversions for taking unions and intersections of % % finite sets, for deciding membership of finite sets, % % and so on. % % % % AUTHOR : T Melham % % DATE : 92.02.15 % % ===================================================================== % % ===================================================================== % % IN_CONV: decide membership for finite sets. % % % % A call to: % % % % IN_CONV conv "x IN {x1,...,xn}" % % % % returns: % % % % |- x IN {x1,...,xn} = T % % % % if x is syntactically identical to xi for some i, where 1<=i<=n, or % % if conv proves |- (x=xi)=T for some i, where 1<=i<=n; or it returns: % % % % |- x IN {x1,...,xn} = F % % % % if conv proves |- (x=xi)=F for all 1<=i<=n. % % ===================================================================== % let IN_CONV = let check st = assert (\c. fst(dest_const c) = st) in let inI = theorem `finite_sets` `IN_INSERT` in let inE = GEN "x:*" (EQF_INTRO (SPEC "x:*" th)) where th = theorem `finite_sets` `NOT_IN_EMPTY` in let T = "T" and F = "F" and gv = genvar ":bool" in let DISJ = AP_TERM "\/:bool->bool->bool" in let F_OR = el 3 (CONJUNCTS (SPEC gv OR_CLAUSES)) in let OR_T = el 2 (CONJUNCTS (SPEC gv OR_CLAUSES)) in letrec in_conv conv (eth,ith) x S = (let (_,[y;S']) = (check `INSERT` # I) (strip_comb S) in let thm = SPEC S' (SPEC y ith) in let rectm = rand(rand(concl thm)) in if (aconv x y) then EQT_INTRO (EQ_MP (SYM thm) (DISJ1 (ALPHA x y) rectm)) else (let eql = conv (mk_eq (x, y)) in let res = rand(concl eql) in if (res=T) then EQT_INTRO (EQ_MP (SYM thm) (DISJ1 (EQT_ELIM eql) rectm)) else if (res=F) then let rthm = in_conv conv (eth,ith) x S' in let thm2 = MK_COMB (DISJ eql,rthm) in let thm3 = INST [rand(concl rthm),gv] F_OR in TRANS thm (TRANS thm2 thm3) else fail) ? let rthm = in_conv conv (eth,ith) x S' in if (rand(concl rthm)=T) then let eqn = mk_eq(x,y) in let thm2 = MK_COMB(DISJ (REFL eqn), rthm) in let thm3 = TRANS thm2 (INST [eqn,gv] OR_T) in TRANS thm thm3 else fail) ? (let e = check `EMPTY` S in eth) in \conv tm. (let (_,[x;S]) = (check `IN` # I) (strip_comb tm) in let ith = ISPEC x inI and eth = ISPEC x inE in in_conv conv (eth,ith) x S) ? failwith `IN_CONV`;; % ===================================================================== % % DELETE_CONV: delete an element from a finite set. % % % % A call to: % % % % DELETE_CONV conv "{x1,...,xn} DELETE x" % % % % returns: % % % % |-{x1,...,xn} DELETE x = {xi,...,xk} % % % % where for all xj in {xi,...,xk}, either conv proves |- xj=x or xj is % % syntactically identical to x and for all xj in {x1,...,xn} and NOT in % % {xi,...,xj}, conv proves |- (xj=x)=F. % % ===================================================================== % let DELETE_CONV = let check st = assert (\c. fst(dest_const c) = st) in let bv = genvar ":bool" in let Edel = theorem `finite_sets` `EMPTY_DELETE` in let Dins = GENL ["y:*";"x:*"] (SPECL ["x:*";"y:*"] th) where th = theorem `finite_sets` `DELETE_INSERT` in letrec del_conv conv (eth,ith) x S = (let (_,[y;S']) = (check `INSERT` # I) (strip_comb S) in let thm = SPEC S' (SPEC y ith) in let eql = (aconv x y) => EQT_INTRO (ALPHA y x) | conv (mk_eq(y,x)) in let rthm = del_conv conv (eth,ith) x S' in let v = genvar (type_of S) in let pat = mk_eq(lhs(concl thm),mk_cond(bv,v,mk_comb(rator S,v))) in let thm2 = SUBST [rthm,v;eql,bv] pat thm in TRANS thm2 (COND_CONV (rand(concl thm2)))) ? (let e = check `EMPTY` S in eth) in \conv tm. (let (_,[S;x]) = (check `DELETE` # I) (strip_comb tm) in let ith = ISPEC x Dins and eth = ISPEC x Edel in del_conv conv (eth,ith) x S) ? failwith `DELETE_CONV`;; % ===================================================================== % % UNION_CONV: compute the union of two sets. % % % % A call to: % % % % UNION_CONV conv "{x1,...,xn} UNION S" % % % % returns: % % % % |-{x1,...,xn} UNION S = xi INSERT ... (xk INSERT S) % % % % where for all xj in {x1,...,xn} but NOT in {xi,...,xk}, IN_CONV conv % % proves that |- xj IN S = T % % ===================================================================== % let UNION_CONV = let InU = theorem `finite_sets` `INSERT_UNION` in let InUE = theorem `finite_sets` `INSERT_UNION_EQ` in let Eu = CONJUNCT1 (theorem `finite_sets` `UNION_EMPTY`) in let check st = assert (\c. fst(dest_const c) = st) in letrec strip_set tm = (let [h;t] = snd ((check `INSERT` # I) (strip_comb tm)) in (h .(strip_set t))) ? (fst(dest_const tm) = `EMPTY` => [] | fail) in let mkIN = let boolty = ":bool" in \x s. let ty = type_of x in let sty = mk_type(`set`,[ty]) in let INty = mk_type(`fun`,[ty;mk_type(`fun`,[sty;boolty])]) in mk_comb(mk_comb(mk_const(`IN`,INty),x),s) in let bv = genvar ":bool" in let itfn conv (ith,iith) x th = let _,[S;T] = strip_comb(lhs(concl th)) in (let eql = IN_CONV conv (mkIN x T) in let thm = SPEC T (SPEC S (SPEC x ith)) in let l,ins = (I # (rator o rand)) (dest_eq(concl thm)) in let v = genvar (type_of S) in let pat = mk_eq(l,mk_cond(bv,v,mk_comb(ins,v))) in let thm2 = SUBST [th,v;eql,bv] pat thm in TRANS thm2 (COND_CONV (rand(concl thm2)))) ? let v = genvar (type_of S) in let thm = SPEC T (SPEC S (SPEC x iith)) in let l,r = (I # rator) (dest_eq (concl thm)) in SUBST [th,v] (mk_eq(l,mk_comb(r,v))) thm in \conv tm. (let (_,[S1;S2]) = (check `UNION` # I) (strip_comb tm) in let els = strip_set S1 in let ty = hd(snd(dest_type(type_of S1))) in let ith = INST_TYPE [ty,":*"] InU in let iith = INST_TYPE [ty,":*"] InUE in itlist (itfn conv (ith,iith)) els (ISPEC S2 Eu)) ? failwith `UNION_CONV`;; % ===================================================================== % % INSERT_CONV: non-redundantly insert a value into a set. % % % % A call to: % % % % INSERT_CONV conv "x INSERT S" % % % % returns: % % % % |- x INSERT S = S % % % % if IN_CONV conv proves that |- x IN s = T, otherwise fail. % % % % Note that DEPTH_CONV (INSERT_CONV conv) can be used to remove % % duplicate elements from a set, but the following conversion is % % faster: % % % % letrec REDUCE_CONV conv tm = % % (SUB_CONV (REDUCE_CONV conv) THENC (TRY_CONV (INSERT_CONV conv))) % % tm;; % % ===================================================================== % let INSERT_CONV = let absth = let th = theorem `finite_sets` `ABSORPTION` in let th1 = fst(EQ_IMP_RULE (SPECL ["x:*";"s:(*)set"] th)) in GENL ["x:*";"s:(*)set"] th1 in let check = assert (\c. fst(dest_const c) = `INSERT`) in let mkIN = let boolty = ":bool" in \x s. let ty = type_of x in let sty = mk_type(`set`,[ty]) in let INty = mk_type(`fun`,[ty;mk_type(`fun`,[sty;boolty])]) in mk_comb(mk_comb(mk_const(`IN`,INty),x),s) in let isT = let T = "T" in \thm. rand(concl thm)=T in \conv tm. (let _,[x;s] = (check # I) (strip_comb tm) in let thm = IN_CONV conv (mkIN x s) in if (isT thm) then MP (SPEC s (ISPEC x absth)) (EQT_ELIM thm) else fail) ? failwith `INSERT_CONV`;; % ===================================================================== % % IMAGE_CONV: compute the image of a function on a finite set. % % % % A call to: % % % % IMAGE_CONV conv iconv "IMAGE f {x1,...,xn}" % % % % returns: % % % % |- IMAGE f {x1,...,xn} = {y1,...,yn} % % % % where conv proves |- f xi = yi for all 1<=i<=n. The conversion also % % trys to use INSERT_CONV iconv to simplify insertion of the results % % into the set {y1,...,yn}. % % % % ===================================================================== % let IMAGE_CONV = let Ith = theorem `finite_sets` `IMAGE_INSERT` and Eth = theorem `finite_sets` `IMAGE_EMPTY` in let check st = assert (\c. fst(dest_const c) = st) in letrec iconv IN cnv1 cnv2 ith eth s = (let _,[x;t] = (check `INSERT` # I) (strip_comb s) in let thm1 = SPEC t (SPEC x ith) in let el = rand(rator(rand(concl thm1))) in let cth = MK_COMB(AP_TERM IN (cnv1 el),iconv IN cnv1 cnv2 ith eth t) in let thm2 = TRY_CONV (INSERT_CONV cnv2) (rand(concl cth)) in TRANS thm1 (TRANS cth thm2)) ? (if (fst(dest_const s) = `EMPTY`) then eth else fail) in \conv1 conv2 tm. (let _,[f;s] = (check `IMAGE` # I) (strip_comb tm) in let _,[_;ty] = dest_type(type_of f) in let sty = mk_type(`set`,[ty]) in let INty = mk_type(`fun`, [ty;mk_type(`fun`,[sty;sty])]) in let IN = mk_const(`INSERT`, INty) in iconv IN conv1 conv2 (ISPEC f Ith) (ISPEC f Eth) s) ? failwith `IMAGE_CONV`;; hol88-2.02.19940316/Library/finite_sets/Makefile0000640000212700021270000000367605147526775017342 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: finite_sets # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o @echo "===> library finite_sets: all object code deleted" clobber: rm -f *_ml.o *_ml.l *.th @echo "===> library finite_sets: object code and theory files deleted" # ===================================================================== # Entries for individual files. # ===================================================================== finite_sets.th: mk_finite_sets.ml rm -f finite_sets.th echo 'set_flag(`abort_when_fail`,true);;'\ 'loadt `mk_finite_sets`;;' | ${Hol} set_ind_ml.o: finite_sets.th set_ind.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `finite_sets`;;'\ 'compilet `set_ind`;;'\ 'quit();;' | ${Hol} fset_conv_ml.o: finite_sets.th fset_conv.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'load_theory `finite_sets`;;'\ 'compilet `fset_conv`;;'\ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: finite_sets.th set_ind_ml.o fset_conv_ml.o @echo "===> library finite_sets rebuilt" hol88-2.02.19940316/Library/reduce/0000750000212700021270000000000005533117170014600 5ustar cammcammhol88-2.02.19940316/Library/reduce/Manual/0000750000212700021270000000000005535605642016025 5ustar cammcammhol88-2.02.19940316/Library/reduce/Manual/entries.tex0000640000212700021270000005422405535605616020231 0ustar cammcamm\chapter{ML Functions in the reduce Library} \input{entries-intro} \DOC{ADD\_CONV} \TYPE {\small\verb%ADD_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the sum of two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%ADD_CONV "m + n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- m + n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the sum of the natural numbers denoted by {\small\verb%m%} and {\small\verb%n%}. \FAILURE {\small\verb%ADD_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m + n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #ADD_CONV "75 + 25";; |- 75 + 25 = 100 \end{verbatim} } \ENDDOC \DOC{AND\_CONV} \TYPE {\small\verb%AND_CONV : conv%}\egroup \SYNOPSIS Simplifies certain boolean conjunction expressions. \DESCRIBE If {\small\verb%tm%} corresponds to one of the forms given below, where {\small\verb%t%} is an arbitrary term of type {\small\verb%bool%}, then {\small\verb%AND_CONV tm%} returns the corresponding theorem. Note that in the last case the conjuncts need only be alpha-equivalent rather than strictly identical. {\par\samepage\setseps\small \begin{verbatim} AND_CONV "T /\ t" = |- T /\ t = t AND_CONV "t /\ T" = |- t /\ T = t AND_CONV "F /\ t" = |- F /\ t = F AND_CONV "t /\ F" = |- t /\ F = F AND_CONV "t /\ t" = |- t /\ t = t \end{verbatim} } \FAILURE {\small\verb%AND_CONV tm%} fails unless {\small\verb%tm%} has one of the forms indicated above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #AND_CONV "(x = T) /\ F";; |- (x = T) /\ F = F #AND_CONV "T /\ (x = T)";; |- T /\ (x = T) = (x = T) #AND_CONV "(?x. x=T) /\ (?y. y=T)";; |- (?x. x = T) /\ (?y. y = T) = (?x. x = T) \end{verbatim} } \ENDDOC \DOC{BEQ\_CONV} \TYPE {\small\verb%BEQ_CONV : conv%}\egroup \SYNOPSIS Simplifies certain expressions involving boolean equality. \DESCRIBE If {\small\verb%tm%} corresponds to one of the forms given below, where {\small\verb%t%} is an arbitrary term of type {\small\verb%bool%}, then {\small\verb%BEQ_CONV tm%} returns the corresponding theorem. Note that in the last case the left-hand and right-hand sides need only be alpha-equivalent rather than strictly identical. {\par\samepage\setseps\small \begin{verbatim} BEQ_CONV "T = t" = |- T = t = t BEQ_CONV "t = T" = |- t = T = t BEQ_CONV "F = t" = |- F = t = ~t BEQ_CONV "t = F" = |- t = F = ~t BEQ_CONV "t = t" = |- t = t = T \end{verbatim} } \FAILURE {\small\verb%BEQ_CONV tm%} fails unless {\small\verb%tm%} has one of the forms indicated above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #BEQ_CONV "T = T";; |- (T = T) = T #BEQ_CONV "F = T";; |- (F = T) = F #BEQ_CONV "(!x:*#**. x = (FST x,SND x)) = (!y:*#**. y = (FST y,SND y))";; |- ((!x. x = FST x,SND x) = (!y. y = FST y,SND y)) = T \end{verbatim} } \ENDDOC \DOC{COND\_CONV} \TYPE {\small\verb%COND_CONV : conv%}\egroup \SYNOPSIS Simplifies certain conditional expressions. \DESCRIBE If {\small\verb%tm%} corresponds to one of the forms given below, where {\small\verb%b%} has type {\small\verb%bool%} and {\small\verb%t1%} and {\small\verb%t2%} have the same type, then {\small\verb%COND_CONV tm%} returns the corresponding theorem. Note that in the last case the arms need only be alpha-equivalent rather than strictly identical. {\par\samepage\setseps\small \begin{verbatim} COND_CONV "F => t1 | t2" = |- (T => t1 | t2) = t2 COND_CONV "T => t1 | t2" = |- (T => t1 | t2) = t1 COND_CONV "b => t | t = |- (b => t | t) = t \end{verbatim} } \FAILURE {\small\verb%COND_CONV tm%} fails unless {\small\verb%tm%} has one of the forms indicated above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #COND_CONV "F => F | T";; |- (F => F | T) = T #COND_CONV "T => F | T";; |- (T => F | T) = F #COND_CONV "b => (\x. SUC x) | (\p. SUC p)";; |- (b => (\x. SUC x) | (\p. SUC p)) = (\x. SUC x) \end{verbatim} } \ENDDOC \DOC{DIV\_CONV} \TYPE {\small\verb%DIV_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the result of dividing, with truncation, one numeral by another. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%DIV_CONV "m DIV n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- m DIV n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the result of dividing the natural number denoted by {\small\verb%m%} by the natural number denoted by {\small\verb%n%}, with truncation. \FAILURE {\small\verb%DIV_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m DIV n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals, or if {\small\verb%n%} denotes zero. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #DIV_CONV "0 DIV 0";; evaluation failed DIV_CONV #DIV_CONV "0 DIV 12";; |- 0 DIV 12 = 0 #DIV_CONV "2 DIV 0";; evaluation failed DIV_CONV #DIV_CONV "144 DIV 12";; |- 144 DIV 12 = 12 #DIV_CONV "7 DIV 2";; |- 7 DIV 2 = 3 \end{verbatim} } \ENDDOC \DOC{EXP\_CONV} \TYPE {\small\verb%EXP_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the result of raising one numeral to the power of another. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%EXP_CONV "m EXP n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- m EXP n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the result of raising the natural number denoted by {\small\verb%m%} to the power of the natural number denoted by {\small\verb%n%}. \FAILURE {\small\verb%EXP_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m EXP n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #EXP_CONV "0 EXP 0";; |- 0 EXP 0 = 1 #EXP_CONV "15 EXP 0";; |- 15 EXP 0 = 1 #EXP_CONV "12 EXP 1";; |- 12 EXP 1 = 12 #EXP_CONV "2 EXP 6";; |- 2 EXP 6 = 64 \end{verbatim} } \ENDDOC \DOC{GE\_CONV} \TYPE {\small\verb%GE_CONV : conv%}\egroup \SYNOPSIS Proves result of less-than-or-equal-to ordering on two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are both numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%GE_CONV "m >= n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (m >= n) = T \end{verbatim} } \noindent if the natural number denoted by {\small\verb%m%} is greater than or equal to that denoted by {\small\verb%n%}, or {\par\samepage\setseps\small \begin{verbatim} |- (m >= n) = F \end{verbatim} } \noindent otherwise. \FAILURE {\small\verb%GE_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m >= n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #GE_CONV "15 >= 14";; |- 15 >= 14 = T #GE_CONV "100 >= 100";; |- 100 >= 100 = T #GE_CONV "0 >= 107";; |- 0 >= 107 = F \end{verbatim} } \ENDDOC \DOC{GT\_CONV} \TYPE {\small\verb%GT_CONV : conv%}\egroup \SYNOPSIS Proves result of greater-than ordering on two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are both numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%GT_CONV "m > n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (m > n) = T \end{verbatim} } \noindent if the natural number denoted by {\small\verb%m%} is greater than that denoted by {\small\verb%n%}, or {\par\samepage\setseps\small \begin{verbatim} |- (m > n) = F \end{verbatim} } \noindent otherwise. \FAILURE {\small\verb%GT_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m > n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #GT_CONV "100 > 10";; |- 100 > 10 = T #GT_CONV "15 > 15";; |- 15 > 15 = F #GT_CONV "11 > 27";; |- 11 > 27 = F \end{verbatim} } \ENDDOC \DOC{IMP\_CONV} \TYPE {\small\verb%IMP_CONV : conv%}\egroup \SYNOPSIS Simplifies certain implicational expressions. \DESCRIBE If {\small\verb%tm%} corresponds to one of the forms given below, where {\small\verb%t%} is an arbitrary term of type {\small\verb%bool%}, then {\small\verb%IMP_CONV tm%} returns the corresponding theorem. Note that in the last case the antecedent and consequent need only be alpha-equivalent rather than strictly identical. {\par\samepage\setseps\small \begin{verbatim} IMP_CONV "T ==> t" = |- T ==> t = t IMP_CONV "t ==> T" = |- t ==> T = T IMP_CONV "F ==> t" = |- F ==> t = T IMP_CONV "t ==> F" = |- t ==> F = ~t IMP_CONV "t ==> t" = |- t ==> t = T \end{verbatim} } \FAILURE {\small\verb%IMP_CONV tm%} fails unless {\small\verb%tm%} has one of the forms indicated above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #IMP_CONV "T ==> F";; |- T ==> F = F #IMP_CONV "F ==> x";; |- F ==> x = T #IMP_CONV "(!z:(num)list. z = z) ==> (!x:(num)list. x = x)";; |- (!z. z = z) ==> (!x. x = x) = T \end{verbatim} } \ENDDOC \DOC{LE\_CONV} \TYPE {\small\verb%LE_CONV : conv%}\egroup \SYNOPSIS Proves result of less-than-or-equal-to ordering on two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are both numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%LE_CONV "m <= n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (m <= n) = T \end{verbatim} } \noindent if the natural number denoted by {\small\verb%m%} is less than or equal to that denoted by {\small\verb%n%}, or {\par\samepage\setseps\small \begin{verbatim} |- (m <= n) = F \end{verbatim} } \noindent otherwise. \FAILURE {\small\verb%LE_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m <= n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #LE_CONV "12 <= 198";; |- 12 <= 198 = T #LE_CONV "46 <= 46";; |- 46 <= 46 = T #LE_CONV "13 <= 12";; |- 13 <= 12 = F \end{verbatim} } \ENDDOC \DOC{LT\_CONV} \TYPE {\small\verb%LT_CONV : conv%}\egroup \SYNOPSIS Proves result of less-than ordering on two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are both numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%LT_CONV "m < n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (m < n) = T \end{verbatim} } \noindent if the natural number denoted by {\small\verb%m%} is less than that denoted by {\small\verb%n%}, or {\par\samepage\setseps\small \begin{verbatim} |- (m < n) = F \end{verbatim} } \noindent otherwise. \FAILURE {\small\verb%LT_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m < n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #LT_CONV "0 < 12";; |- 0 < 12 = T #LT_CONV "13 < 13";; |- 13 < 13 = F #LT_CONV "25 < 12";; |- 25 < 12 = F \end{verbatim} } \ENDDOC \DOC{MOD\_CONV} \TYPE {\small\verb%MOD_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the remainder after dividing one numeral by another. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%MOD_CONV "m MOD n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- m MOD n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the remainder after dividing, with truncation, the natural number denoted by {\small\verb%m%} by the natural number denoted by {\small\verb%n%}. \FAILURE {\small\verb%MOD_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m MOD n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals, or if {\small\verb%n%} denotes zero. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #MOD_CONV "0 MOD 0";; evaluation failed MOD_CONV #MOD_CONV "0 MOD 12";; |- 0 MOD 12 = 0 #MOD_CONV "2 MOD 0";; evaluation failed MOD_CONV #MOD_CONV "144 MOD 12";; |- 144 MOD 12 = 0 #MOD_CONV "7 MOD 2";; |- 7 MOD 2 = 1 \end{verbatim} } \ENDDOC \DOC{MUL\_CONV} \TYPE {\small\verb%MUL_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the product of two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%MUL_CONV "m * n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- m * n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the product of the natural numbers denoted by {\small\verb%m%} and {\small\verb%n%}. \FAILURE {\small\verb%MUL_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m * n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #MUL_CONV "0 * 12";; |- 0 * 12 = 0 #MUL_CONV "1 * 1";; |- 1 * 1 = 1 #MUL_CONV "6 * 11";; |- 6 * 11 = 66 \end{verbatim} } \ENDDOC \DOC{NEQ\_CONV} \TYPE {\small\verb%NEQ_CONV : conv%}\egroup \SYNOPSIS Proves equality or inequality of two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are both numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%NEQ_CONV "m = n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- (m = n) = T \end{verbatim} } \noindent if {\small\verb%m%} and {\small\verb%n%} are identical, or {\par\samepage\setseps\small \begin{verbatim} |- (m = n) = F \end{verbatim} } \noindent if {\small\verb%m%} and {\small\verb%n%} are distinct. \FAILURE {\small\verb%NEQ_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m = n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #NEQ_CONV "12 = 12";; |- (12 = 12) = T #NEQ_CONV "14 = 25";; |- (14 = 25) = F \end{verbatim} } \ENDDOC \DOC{NOT\_CONV} \TYPE {\small\verb%NOT_CONV : conv%}\egroup \SYNOPSIS Simplifies certain boolean negation expressions. \DESCRIBE If {\small\verb%tm%} corresponds to one of the forms given below, where {\small\verb%t%} is an arbitrary term of type {\small\verb%bool%}, then {\small\verb%NOT_CONV tm%} returns the corresponding theorem. {\par\samepage\setseps\small \begin{verbatim} NOT_CONV "~F" = |- ~F = T NOT_CONV "~T" = |- ~T = F NOT_CONV "~~t" = |- ~~t = t \end{verbatim} } \FAILURE {\small\verb%NOT_CONV tm%} fails unless {\small\verb%tm%} has one of the forms indicated above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #NOT_CONV "~~~~T";; |- ~~~~T = ~~T #NOT_CONV "~~T";; |- ~~T = T #NOT_CONV "~T";; |- ~T = F \end{verbatim} } \ENDDOC \DOC{OR\_CONV} \TYPE {\small\verb%OR_CONV : conv%}\egroup \SYNOPSIS Simplifies certain boolean disjunction expressions. \DESCRIBE If {\small\verb%tm%} corresponds to one of the forms given below, where {\small\verb%t%} is an arbitrary term of type {\small\verb%bool%}, then {\small\verb%OR_CONV tm%} returns the corresponding theorem. Note that in the last case the disjuncts need only be alpha-equivalent rather than strictly identical. {\par\samepage\setseps\small \begin{verbatim} OR_CONV "T \/ t" = |- T \/ t = T OR_CONV "t \/ T" = |- t \/ T = T OR_CONV "F \/ t" = |- F \/ t = t OR_CONV "t \/ F" = |- t \/ F = t OR_CONV "t \/ t" = |- t \/ t = t \end{verbatim} } \FAILURE {\small\verb%OR_CONV tm%} fails unless {\small\verb%tm%} has one of the forms indicated above. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #OR_CONV "F \/ T";; |- F \/ T = T #OR_CONV "X \/ F";; |- X \/ F = X #OR_CONV "(!n. n + 1 = SUC n) \/ (!m. m + 1 = SUC m)";; |- (!n. n + 1 = SUC n) \/ (!m. m + 1 = SUC m) = (!n. n + 1 = SUC n) \end{verbatim} } \ENDDOC \DOC{PRE\_CONV} \TYPE {\small\verb%PRE_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the predecessor of a numeral. \DESCRIBE If {\small\verb%n%} is a numeral (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%PRE_CONV "PRE n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- PRE n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the predecessor of the natural number denoted by {\small\verb%n%}. \FAILURE {\small\verb%PRE_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"PRE n"%}, where {\small\verb%n%} is a numeral. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #PRE_CONV "PRE 0";; |- PRE 0 = 0 #PRE_CONV "PRE 1";; |- PRE 1 = 0 #PRE_CONV "PRE 22";; |- PRE 22 = 21 \end{verbatim} } \ENDDOC \DOC{REDUCE\_CONV} \TYPE {\small\verb%REDUCE_CONV : conv%}\egroup \SYNOPSIS Performs arithmetic or boolean reduction at all levels possible. \DESCRIBE The conversion {\small\verb%REDUCE_CONV%} attempts to apply, in bottom-up order to all suitable redexes, one of the following conversions from the {\small\verb%reduce%} library (only one can succeed): {\par\samepage\setseps\small \begin{verbatim} ADD_CONV AND_CONV BEQ_CONV COND_CONV DIV_CONV EXP_CONV GE_CONV GT_CONV IMP_CONV LE_CONV LT_CONV MOD_CONV MUL_CONV NEQ_CONV NOT_CONV OR_CONV PRE_CONV SBC_CONV SUC_CONV \end{verbatim} } \noindent In particular, it will prove the appropriate reduction for an arbitrarily complicated expression constructed from numerals and the boolean constants {\small\verb%T%} and {\small\verb%F%}. \FAILURE Never fails, but may give a reflexive equation. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #REDUCE_CONV "(2=3) = F";; |- ((2 = 3) = F) = T #REDUCE_CONV "(100 < 200) => (2 EXP (8 DIV 2)) | (3 EXP ((26 EXP 0) * 3))";; |- (100 < 200 => 2 EXP (8 DIV 2) | 3 EXP ((26 EXP 0) * 3)) = 16 #REDUCE_CONV "(15 = 16) \/ (15 < 16)";; |- (15 = 16) \/ 15 < 16 = T #REDUCE_CONV "0 + x";; |- 0 + x = 0 + x \end{verbatim} } \SEEALSO RED_CONV, REDUCE_RULE, REDUCE_TAC \ENDDOC \DOC{REDUCE\_RULE} \TYPE {\small\verb%REDUCE_RULE : (thm -> thm)%}\egroup \SYNOPSIS Performs arithmetic or boolean reduction on a theorem at all levels possible. \DESCRIBE {\small\verb%REDUCE_RULE%} attempts to transform a theorem by applying {\small\verb%REDUCE_CONV%}. \FAILURE Never fails, but may just return the original theorem. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #REDUCE_RULE (ASSUME "x = (100 + (60 - 17))");; . |- x = 143 #REDUCE_RULE (REFL "100 + 12 DIV 6");; |- T \end{verbatim} } \SEEALSO RED_CONV, REDUCE_CONV, REDUCE_TAC \ENDDOC \DOC{REDUCE\_TAC} \TYPE {\small\verb%REDUCE_TAC : tactic%}\egroup \SYNOPSIS Performs arithmetic or boolean reduction on a goal at all levels possible. \DESCRIBE {\small\verb%REDUCE_TAC%} attempts to transform a goal by applying {\small\verb%REDUCE_CONV%}. It will prove any true goal which is constructed from numerals and the boolean constants {\small\verb%T%} and {\small\verb%F%}. \FAILURE Never fails, but may not advance the goal. \EXAMPLE The following example takes a couple of minutes' CPU time: {\par\samepage\setseps\small \begin{verbatim} #g "((1 EXP 3) + (12 EXP 3) = 1729) /\ ((9 EXP 3) + (10 EXP 3) = 1729)";; "((1 EXP 3) + (12 EXP 3) = 1729) /\ ((9 EXP 3) + (10 EXP 3) = 1729)" () : void #e REDUCE_TAC;; OK.. goal proved |- ((1 EXP 3) + (12 EXP 3) = 1729) /\ ((9 EXP 3) + (10 EXP 3) = 1729) Previous subproof: goal proved () : void \end{verbatim} } \SEEALSO RED_CONV, REDUCE_CONV, REDUCE_RULE \ENDDOC \DOC{RED\_CONV} \TYPE {\small\verb%RED_CONV : conv%}\egroup \SYNOPSIS Performs arithmetic or boolean reduction at top level if possible. \DESCRIBE The conversion {\small\verb%RED_CONV%} attempts to apply, at the top level only, one of the following conversions from the {\small\verb%reduce%} library (only one can succeed): {\par\samepage\setseps\small \begin{verbatim} ADD_CONV AND_CONV BEQ_CONV COND_CONV DIV_CONV EXP_CONV GE_CONV GT_CONV IMP_CONV LE_CONV LT_CONV MOD_CONV MUL_CONV NEQ_CONV NOT_CONV OR_CONV PRE_CONV SBC_CONV SUC_CONV \end{verbatim} } \FAILURE Fails if none of the above conversions are applicable at top level. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #RED_CONV "(2=3) = F";; |- ((2 = 3) = F) = ~(2 = 3) #RED_CONV "15 DIV 13";; |- 15 DIV 13 = 1 #RED_CONV "100 + 100";; |- 100 + 100 = 200 #RED_CONV "0 + x";; evaluation failed RED_CONV \end{verbatim} } \SEEALSO REDUCE_CONV, REDUCE_RULE, REDUCE_TAC \ENDDOC \DOC{SBC\_CONV} \TYPE {\small\verb%SBC_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the difference of two numerals. \DESCRIBE If {\small\verb%m%} and {\small\verb%n%} are numerals (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%SBC_CONV "m - n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- m - n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the difference of the natural numbers denoted by {\small\verb%m%} and {\small\verb%n%}. \FAILURE {\small\verb%SBC_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"m - n"%}, where {\small\verb%m%} and {\small\verb%n%} are numerals. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #SBC_CONV "25 - 30";; |- 25 - 30 = 0 #SBC_CONV "200 - 200";; |- 200 - 200 = 0 #SBC_CONV "60 - 17";; |- 60 - 17 = 43 \end{verbatim} } \ENDDOC \DOC{SUC\_CONV} \TYPE {\small\verb%SUC_CONV : conv%}\egroup \SYNOPSIS Calculates by inference the successor of a numeral. \DESCRIBE If {\small\verb%n%} is a numeral (e.g. {\small\verb%0%}, {\small\verb%1%}, {\small\verb%2%}, {\small\verb%3%},...), then {\small\verb%SUC_CONV "SUC n"%} returns the theorem: {\par\samepage\setseps\small \begin{verbatim} |- SUC n = s \end{verbatim} } \noindent where {\small\verb%s%} is the numeral that denotes the successor of the natural number denoted by {\small\verb%n%}. \FAILURE {\small\verb%SUC_CONV tm%} fails unless {\small\verb%tm%} is of the form {\small\verb%"SUC n"%}, where {\small\verb%n%} is a numeral. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #SUC_CONV "SUC 33";; |- SUC 33 = 34 \end{verbatim} } \ENDDOC hol88-2.02.19940316/Library/reduce/Manual/reduce.log0000640000212700021270000000774305535605662020015 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:21 **reduce.tex (reduce.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file reduce.idx (reduce.aux (title.aux) (description.aux) (entries.aux) (index.aux)) (title.tex [1 ] [2]) (reduce.toc) \tf@toc=\write4 [3 ] [4 ] (description.tex Chapter 1. [1 ] [2]) [3] (entries.tex [4 ] Chapter 2. (entries-intro.tex) [5] [6] [7] Underfull \vbox (badness 4108) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 3.45099 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [8] [9] [10] Underfull \vbox (badness 1789) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.61905 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [11] Underfull \vbox (badness 1983) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.7074 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [12] Underfull \vbox (badness 1259) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.32814 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [13] Underfull \vbox (badness 1789) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.61905 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [14] Underfull \vbox (badness 4108) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 3.45099 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [15] [16] Underfull \vbox (badness 1231) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.31165 .\glue(\topskip) 2.00002 .\hbox(9.99998+2.79999)x455.24408, glue set 392.3845fil ..\frtnbf E ..\frtnbf x ..\frtnbf a ..\frtnbf m ..\frtnbf p ..etc. .\penalty 10000 .\glue(\parskip) 0.0 plus 1.0 .\penalty 10000 .etc. [17] [18] [19] [20] [21] [22] [23]) [24] (index.tex [25 ]) (reduce.aux (title.aux) (description.aux) (entries.aux) (index.aux)) ) Here is how much of TeX's memory you used: 422 strings out of 11977 3515 string characters out of 87025 36701 words of memory out of 262141 2282 multiletter control sequences out of 9500 19472 words of font info for 74 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 17i,10n,17p,180b,460s stack positions out of 300i,100n,60p,3000b,4000s Output written on reduce.dvi (29 pages, 35000 bytes). hol88-2.02.19940316/Library/reduce/Manual/reduce.idx0000640000212700021270000000176605535605662020017 0ustar cammcamm\indexentry{ADD\_CONV@{\ptt ADD\_CONV}}{5} \indexentry{AND\_CONV@{\ptt AND\_CONV}}{5} \indexentry{BEQ\_CONV@{\ptt BEQ\_CONV}}{6} \indexentry{COND\_CONV@{\ptt COND\_CONV}}{7} \indexentry{DIV\_CONV@{\ptt DIV\_CONV}}{8} \indexentry{EXP\_CONV@{\ptt EXP\_CONV}}{9} \indexentry{GE\_CONV@{\ptt GE\_CONV}}{10} \indexentry{GT\_CONV@{\ptt GT\_CONV}}{11} \indexentry{IMP\_CONV@{\ptt IMP\_CONV}}{12} \indexentry{LE\_CONV@{\ptt LE\_CONV}}{13} \indexentry{LT\_CONV@{\ptt LT\_CONV}}{14} \indexentry{MOD\_CONV@{\ptt MOD\_CONV}}{15} \indexentry{MUL\_CONV@{\ptt MUL\_CONV}}{16} \indexentry{NEQ\_CONV@{\ptt NEQ\_CONV}}{17} \indexentry{NOT\_CONV@{\ptt NOT\_CONV}}{18} \indexentry{OR\_CONV@{\ptt OR\_CONV}}{18} \indexentry{PRE\_CONV@{\ptt PRE\_CONV}}{19} \indexentry{REDUCE\_CONV@{\ptt REDUCE\_CONV}}{20} \indexentry{REDUCE\_RULE@{\ptt REDUCE\_RULE}}{21} \indexentry{REDUCE\_TAC@{\ptt REDUCE\_TAC}}{22} \indexentry{RED\_CONV@{\ptt RED\_CONV}}{22} \indexentry{SBC\_CONV@{\ptt SBC\_CONV}}{23} \indexentry{SUC\_CONV@{\ptt SUC\_CONV}}{24} hol88-2.02.19940316/Library/reduce/Manual/reduce.aux0000640000212700021270000000013405535605662020014 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{index.aux} hol88-2.02.19940316/Library/reduce/Manual/title.aux0000640000212700021270000000077305535605647017702 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/reduce/Manual/description.tex0000640000212700021270000001131405104511472021060 0ustar cammcamm\chapter{The reduce Library} This manual describes the use of the \ml{reduce} library, as well as discussing its design. The library is intended to ease the burden of performing tedious and intellectually trivial tasks of arithmetic such as proving: \begin{hol}\begin{verbatim} |- 2 EXP 6 = 64 \end{verbatim}\end{hol} \noindent Anyone trying to prove the above by hand will testify to its extreme tediousness. However, using the \ml{reduce} library, the evaluation of: \begin{hol}\begin{verbatim} REDUCE_CONV "2 EXP 6" \end{verbatim}\end{hol} \noindent will perform the above automatically, and probably in far fewer primitive inferences than a human would take. The library will also take care of certain boolean expressions. This is mainly for the sake of completeness, since the same effect can be achieved by careful use of rewriting. \section{The representation of numbers} The approach to representing natural number constants in \HOL\ is to provide a conversion \ml{num\_CONV} which generates the definition of any nonzero numeral in terms of its predecessor, for example: \begin{hol}\begin{verbatim} #num_CONV "1";; |- 1 = SUC 0 #num_CONV "256";; |- 256 = SUC 255 \end{verbatim}\end{hol} \noindent This conversion uses \ml{mk\_thm}, so could be regarded as unsatisfactory; however it is arguably no worse than expanding a constant defined through the normal constant definition mechanism. The \ml{reduce} library uses only the above conversion, together with certain definitions and preproved theorems concerning the various arithmetic and boolean operators, to derive, strictly by inference, reduction theorems for certain expressions. \section{Sample algorithm} The following is an example of an algorithm for reducing addition expressions. In fact, for reasons of efficiency, the library's \ml{ADD\_CONV} conversion is implemented in a slightly more sophisticated way, but this example gives the general flavour of how the various arithmetic conversions are defined. Suppose we want to apply the conversion to \ml{"m + n"} where \ml{m} and \ml{n} are both numerals. Then \begin{itemize} \item If the first numeral is zero, we need only specialize the first conjunct of the inbuilt definition \ml{ADD}: {\small\begin{verbatim} SPEC "n" (CONJUNCT1 ADD) \end{verbatim}} \item If the first numeral is not zero, then we call the conversion recursively to give: {\small\begin{verbatim} |- p + n = s \end{verbatim}} where \ml{p} is the predecessor of \ml{m}, and \ml{s} the corresponding sum. Now we can apply the following inferences: {\small\begin{verbatim} |- p + n = s % [1] From recursive call % |- (SUC p) + n = SUC(p + n) % [2] Instance of 2nd conjunct of ADD % |- (SUC p) + n = SUC s % [3] Substituting [1] in [2] % |- SUC p = m % [4] SYM (num_CONV m) % |- SUC s = t % [5] SYM (num_CONV (s+1)) % |- m + n = t % [6] Substituting [4] and [5] in [6] % \end{verbatim}} This gives the desired result. The above can easily be converted into a simple recursive procedure. \end{itemize} \section{Using the library} The straightforward way to use the library is simply to do: \begin{hol}\begin{verbatim} load_library `reduce`;; \end{verbatim}\end{hol} \noindent This will work only if the \HOL\/ being used has been installed correctly; if this is not the case the user should refer to the \TUTORIAL\/ or the \DESCRIPTION. The library provides the following three ML bindings, which should be all that is needed for most purposes: \begin{itemize} \item \ml{REDUCE\_CONV} is a conversion which, when given an expression, will return a theorem expressing its equivalence with a reduced version, which in many cases will be simply a single numeral or boolean literal. For example: {\small\begin{verbatim} #REDUCE_CONV "(50 < 51) => (2 * 25) | (60 - 17)";; |- (50 < 51 => 2 * 25 | 60 - 17) = 50 #REDUCE_CONV "(3 * x) + (1 + 2)";; |- (3 * x) + (1 + 2) = (3 * x) + 3 #REDUCE_CONV "(1 < 2) /\ (2 <= 2)";; |- 1 < 2 /\ 2 <= 2 = T \end{verbatim}} \item \ml{REDUCE\_RULE} is a rule which applies the reductions corresponding to \ml{REDUCE\_CONV} to subterms of the theorem's conclusion \item \ml{REDUCE\_TAC} performs the same reductions on a goal. \end{itemize} \noindent For more sophisticated use, there are conversions specific to each operator, for example \ml{ADD\_CONV} and \ml{OR\_CONV}. For more details of these, refer to the next chapter. The arithmetic conversions and boolean conversions may be loaded separately by loading (with \ml{loadt} for instance) \ml{arithconv.ml} and \ml{boolconv.ml} respectively, in the main library directory. hol88-2.02.19940316/Library/reduce/Manual/reduce.dvi0000640000212700021270000010427005535605662020007 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1021‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘Y¼óHò"VáG cmbx10ëHThe– ‰‹HOL“reduce“LibraryŽŸI­Û’¿fvó7ò"Vff cmbx10âJ.‘…R.‘ 8HarrisonŽ ‡&‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’Ø•¼June‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’—´¯ž£hó+X«Q cmr12ÖcŽŽŽ’”Qó-!",š cmsy10Ø ŽŽŽŽ’¤;ÈÖJ.–ê¨R.“Harrison“1991ŽŽŽŒ‹ΠÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFLÛ1Ž‘ŸôThe–€reduce“Library’;é31ŽŽ¤‘ŸôÖ1.1Ž‘,¦JThe–ê¨represenš¬rtation“of“n˜um˜bSŽers‘`ä‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ߎŒ‹  ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸkžëHThe– ‰‹reduce“LibraryŽŸÖx‰Ç>|Ÿ:yÖÖThis–Ø{manš¬rual“describSŽes“the“use“of“the“ó(ßêþÓ#num_CONV‘¿ª"1";;Ž¤ ‘>þ|-–¿ª1“=“SUC“0ŽŸ‘>þ#num_CONV‘¿ª"256";;Ž¡‘>þ|-–¿ª256“=“SUC“255ŽŽŽŽŽŽŽŸ6zÖThis›î'con•¬rv“ersion˜uses˜Ómk_thmŽ‘%l#Ö,‘ ¨so˜could˜bSŽe˜regarded˜as˜unsatisfactory;‘BRho“w“ev“er˜it˜is˜arguablyŽ¡no–")wš¬rorse“than“expanding“a“constan˜t“de ned“through“the“normal“constan˜t“de nition“mec˜h-Ž¡anism.ŽŸ$‚‘ aThe‘uÓreduceŽ‘(°æÖlibrary–uuses“only“the“abSŽo•¬rv“e›ucon“v“ersion,‘CLtogether˜with˜certain˜de nitions˜andŽ¡prepro•¬rv“ed–VLtheorems“concerning“the“v‘ÿXäarious“arithmetic“and“b•SŽo“olean›VLop“erators,‘q5to˜deriv¬re,Ž¡strictly–ê¨b¬ry“inference,“reduction“theorems“for“certain“expressions.ŽŽŸ$ý’óŸÛ1ŽŽŒ‹ ÌU ýFÓŸú™š‘êñëÛ2’LµChapter–€1.‘ The“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.2Ž‘5oSample‘Ÿ¼algorithmŽŸâ#‘êñëÖThe–†¹follo¬rwing“is“an“example“of“an“algorithm“for“reducing“addition“expressions.‘ In“fact,Ž¤‘êñëfor–¸reasons“of“eciency‘ÿV,‘_=the“library's“ÓADD_CONVŽ‘8&ÀÖcon•¬rv“ersion–¸is“implemenš¬rted“in“a“sligh˜tlyŽ¡‘êñëmore–lsophisticated“w•¬ra“y‘ÿV,‘k]but–lthis“example“givš¬res“the“general“ a˜v˜our“of“ho˜w“the“v‘ÿXäariousŽ¡‘êñëarithmetic›Ðcon•¬rv“ersions˜are˜de ned.‘{YSuppSŽose˜w“e˜w“an“t˜to˜apply˜the˜con“v“ersion˜to˜Ó"m–¿ª+“n"ŽŽ¡‘êñëÖwhere‘ê¨ÓmŽ– ”úÖand‘ê¨ÓnŽ“Öare–ê¨bSŽoth“n¬rumerals.‘8àThenŽŸòë‘üqÚØŽŽŽ‘Q×ÖIf–the“ rst“nš¬rumeral“is“zero,‘¸w˜e“need“only“spSŽecialize“the“ rst“conjunct“of“the“in˜builtŽ¡‘Q×de nition‘ê¨ÓADDŽ‘)¦Ö:Ž¤Jâ‘PÓSPEC–¿ª"n"“(CONJUNCT1“ADD)Ž© ™šŸ±H‘üqÚØŽŽŽ‘Q×ÖIf–ê¨the“ rst“nš¬rumeral“is“not“zero,“then“w˜e“call“the“con˜v˜ersion“recursiv˜ely“to“giv˜e:Ž¡‘PÓ|-–¿ªp“+“n“=“sŽ¦Ÿ±H‘Q×Öwhere‘€µÓpŽ›ÁÖis–€µthe“predecessor“of“ÓmŽ‘ @_Ö,‘¦8and“ÓsŽ˜Öthe“correspSŽonding“sum.‘ûNoš¬rw“w˜e“can“applyŽŸ‘Q×the–ê¨follo¬rwing“inferences:Ž¡‘PÓ|-–¿ªp“+“n“=“s‘[ú %“[1]“From“recursive“call‘J»¢%Ž¦‘P|-–¿ª(SUC“p)“+“n“=“SUC(p“+“n)“%“[2]“Instance“of“2nd“conjunct“of“ADD“%Ž¦‘P|-–¿ª(SUC“p)“+“n“=“SUC“s‘"}ü%“[3]“Substituting“[1]“in“[2]‘3¼ú%Ž¦‘P|-–¿ªSUC“p“=“m›[ú %“[4]“SYM“(num_CONV“m)˜%Ž¦‘P|-–¿ªSUC“s“=“t‘[ú %“[5]“SYM“(num_CONV“(s+1))‘Dûø%Ž¦‘P|-–¿ªm“+“n“=“t‘[ú %“[6]“Substituting“[4]“and“[5]“in“[6]“%Ž¦Ÿ±H‘Q×ÖThis–¦givš¬res“the“desired“result.‘ k&The“abSŽo˜v˜e“can“easily“bSŽe“con˜v˜erted“in˜to“a“simpleŽ©‘Q×recursiv¬re‘ê¨proSŽcedure.ŽŸ'Ñ„‘êñëç1.3Ž‘5oUsing–Ÿ¼the“libraryŽŸâ#‘êñëÖThe›ê¨straigh•¬rtforw“ard˜w“a“y˜to˜use˜the˜library˜is˜simply˜to˜do:Ž¤ò럎4Ÿý‘‘0éÓload_library‘¿ª`reduce`;;ŽŽŽŽŽŽŽ¡‘êñëÖThis–*Œwill“w¬rork“only“if“the“ÍHOL‘*{ÖbšSŽeing“used“has“b˜een“installed“correctly;‘J~if“this“is“not“theŽ¦‘êñëcase–ê¨the“user“should“refer“to“the“óp®0J cmsl10ÈTUTORIAL“Öor“the“ÈDESCRIPTIONÖ.Ž¦‘öSzThe–ürlibrary“proš¬rvides“the“follo˜wing“three“ML‘ü5bindings,‘,whic˜h“should“bSŽe“all“that“is“neededŽ¦‘êñëfor–ê¨most“purpSŽoses:ŽŽŽŒ‹Ï ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €Using–€the“library’;«F3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘$GPØŽŽŽ‘0'MÓREDUCE_CONVŽ‘ròÖis–Žäa“con•¬rv“ersion›Žäwhic“h,‘¡>when˜giv“en˜an˜expression,‘¡>will˜return˜a˜theoremŽ¤‘0'Mexpressing–áªits“equiv‘ÿXäalence“with“a“reduced“v•¬rersion,‘©whic“h–áªin“man¬ry“cases“will“bSŽe“simplyŽ¡‘0'Ma–ê¨single“n¬rumeral“or“b•SŽo“olean–ê¨literal.‘8àF‘ÿVor“example:ŽŸ™š‘G%õÓ#REDUCE_CONV–¿ª"(50“<“51)“=>“(2“*“25)“|“(60“-“17)";;Ž¤ ™š‘G%õ|-–¿ª(50“<“51“=>“2“*“25“|“60“-“17)“=“50Ž©34‘G%õ#REDUCE_CONV–¿ª"(3“*“x)“+“(1“+“2)";;Ž¡‘G%õ|-–¿ª(3“*“x)“+“(1“+“2)“=“(3“*“x)“+“3Ž¦‘G%õ#REDUCE_CONV–¿ª"(1“<“2)“/\“(2“<=“2)";;Ž¡‘G%õ|-–¿ª1“<“2“/\“2“<=“2“=“TŽ¡Ÿ"‘$GPØŽŽŽ‘0'MÓREDUCE_RULEŽ‘r÷Öis–“ka“rule“whic¬rh“applies“the“reductions“correspSŽonding“to“ÓREDUCE_CONVŽ‘Fc$ÖtoŽ¤‘0'Msubterms–ê¨of“the“theorem's“conclusionŽŸ‘$GPØŽŽŽ‘0'MÓREDUCE_TACŽ‘mŽ™ÖpSŽerforms–ê¨the“same“reductions“on“a“goal.ŽŸ‘ÇaF‘ÿVor–wÆmore“sophisticated“use,‘› there“are“con•¬rv“ersions–wÆspšSŽeci c“to“eac¬rh“op˜erator,‘› for“exampleŽ¡‘ÇaÓADD_CONVŽ‘C®¾Öand‘ê ÓOR_CONVŽ‘+'³Ö.›ãWF‘ÿVor–ê more“details“of“these,‘_refer“to“the“next“c¬rhapter.˜The“arithmeticŽ¡‘Çacon•¬rv“ersions–€eand“b•SŽo“olean›€econ•¬rv“ersions˜ma“y˜bSŽe˜loaded˜separately˜b“y˜loading˜(with˜ÓloadtŽ‘#¿ÖforŽ¡‘Çainstance)‘ê¨Óarithconv.mlŽ‘LÑHÖand‘ê¨Óboolconv.mlŽ‘GžÖrespSŽectiv¬rely›ÿV,–ê¨in“the“main“library“directory˜.ŽŽŽŒ‹¸ ÌU ýFÓŸú™š‘êñëÛ4’̵Chapter–€1.‘ €The“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹™ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|ŸGëHML– ‰‹F‘ýunctions“in“the“reduce“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–úcš¬rhapter“pro˜vides“doSŽcumen˜tation“on“all“the“ÍML“Öfunctions“that“are“made“a˜v‘ÿXäailable“inŽ¤ÍHOL–O}Öwhen“the“ÓreduceŽ‘+öÖlibrary“is“loaded.‘g^This“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“online“viaŽ¡the‘ê¨ÓhelpŽ‘ÓøÖfacilit¬ry‘ÿV.ŽŸ$¤¯Ÿ¹IŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍóIßêþÓ|-–¿ªm“+“n“=“sŽŸº‰Öwhere–ºRÓs“Öis“the“nš¬rumeral“that“denotes“the“sum“of“the“natural“n˜um˜bSŽers“denoted“b˜y“Óm“Öand“ÓnÖ.Ž¦âF‘þž¸ailureŽ¡ÓADD_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜+˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.Ž¦âExampleŽŸT#Ó#ADD_CONV–¿ª"75“+“25";;ŽŸ ™š|-–¿ª75“+“25“=“100ŽŸ3ÁŸ¹IŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIAND_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ.T~ÓAND_CONV–¿ª:“convŽŽŸ$ý’óŸÛ5ŽŽŒ‹# ÌU ýFÓŸú™š‘êñëÛ6’¡UðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâSynopsisŽ¤dV‘êñëÖSimpli es–ê¨certain“b•SŽo“olean–ê¨conjunction“expressions.Ž©‘W‘êñëâDescriptionŽ¡‘êñëÖIf–nMÓtm“ÖcorrespšSŽonds“to“one“of“the“forms“giv¬ren“b˜eloš¬rw,‘6where“Ót“Öis“an“arbitrary“term“of“t˜ypSŽeŽ¤‘êñëÓboolÖ,‘{{then–_°ÓAND_CONV‘¿ªtm“Öreturns“the“correspSŽonding“theorem.‘ Note“that“in“the“last“case“theŽ¡‘êñëconjuncts–ê¨need“only“bSŽe“alpha-equiv‘ÿXäalenš¬rt“rather“than“strictly“iden˜tical.ŽŸ*ò‘ü0éÓAND_CONV–¿ª"T“/\“t"“=“|-“T“/\“t“=“tŽ¤ ™š‘ü0éAND_CONV–¿ª"t“/\“T"“=“|-“t“/\“T“=“tŽ¡‘ü0éAND_CONV–¿ª"F“/\“t"“=“|-“F“/\“t“=“FŽ¡‘ü0éAND_CONV–¿ª"t“/\“F"“=“|-“t“/\“F“=“FŽ¡‘ü0éAND_CONV–¿ª"t“/\“t"“=“|-“t“/\“t“=“tŽŸ*Z‘êñëâF‘þž¸ailureŽŸdV‘êñëÓAND_CONV‘¿ªtm–ê¨Öfails“unless“Ótm“Öhas“one“of“the“forms“indicated“abSŽo•¬rv“e.Ž¦‘êñëâExampleŽŸH‘êñëÓ#AND_CONV–¿ª"(x“=“T)“/\“F";;Ž¡‘êñë|-–¿ª(x“=“T)“/\“F“=“FŽ©34‘êñë#AND_CONV–¿ª"T“/\“(x“=“T)";;Ž¡‘êñë|-–¿ªT“/\“(x“=“T)“=“(x“=“T)Ž¦‘êñë#AND_CONV–¿ª"(?x.“x=T)“/\“(?y.“y=T)";;Ž¡‘êñë|-–¿ª(?x.“x“=“T)“/\“(?y.“y“=“T)“=“(?x.“x“=“T)ŽŸ:|²Ÿ-p‘êñëŸé8ö‰ffÇBXŸÇ ÌÍŸÇ „'ŽffŸñ•‘ÌÍëIBEQ_CONVŽŽ’ÆÛò„'ŽffŽŽŸ-o‰ffÇBXŽŽŽŸ2œÙ‘êñëÓBEQ_CONV–¿ª:“convŽ¤‘W‘êñëâSynopsisŽ©dV‘êñëÖSimpli es–ê¨certain“expressions“in•¬rv“olving›ê¨b•SŽo“olean˜equalit¬ry‘ÿV.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–nMÓtm“ÖcorrespšSŽonds“to“one“of“the“forms“giv¬ren“b˜eloš¬rw,‘6where“Ót“Öis“an“arbitrary“term“of“t˜ypSŽeŽŸ‘êñëÓboolÖ,‘{{then–_°ÓBEQ_CONV‘¿ªtm“Öreturns“the“correspSŽonding“theorem.‘ Note“that“in“the“last“case“theŽŽŽŒ‹$ ÌU ýFÓŸú™š‘ÇaÒCOND‘Ái‰ffÇŽ‘ˆ„CONV’o÷Û7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖleft-hand–½and“righš¬rt-hand“sides“need“only“bSŽe“alpha-equiv‘ÿXäalen˜t“rather“than“strictly“iden˜tical.Ž©;Œ‘$_ÓBEQ_CONV–¿ª"T“=“t"“=“|-“T“=“t“=“tŽ¤ ™š‘$_BEQ_CONV–¿ª"t“=“T"“=“|-“t“=“T“=“tŽ¡‘$_BEQ_CONV–¿ª"F“=“t"“=“|-“F“=“t“=“~tŽ¡‘$_BEQ_CONV–¿ª"t“=“F"“=“|-“t“=“F“=“~tŽ¡‘$_BEQ_CONV–¿ª"t“=“t"“=“|-“t“=“t“=“TŽŸ&åבÇaâF‘þž¸ailureŽŸ‘ÇaÓBEQ_CONV‘¿ªtm–ê¨Öfails“unless“Ótm“Öhas“one“of“the“forms“indicated“abSŽo•¬rv“e.ŽŸCå‘ÇaâExampleŽ¦‘ÇaÓ#BEQ_CONV–¿ª"T“=“T";;Ž¡‘Ça|-–¿ª(T“=“T)“=“TŽ©34‘Ça#BEQ_CONV–¿ª"F“=“T";;Ž¡‘Ça|-–¿ª(F“=“T)“=“FŽ¦‘Ça#BEQ_CONV–¿ª"(!x:*#**.“x“=“(FST“x,SND“x))“=“(!y:*#**.“y“=“(FST“y,SND“y))";;Ž¡‘Ça|-–¿ª((!x.“x“=“FST“x,SND“x)“=“(!y.“y“=“FST“y,SND“y))“=“TŽŸ2m Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëICOND_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ-ò"‘ÇaÓCOND_CONV–¿ª:“convŽ¤Cå‘ÇaâSynopsisŽ©‘ÇaÖSimpli es–ê¨certain“conditional“expressions.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–"ØÓtm“ÖcorrespšSŽonds“to“one“of“the“forms“giv¬ren“b˜eloš¬rw,‘0äwhere“Ób“Öhas“t˜ypSŽe“Óbool“Öand“Ót1“Öand“Ót2Ž¦‘ÇaÖha•¬rv“e–Óthe“same“t¬rypšSŽe,‘×Íthen“ÓCOND_CONV‘¿ªtm“Öreturns“the“corresp˜onding“theorem.‘1Note“that“inŽ¦‘Çathe–ê¨last“case“the“arms“need“only“bSŽe“alpha-equiv‘ÿXäalenš¬rt“rather“than“strictly“iden˜tical.ŽŸ;Œ‘$_ÓCOND_CONV–¿ª"F“=>“t1“|“t2"“=“|-“(T“=>“t1“|“t2)“=“t2Ž¤ ™š‘$_COND_CONV–¿ª"T“=>“t1“|“t2"“=“|-“(T“=>“t1“|“t2)“=“t1Ž¡‘$_COND_CONV–¿ª"b“=>“t“|“t‘þ¨=“|-“(b“=>“t“|“t)“=“tŽŸ&åבÇaâF‘þž¸ailureŽ¦‘ÇaÓCOND_CONV‘¿ªtm–ê¨Öfails“unless“Ótm“Öhas“one“of“the“forms“indicated“abSŽo•¬rv“e.ŽŽŽŒ‹*¢ ÌU ýFÓŸú™š‘êñëÛ8’¡UðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ*Úß‘êñëÓ#COND_CONV–¿ª"F“=>“F“|“T";;Ž¤ ™š‘êñë|-–¿ª(F“=>“F“|“T)“=“TŽ©34‘êñë#COND_CONV–¿ª"T“=>“F“|“T";;Ž¡‘êñë|-–¿ª(T“=>“F“|“T)“=“FŽ¦‘êñë#COND_CONV–¿ª"b“=>“(\x.“SUC“x)“|“(\p.“SUC“p)";;Ž¡‘êñë|-–¿ª(b“=>“(\x.“SUC“x)“|“(\p.“SUC“p))“=“(\x.“SUC“x)ŽŸeP^Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIDIV_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸG’‡‘êñëÓDIV_CONV–¿ª:“convŽ¤)ÍÒ‘êñëâSynopsisŽ©st‘êñëÖCalculates–ê¨bš¬ry“inference“the“result“of“dividing,“with“truncation,“one“n˜umeral“b˜y“another.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–Œ4Óm“Öand“Ón“Öare“n¬rumerals“(e.g.‘dÓ0Ö,–ŸÓ1Ö,“Ó2Ö,“Ó3Ö,...),“then›Œ4ÓDIV_CONV–¿ª"m“DIV“n"˜Öreturns˜the˜theorem:ŽŸ'gk‘ü0éÓ|-–¿ªm“DIV“n“=“sŽŸ&Z]‘êñëÖwhere–~ŒÓs“Öis“the“nš¬rumeral“that“denotes“the“result“of“dividing“the“natural“n˜um˜bSŽer“denoted“b˜yŽŸ‘êñëÓm–ê¨Öbš¬ry“the“natural“n˜um˜bSŽer“denoted“b˜y“ÓnÖ,“with“truncation.Ž¡‘êñëâF‘þž¸ailureŽ¦‘êñëÓDIV_CONV›¿ªtm–Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜DIV˜n"Ö,›^where“Óm“Öand“Ón“Öare“n¬rumerals,˜or“if“ÓnŽŸ‘êñëÖdenotes‘ê¨zero.ŽŽŽŒ‹ 1] ÌU ýFÓŸú™š‘ÇaÒEXP‘Ái‰ffÇŽ‘ˆ„CONV’{¡FÛ9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ$‰‘ÇaÓ#DIV_CONV–¿ª"0“DIV“0";;Ž¤ ™š‘Çaevaluation‘¿ªfailed‘¾RDIV_CONVŽ©34‘Ça#DIV_CONV–¿ª"0“DIV“12";;Ž¡‘Ça|-–¿ª0“DIV“12“=“0Ž¦‘Ça#DIV_CONV–¿ª"2“DIV“0";;Ž¡‘Çaevaluation‘¿ªfailed‘¾RDIV_CONVŽ¦‘Ça#DIV_CONV–¿ª"144“DIV“12";;Ž¡‘Ça|-–¿ª144“DIV“12“=“12Ž¦‘Ça#DIV_CONV–¿ª"7“DIV“2";;Ž¡‘Ça|-–¿ª7“DIV“2“=“3ŽŸR.:Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIEXP_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ>v‘ÇaÓEXP_CONV–¿ª:“convŽ¤$VZ‘ÇaâSynopsisŽ©–‘ÇaÖCalculates–ê¨bš¬ry“inference“the“result“of“raising“one“n˜umeral“to“the“pSŽo˜w˜er“of“another.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–Œ4Óm“Öand“Ón“Öare“n¬rumerals“(e.g.‘dÓ0Ö,–ŸÓ1Ö,“Ó2Ö,“Ó3Ö,...),“then›Œ4ÓEXP_CONV–¿ª"m“EXP“n"˜Öreturns˜the˜theorem:ŽŸ!ïó‘$_Ó|-–¿ªm“EXP“n“=“sŽŸ"@ÑÇaÖwhere–ýÓs“Öis“the“nš¬rumeral“that“denotes“the“result“of“raising“the“natural“n˜um˜bSŽer“denoted“b˜yŽŸ‘ÇaÓm–ê¨Öto“the“pšSŽo•¬rw“er–ê¨of“the“natural“n•¬rum“b˜er–ê¨denoted“b¬ry“ÓnÖ.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÓEXP_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜EXP˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹ 6' ÌU ýFÓŸú™š‘êñëÛ10’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ!ˆ‘êñëÓ#EXP_CONV–¿ª"0“EXP“0";;Ž¤ ™š‘êñë|-–¿ª0“EXP“0“=“1Ž©34‘êñë#EXP_CONV–¿ª"15“EXP“0";;Ž¡‘êñë|-–¿ª15“EXP“0“=“1Ž¦‘êñë#EXP_CONV–¿ª"12“EXP“1";;Ž¡‘êñë|-–¿ª12“EXP“1“=“12Ž¦‘êñë#EXP_CONV–¿ª"2“EXP“6";;Ž¡‘êñë|-–¿ª2“EXP“6“=“64ŽŸK5aŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIGE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ:… ‘êñëÓGE_CONV–¿ª:“convŽ¤"Xe‘êñëâSynopsisŽ©–‘êñëÖPro•¬rv“es–ê¨result“of“less-than-or-equal-to“ordering“on“t•¬rw“o‘ê¨n“umerals.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–tâÓm“Öand“Ón“Öare“bSŽoth“n¬rumerals“(e.g.‘ ×Ó0Ö,–×qÓ1Ö,“Ó2Ö,“Ó3Ö,...),“then›tâÓGE_CONV–¿ª"m“>=“n"˜Öreturns˜theŽŸ‘êñëtheorem:Ž¤ñÿ‘ü0éÓ|-–¿ª(m“>=“n)“=“TŽ© ÂK‘êñëÖif–ê¨the“natural“n•¬rum“bSŽer–ê¨denoted“bš¬ry“Óm“Öis“greater“than“or“equal“to“that“denoted“b˜y“ÓnÖ,“orŽ¡‘ü0éÓ|-–¿ª(m“>=“n)“=“FŽ¦‘êñëÖotherwise.ŽŸ"Xe‘êñëâF‘þž¸ailureŽŸ–‘êñëÓGE_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜>=˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹ :û ÌU ýFÓŸú™š‘ÇaÒGT‘Ái‰ffÇŽ‘ˆ„CONV’|ž÷Û11Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ&±ü‘ÇaÓ#GE_CONV–¿ª"15“>=“14";;Ž¤ ™š‘Ça|-–¿ª15“>=“14“=“TŽ©34‘Ça#GE_CONV–¿ª"100“>=“100";;Ž¡‘Ça|-–¿ª100“>=“100“=“TŽ¦‘Ça#GE_CONV–¿ª"0“>=“107";;Ž¡‘Ça|-–¿ª0“>=“107“=“FŽŸYª¬Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIGT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸA¿¯‘ÇaÓGT_CONV–¿ª:“convŽ¤&yè‘ÇaâSynopsisŽ©žz‘ÇaÖPro•¬rv“es–ê¨result“of“greater-than“ordering“on“t•¬rw“o‘ê¨n“umerals.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–ÙÎÓm“Öand“Ón“Öare“bSŽoth“n¬rumerals“(e.g.‘ÝíÓ0Ö,–`Ó1Ö,“Ó2Ö,“Ó3Ö,...),“then›ÙÎÓGT_CONV–¿ª"m“>“n"˜Öreturns˜the˜theorem:Ž¤$‚‘$_Ó|-–¿ª(m“>“n)“=“TŽ©#Ûn‘ÇaÖif–ê¨the“natural“n•¬rum“bSŽer–ê¨denoted“bš¬ry“Óm“Öis“greater“than“that“denoted“b˜y“ÓnÖ,“orŽ¡‘$_Ó|-–¿ª(m“>“n)“=“FŽ¦‘ÇaÖotherwise.ŽŸ&yè‘ÇaâF‘þž¸ailureŽŸžz‘ÇaÓGT_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜>˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹ ?o ÌU ýFÓŸú™š‘êñëÛ12’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ'#‘êñëÓ#GT_CONV–¿ª"100“>“10";;Ž¤ ™š‘êñë|-–¿ª100“>“10“=“TŽ©34‘êñë#GT_CONV–¿ª"15“>“15";;Ž¡‘êñë|-–¿ª15“>“15“=“FŽ¦‘êñë#GT_CONV–¿ª"11“>“27";;Ž¡‘êñë|-–¿ª11“>“27“=“FŽŸZçPŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIIMP_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸB^‘êñëÓIMP_CONV–¿ª:“convŽ¤&Ô`‘êñëâSynopsisŽ©µ‘êñëÖSimpli es–ê¨certain“implicational“expressions.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–nMÓtm“ÖcorrespšSŽonds“to“one“of“the“forms“giv¬ren“b˜eloš¬rw,‘6where“Ót“Öis“an“arbitrary“term“of“t˜ypSŽeŽ¤‘êñëÓboolÖ,‘{{then–_°ÓIMP_CONV‘¿ªtm“Öreturns“the“correspSŽonding“theorem.‘ Note“that“in“the“last“case“theŽ¡‘êñëan•¬rteceden“t–ê¨and“consequenš¬rt“need“only“bSŽe“alpha-equiv‘ÿXäalen˜t“rather“than“strictly“iden˜tical.ŽŸ$mú‘ü0éÓIMP_CONV–¿ª"T“==>“t"“=“|-“T“==>“t“=“tŽ¤ ™š‘ü0éIMP_CONV–¿ª"t“==>“T"“=“|-“t“==>“T“=“TŽ¡‘ü0éIMP_CONV–¿ª"F“==>“t"“=“|-“F“==>“t“=“TŽ¡‘ü0éIMP_CONV–¿ª"t“==>“F"“=“|-“t“==>“F“=“~tŽ¡‘ü0éIMP_CONV–¿ª"t“==>“t"“=“|-“t“==>“t“=“TŽŸ8>‘êñëâF‘þž¸ailureŽ¦‘êñëÓIMP_CONV‘¿ªtm–ê¨Öfails“unless“Ótm“Öhas“one“of“the“forms“indicated“abSŽo•¬rv“e.ŽŽŽŒ‹ Cn ÌU ýFÓŸú™š‘ÇaÒLE‘Ái‰ffÇŽ‘ˆ„CONV’o;Û13Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ%=Ÿ‘ÇaÓ#IMP_CONV–¿ª"T“==>“F";;Ž¤ ™š‘Ça|-–¿ªT“==>“F“=“FŽ©34‘Ça#IMP_CONV–¿ª"F“==>“x";;Ž¡‘Ça|-–¿ªF“==>“x“=“TŽ¦‘Ça#IMP_CONV–¿ª"(!z:(num)list.“z“=“z)“==>“(!x:(num)list.“x“=“x)";;Ž¡‘Ça|-–¿ª(!z.“z“=“z)“==>“(!x.“x“=“x)“=“TŽŸU˜Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëILE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ?¶`‘ÇaÓLE_CONV–¿ª:“convŽ¤%P‘ÇaâSynopsisŽ©T‘ÇaÖPro•¬rv“es–ê¨result“of“less-than-or-equal-to“ordering“on“t•¬rw“o‘ê¨n“umerals.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–tâÓm“Öand“Ón“Öare“bSŽoth“n¬rumerals“(e.g.‘ ×Ó0Ö,–×qÓ1Ö,“Ó2Ö,“Ó3Ö,...),“then›tâÓLE_CONV–¿ª"m“<=“n"˜Öreturns˜theŽŸ‘Çatheorem:Ž¤"éž‘$_Ó|-–¿ª(m“<=“n)“=“TŽ©"ü‘ÇaÖif–ê¨the“natural“n•¬rum“bSŽer–ê¨denoted“bš¬ry“Óm“Öis“less“than“or“equal“to“that“denoted“b˜y“ÓnÖ,“orŽ¡‘$_Ó|-–¿ª(m“<=“n)“=“FŽ¦‘ÇaÖotherwise.ŽŸ%P‘ÇaâF‘þž¸ailureŽŸT‘ÇaÓLE_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜<=˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹Hj ÌU ýFÓŸú™š‘êñëÛ14’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ&±ü‘êñëÓ#LE_CONV–¿ª"12“<=“198";;Ž¤ ™š‘êñë|-–¿ª12“<=“198“=“TŽ©34‘êñë#LE_CONV–¿ª"46“<=“46";;Ž¡‘êñë|-–¿ª46“<=“46“=“TŽ¦‘êñë#LE_CONV–¿ª"13“<=“12";;Ž¡‘êñë|-–¿ª13“<=“12“=“FŽŸYª¬Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëILT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸA¿¯‘êñëÓLT_CONV–¿ª:“convŽ¤&yè‘êñëâSynopsisŽ©žz‘êñëÖPro•¬rv“es–ê¨result“of“less-than“ordering“on“t•¬rw“o‘ê¨n“umerals.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–ÙÎÓm“Öand“Ón“Öare“bSŽoth“n¬rumerals“(e.g.‘ÝíÓ0Ö,–`Ó1Ö,“Ó2Ö,“Ó3Ö,...),“then›ÙÎÓLT_CONV–¿ª"m“<“n"˜Öreturns˜the˜theorem:Ž¤$‚‘ü0éÓ|-–¿ª(m“<“n)“=“TŽ©#Ûn‘êñëÖif–ê¨the“natural“n•¬rum“bSŽer–ê¨denoted“bš¬ry“Óm“Öis“less“than“that“denoted“b˜y“ÓnÖ,“orŽ¡‘ü0éÓ|-–¿ª(m“<“n)“=“FŽ¦‘êñëÖotherwise.ŽŸ&yè‘êñëâF‘þž¸ailureŽŸžz‘êñëÓLT_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜<˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹L½ ÌU ýFÓŸú™š‘ÇaÒMOD‘Ái‰ffÇŽ‘ˆ„CONV’p6Û15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ*Úß‘ÇaÓ#LT_CONV–¿ª"0“<“12";;Ž¤ ™š‘Ça|-–¿ª0“<“12“=“TŽ©34‘Ça#LT_CONV–¿ª"13“<“13";;Ž¡‘Ça|-–¿ª13“<“13“=“FŽ¦‘Ça#LT_CONV–¿ª"25“<“12";;Ž¡‘Ça|-–¿ª25“<“12“=“FŽŸeP^Ÿ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIMOD_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸG’‡‘ÇaÓMOD_CONV–¿ª:“convŽ¤)ÍÒ‘ÇaâSynopsisŽ©st‘ÇaÖCalculates–ê¨bš¬ry“inference“the“remainder“after“dividing“one“n˜umeral“b˜y“another.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–Œ4Óm“Öand“Ón“Öare“n¬rumerals“(e.g.‘dÓ0Ö,–ŸÓ1Ö,“Ó2Ö,“Ó3Ö,...),“then›Œ4ÓMOD_CONV–¿ª"m“MOD“n"˜Öreturns˜the˜theorem:ŽŸ'gk‘$_Ó|-–¿ªm“MOD“n“=“sŽŸ&Z]‘ÇaÖwhere–¯lÓs“Öis“the“n¬rumeral“that“denotes“the“remainder“after“dividing,›àwith“truncation,˜theŽŸ‘Çanatural›ê¨n•¬rum“bSŽer˜denoted˜b“y˜Óm˜Öb“y˜the˜natural˜n“um“bSŽer˜denoted˜b“y˜ÓnÖ.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÓMOD_CONV›¿ªtm–Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜MOD˜n"Ö,›^where“Óm“Öand“Ón“Öare“n¬rumerals,˜or“if“ÓnŽŸ‘ÇaÖdenotes‘ê¨zero.ŽŽŽŒ‹PÑ ÌU ýFÓŸú™š‘êñëÛ16’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸ$‰‘êñëÓ#MOD_CONV–¿ª"0“MOD“0";;Ž¤ ™š‘êñëevaluation‘¿ªfailed‘¾RMOD_CONVŽ©34‘êñë#MOD_CONV–¿ª"0“MOD“12";;Ž¡‘êñë|-–¿ª0“MOD“12“=“0Ž¦‘êñë#MOD_CONV–¿ª"2“MOD“0";;Ž¡‘êñëevaluation‘¿ªfailed‘¾RMOD_CONVŽ¦‘êñë#MOD_CONV–¿ª"144“MOD“12";;Ž¡‘êñë|-–¿ª144“MOD“12“=“0Ž¦‘êñë#MOD_CONV–¿ª"7“MOD“2";;Ž¡‘êñë|-–¿ª7“MOD“2“=“1ŽŸR.:Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIMUL_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ>v‘êñëÓMUL_CONV–¿ª:“convŽ¤$VZ‘êñëâSynopsisŽ©–‘êñëÖCalculates–ê¨bš¬ry“inference“the“proSŽduct“of“t˜w˜o“n˜umerals.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–ê¨Óm“Öand“Ón“Öare“n¬rumerals“(e.g.‘8àÓ0Ö,“Ó1Ö,“Ó2Ö,“Ó3Ö,...),“then“ÓMUL_CONV–¿ª"m“*“n"–ê¨Öreturns“the“theorem:ŽŸ!ïó‘ü0éÓ|-–¿ªm“*“n“=“sŽŸ"@ÑêñëÖwhere–SÓs“Öis“the“nš¬rumeral“that“denotes“the“proSŽduct“of“the“natural“n˜um˜bSŽers“denoted“b˜y“Óm“ÖandŽŸ‘êñëÓnÖ.Ž¡‘êñëâF‘þž¸ailureŽ¦‘êñëÓMUL_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜*˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹U, ÌU ýFÓŸú™š‘ÇaÒNEQ‘Ái‰ffÇŽ‘ˆ„CONV’s±˜Û17Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸ%(‘ÇaÓ#MUL_CONV–¿ª"0“*“12";;Ž¤ ™š‘Ça|-–¿ª0“*“12“=“0Ž©34‘Ça#MUL_CONV–¿ª"1“*“1";;Ž¡‘Ça|-–¿ª1“*“1“=“1Ž¦‘Ça#MUL_CONV–¿ª"6“*“11";;Ž¡‘Ça|-–¿ª6“*“11“=“66ŽŸU\íŸ-p‘ÇaŸé8ö‰ffÇBXŸÇ ÌÍŸÇ „'ŽffŸñ•‘ÌÍëINEQ_CONVŽŽ’ÆÛò„'ŽffŽŽŸ-o‰ffÇBXŽŽŽŸ@ ÷‘ÇaÓNEQ_CONV–¿ª:“convŽ¤%?‘ÇaâSynopsisŽ©OÈ‘ÇaÖPro•¬rv“es›ê¨equalit“y˜or˜inequalit“y˜of˜t“w“o˜n“umerals.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–tâÓm“Öand“Ón“Öare“bSŽoth“n¬rumerals“(e.g.‘ ×Ó0Ö,–×qÓ1Ö,“Ó2Ö,“Ó3Ö,...),“then›tâÓNEQ_CONV–¿ª"m“=“n"˜Öreturns˜theŽŸ‘Çatheorem:Ž¤"ع‘$_Ó|-–¿ª(m“=“n)“=“TŽ©"ïX‘ÇaÖif–ê¨Óm“Öand“Ón“Öare“iden¬rtical,“orŽ¡‘$_Ó|-–¿ª(m“=“n)“=“FŽ¦‘ÇaÖif–ê¨Óm“Öand“Ón“Öare“distinct.ŽŸ%?‘ÇaâF‘þž¸ailureŽŸOÈ‘ÇaÓNEQ_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜=˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.ŽŽŽŒ‹Y° ÌU ýFÓŸú™š‘êñëÛ18’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâExampleŽŸÉ‘êñëÓ#NEQ_CONV–¿ª"12“=“12";;Ž¤ ™š‘êñë|-–¿ª(12“=“12)“=“TŽŸ34‘êñë#NEQ_CONV–¿ª"14“=“25";;Ž¡‘êñë|-–¿ª(14“=“25)“=“FŽŸ(LŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëINOT_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ((X‘êñëÓNOT_CONV–¿ª:“convŽ¤_‘êñëâSynopsisŽ©‘êñëÖSimpli es–ê¨certain“b•SŽo“olean–ê¨negation“expressions.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–nMÓtm“ÖcorrespšSŽonds“to“one“of“the“forms“giv¬ren“b˜eloš¬rw,‘6where“Ót“Öis“an“arbitrary“term“of“t˜ypSŽeŽ¦‘êñëÓboolÖ,–ê¨then“ÓNOT_CONV‘¿ªtm“Öreturns“the“correspSŽonding“theorem.ŽŸÉ‘ü0éÓNOT_CONV–¿ª"~F"› T=“|-˜~F“=“TŽ¤ ™š‘ü0éNOT_CONV–¿ª"~T"› T=“|-˜~T“=“FŽ¡‘ü0éNOT_CONV–¿ª"~~t"“=“|-“~~t“=“tŽŸ"Ž€‘êñëâF‘þž¸ailureŽ¦‘êñëÓNOT_CONV‘¿ªtm–ê¨Öfails“unless“Ótm“Öhas“one“of“the“forms“indicated“abSŽo•¬rv“e.ŽŸ_‘êñëâExampleŽŸÉ‘êñëÓ#NOT_CONV‘¿ª"~~~~T";;Ž¡‘êñë|-–¿ª~~~~T“=“~~TŽ©34‘êñë#NOT_CONV‘¿ª"~~T";;Ž¡‘êñë|-–¿ª~~T“=“TŽ¦‘êñë#NOT_CONV‘¿ª"~T";;Ž¡‘êñë|-–¿ª~T“=“FŽŸ(LŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIOR_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ((X‘êñëÓOR_CONV–¿ª:“convŽŽŽŒ‹] ÌU ýFÓŸú™š‘ÇaÒPRE‘Ái‰ffÇŽ‘ˆ„CONV’tô½Û19Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâSynopsisŽ¤‘ÇaÖSimpli es–ê¨certain“b•SŽo“olean–ê¨disjunction“expressions.Ž©å_‘ÇaâDescriptionŽ¡‘ÇaÖIf–nMÓtm“ÖcorrespšSŽonds“to“one“of“the“forms“giv¬ren“b˜eloš¬rw,‘6where“Ót“Öis“an“arbitrary“term“of“t˜ypSŽeŽ¡‘ÇaÓboolÖ,‘Ü„then–ØûÓOR_CONV‘¿ªtm“Öreturns“the“correspSŽonding“theorem.‘2üNote“that“in“the“last“case“theŽ¡‘Çadisjuncts–ê¨need“only“bSŽe“alpha-equiv‘ÿXäalenš¬rt“rather“than“strictly“iden˜tical.ŽŸ I‘$_ÓOR_CONV–¿ª"T“\/“t"“=“|-“T“\/“t“=“TŽ¤ ™š‘$_OR_CONV–¿ª"t“\/“T"“=“|-“t“\/“T“=“TŽ¡‘$_OR_CONV–¿ª"F“\/“t"“=“|-“F“\/“t“=“tŽ¡‘$_OR_CONV–¿ª"t“\/“F"“=“|-“t“\/“F“=“tŽ¡‘$_OR_CONV–¿ª"t“\/“t"“=“|-“t“\/“t“=“tŽŸ&X‘ÇaâF‘þž¸ailureŽŸ‘ÇaÓOR_CONV‘¿ªtm–ê¨Öfails“unless“Ótm“Öhas“one“of“the“forms“indicated“abSŽo•¬rv“e.Ž¦‘ÇaâExampleŽŸ I‘ÇaÓ#OR_CONV–¿ª"F“\/“T";;Ž¡‘Ça|-–¿ªF“\/“T“=“TŽ©34‘Ça#OR_CONV–¿ª"X“\/“F";;Ž¡‘Ça|-–¿ªX“\/“F“=“XŽ¦‘Ça#OR_CONV–¿ª"(!n.“n“+“1“=“SUC“n)“\/“(!m.“m“+“1“=“SUC“m)";;Ž¡‘Ça|-–¿ª(!n.“n“+“1“=“SUC“n)“\/“(!m.“m“+“1“=“SUC“m)“=“(!n.“n“+“1“=“SUC“n)ŽŸ1"ÌŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIPRE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ-5‘ÇaÓPRE_CONV–¿ª:“convŽ¤å_‘ÇaâSynopsisŽ©‘ÇaÖCalculates–ê¨bš¬ry“inference“the“predecessor“of“a“n˜umeral.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÖIf–ê¨Ón“Öis“a“n¬rumeral“(e.g.‘8àÓ0Ö,“Ó1Ö,“Ó2Ö,“Ó3Ö,...),“then“ÓPRE_CONV–¿ª"PRE“n"–ê¨Öreturns“the“theorem:ŽŸ I‘$_Ó|-–¿ªPRE“n“=“sŽŸr¯‘ÇaÖwhere–±¸Ós“Öis“the“nš¬rumeral“that“denotes“the“predecessor“of“the“natural“n˜um˜bSŽer“denoted“b˜y“ÓnÖ.ŽŽŽŒ‹bx ÌU ýFÓŸú™š‘êñëÛ20’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâF‘þž¸ailureŽŸDÒ‘êñëÓPRE_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"PRE˜n"Ö,“where“Ón“Öis“a“n¬rumeral.ŽŸ!G‘êñëâExampleŽŸñ³‘êñëÓ#PRE_CONV–¿ª"PRE“0";;Ž¤ ™š‘êñë|-–¿ªPRE“0“=“0Ž©34‘êñë#PRE_CONV–¿ª"PRE“1";;Ž¡‘êñë|-–¿ªPRE“1“=“0Ž¦‘êñë#PRE_CONV–¿ª"PRE“22";;Ž¡‘êñë|-–¿ªPRE“22“=“21ŽŸFÃxŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIREDUCE_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ8L‘êñëÓREDUCE_CONV–¿ª:“convŽ¤!G‘êñëâSynopsisŽ©DÒ‘êñëÖPš¬rerforms–ê¨arithmetic“or“b•SŽo“olean–ê¨reduction“at“all“lev˜els“pSŽossible.Ž¡‘êñëâDescriptionŽ¦‘êñëÖThe›con•¬rv“ersion˜ÓREDUCE_CONV‘ÊÖattempts˜to˜apply‘ÿV,‘<‰in˜bSŽottom-up˜order˜to˜all˜suitable˜redexes,Ž©‘êñëone–ê¨of“the“folloš¬rwing“con˜v˜ersions“from“the“Óreduce“Ölibrary“(only“one“can“succeed):ŽŸ¬á‘ü0éÓADD_CONV– TAND_CONV“BEQ_CONV“COND_CONVŽ¤ ™š‘ü0éDIV_CONV‘ TEXP_CONV‘>þGE_CONV‘þ¨GT_CONVŽ¡‘ü0éIMP_CONV–>þLE_CONV“LT_CONV“MOD_CONVŽ¡‘ü0éMUL_CONV– TNEQ_CONV“NOT_CONV‘þ¨OR_CONVŽ¡‘ü0éPRE_CONV– TSBC_CONV“SUC_CONVŽŸÎu‘êñëÖIn–íparticular,‘ùïit“will“pro•¬rv“e–íthe“appropriate“reduction“for“an“arbitrarily“complicated“ex-Ž¦‘êñëpression–ê¨constructed“from“nš¬rumerals“and“the“b•SŽo“olean–ê¨constan˜ts“ÓT“Öand“ÓFÖ.ŽŸ!G‘êñëâF‘þž¸ailureŽŸDÒ‘êñëÖNevš¬rer–ê¨fails,“but“ma˜y“giv˜e“a“re exiv˜e“equation.ŽŽŽŒ‹hü ÌU ýFÓŸú™š‘ÇaÒREDUCE‘Ái‰ffÇŽ‘ˆ„R¦tULE’\&ÂÛ21Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâExampleŽŸf‘ÇaÓ#REDUCE_CONV–¿ª"(2=3)“=“F";;Ž¤ ™š‘Ça|-–¿ª((2“=“3)“=“F)“=“TŽ©34‘Ça#REDUCE_CONV–¿ª"(100“<“200)“=>“(2“EXP“(8“DIV“2))“|“(3“EXP“((26“EXP“0)“*“3))";;Ž¡‘Ça|-–¿ª(100“<“200“=>“2“EXP“(8“DIV“2)“|“3“EXP“((26“EXP“0)“*“3))“=“16Ž¦‘Ça#REDUCE_CONV–¿ª"(15“=“16)“\/“(15“<“16)";;Ž¡‘Ça|-–¿ª(15“=“16)“\/“15“<“16“=“TŽ¦‘Ça#REDUCE_CONV–¿ª"0“+“x";;Ž¡‘Ça|-–¿ª0“+“x“=“0“+“xŽŸ(œó‘ÇaâSee‘…alsoŽŸ ³Ã‘ÇaÓRED_CONV,–¿ªREDUCE_RULE,“REDUCE_TACŽŸ*9矹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIREDUCE_RULEŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ1 ‘ÇaÓREDUCE_RULE–¿ª:“(thm“->“thm)Ž¤h¢‘ÇaâSynopsisŽ©)‘ÇaÖPš¬rerforms–ê¨arithmetic“or“b•SŽo“olean–ê¨reduction“on“a“theorem“at“all“lev˜els“pSŽossible.Ž¡‘ÇaâDescriptionŽ¦‘ÇaÓREDUCE_RULE–ê¨Öattempts“to“transform“a“theorem“b¬ry“applying“ÓREDUCE_CONVÖ.Ž¡‘ÇaâF‘þž¸ailureŽ¦‘ÇaÖNevš¬rer–ê¨fails,“but“ma˜y“just“return“the“original“theorem.Ž¡‘ÇaâExampleŽŸf‘ÇaÓ#REDUCE_RULE–¿ª(ASSUME“"x“=“(100“+“(60“-“17))");;Ž¤ ™š‘Ça.–¿ª|-“x“=“143ŽŸ34‘Ça#REDUCE_RULE–¿ª(REFL“"100“+“12“DIV“6");;Ž¡‘Ça|-‘¿ªTŽŸ(œó‘ÇaâSee‘…alsoŽŸ ³Ã‘ÇaÓRED_CONV,–¿ªREDUCE_CONV,“REDUCE_TACŽŽŽŒ‹nàÌU ýFÓŸú™š‘êñëÛ22’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIREDUCE_TACŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0´¸‘êñëÓREDUCE_TAC–¿ª:“tacticŽ¤¼É‘êñëâSynopsisŽ©/2‘êñëÖPš¬rerforms–ê¨arithmetic“or“b•SŽo“olean–ê¨reduction“on“a“goal“at“all“lev˜els“pSŽossible.Ž¡‘êñëâDescriptionŽ¦‘êñëÓREDUCE_TAC‘­ÎÖattempts–­Ýto“transform“a“goal“bš¬ry“applying“ÓREDUCE_CONVÖ.“It“will“pro˜v˜e“an˜y“trueŽŸ‘êñëgoal–ê¨whicš¬rh“is“constructed“from“n˜umerals“and“the“b•SŽo“olean–ê¨constan˜ts“ÓT“Öand“ÓFÖ.Ž¡‘êñëâF‘þž¸ailureŽ¦‘êñëÖNevš¬rer–ê¨fails,“but“ma˜y“not“adv‘ÿXäance“the“goal.Ž¡‘êñëâExampleŽ¦‘êñëÖThe–ê¨folloš¬rwing“example“tak˜es“a“couple“of“min˜utes'“CPU“time:ŽŸVc‘ü0éÓ#g–¿ª"((1“EXP“3)“+“(12“EXP“3)“=“1729)“/\“((9“EXP“3)“+“(10“EXP“3)“=“1729)";;Ž© ™š‘ü0é"((1–¿ªEXP“3)“+“(12“EXP“3)“=“1729)“/\“((9“EXP“3)“+“(10“EXP“3)“=“1729)"Ž¤34‘ü0é()–¿ª:“voidŽ¡‘ü0é#e‘¿ªREDUCE_TAC;;Ž¦‘ü0éOK..Ž¦‘ü0égoal‘¿ªprovedŽ¦‘ü0é|-–¿ª((1“EXP“3)“+“(12“EXP“3)“=“1729)“/\“((9“EXP“3)“+“(10“EXP“3)“=“1729)Ž¡‘ü0éPrevious‘¿ªsubproof:Ž¦‘ü0égoal‘¿ªprovedŽ¦‘ü0é()–¿ª:“voidŽŸ)-‘êñëâSee‘…alsoŽŸ ÈÌ‘êñëÓRED_CONV,–¿ªREDUCE_CONV,“REDUCE_RULEŽŸ+6[Ÿ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëIRED_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ0´¸‘êñëÓRED_CONV–¿ª:“convŽŽŽŒ‹sÛ ÌU ýFÓŸú™š‘ÇaÒSBC‘Ái‰ffÇŽ‘ˆ„CONV’v;ÆÛ23Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaâSynopsisŽ¤K«‘ÇaÖPš¬rerforms–ê¨arithmetic“or“b•SŽo“olean–ê¨reduction“at“top“lev˜el“if“pSŽossible.Ž©.«‘ÇaâDescriptionŽ¡‘ÇaÖThe›åVcon•¬rv“ersion˜ÓRED_CONV‘åÖattempts˜to˜apply‘ÿV,‘$at˜the˜top˜lev“el˜only‘ÿV,‘$one˜of˜the˜follo“wingŽŸ‘Çacon•¬rv“ersions–ê¨from“the“Óreduce“Ölibrary“(only“one“can“succeed):ŽŸÈE‘$_ÓADD_CONV– TAND_CONV“BEQ_CONV“COND_CONVŽ¤ ™š‘$_DIV_CONV‘ TEXP_CONV‘>þGE_CONV‘þ¨GT_CONVŽ¡‘$_IMP_CONV–>þLE_CONV“LT_CONV“MOD_CONVŽ¡‘$_MUL_CONV– TNEQ_CONV“NOT_CONV‘þ¨OR_CONVŽ¡‘$_PRE_CONV– TSBC_CONV“SUC_CONVŽŸ)Æ‘ÇaâF‘þž¸ailureŽŸK«‘ÇaÖF‘ÿVails–ê¨if“none“of“the“abSŽo•¬rv“e›ê¨con“v“ersions˜are˜applicable˜at˜top˜lev“el.Ž¦‘ÇaâExampleŽŸð‘ÇaÓ#RED_CONV–¿ª"(2=3)“=“F";;Ž¡‘Ça|-–¿ª((2“=“3)“=“F)“=“~(2“=“3)Ž©34‘Ça#RED_CONV–¿ª"15“DIV“13";;Ž¡‘Ça|-–¿ª15“DIV“13“=“1Ž¦‘Ça#RED_CONV–¿ª"100“+“100";;Ž¡‘Ça|-–¿ª100“+“100“=“200Ž¦‘Ça#RED_CONV–¿ª"0“+“x";;Ž¡‘Çaevaluation‘¿ªfailed‘¾RRED_CONVŽŸ)Æ‘ÇaâSee‘…alsoŽŸ åE‘ÇaÓREDUCE_CONV,–¿ªREDUCE_RULE,“REDUCE_TACŽŸ,ŒŸ¹I‘ÇaŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëISBC_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ1|‘ÇaÓSBC_CONV–¿ª:“convŽŸ.«‘ÇaâSynopsisŽŸK«‘ÇaÖCalculates–ê¨bš¬ry“inference“the“di erence“of“t˜w˜o“n˜umerals.ŽŽŽŒ‹yg ÌU ýFÓŸú™š‘êñëÛ24’š•ðChapter–€2.‘ €ML“F‘þàunctions“in“the“reduce“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëâDescriptionŽ¤‘êñëÖIf–ê¨Óm“Öand“Ón“Öare“n¬rumerals“(e.g.‘8àÓ0Ö,“Ó1Ö,“Ó2Ö,“Ó3Ö,...),“then“ÓSBC_CONV–¿ª"m“-“n"–ê¨Öreturns“the“theorem:ŽŸC·‘ü0éÓ|-–¿ªm“-“n“=“sŽŸª‘êñëÖwhere–>Ós“Öis“the“nš¬rumeral“that“denotes“the“di erence“of“the“natural“n˜um˜bSŽers“denoted“b˜y“ÓmŽ¡‘êñëÖand‘ê¨ÓnÖ.Ž©T;‘êñëâF‘þž¸ailureŽ¡‘êñëÓSBC_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"m˜-˜n"Ö,“where“Óm“Öand“Ón“Öare“n¬rumerals.Ž¦‘êñëâExampleŽŸC·‘êñëÓ#SBC_CONV–¿ª"25“-“30";;Ž¤ ™š‘êñë|-–¿ª25“-“30“=“0Ž©34‘êñë#SBC_CONV–¿ª"200“-“200";;Ž¡‘êñë|-–¿ª200“-“200“=“0Ž¦‘êñë#SBC_CONV–¿ª"60“-“17";;Ž¡‘êñë|-–¿ª60“-“17“=“43ŽŸ+¦ÍŸ¹I‘êñëŸé­‰ffÇBXŸRãÌÍŸRâ„&¥ÅffŸòã‘ÌÍëISUC_CONVŽŽ’ÆÛò„&¥ÅffŽŽŸ¹H‰ffÇBXŽŽŽŸ*ΑêñëÓSUC_CONV–¿ª:“convŽ¤T;‘êñëâSynopsisŽ©‘êñëÖCalculates–ê¨bš¬ry“inference“the“successor“of“a“n˜umeral.Ž¡‘êñëâDescriptionŽ¦‘êñëÖIf–ê¨Ón“Öis“a“n¬rumeral“(e.g.‘8àÓ0Ö,“Ó1Ö,“Ó2Ö,“Ó3Ö,...),“then“ÓSUC_CONV–¿ª"SUC“n"–ê¨Öreturns“the“theorem:ŽŸC·‘ü0éÓ|-–¿ªSUC“n“=“sŽŸª‘êñëÖwhere–ê¨Ós“Öis“the“nš¬rumeral“that“denotes“the“successor“of“the“natural“n˜um˜bSŽer“denoted“b˜y“ÓnÖ.Ž¡‘êñëâF‘þž¸ailureŽ¦‘êñëÓSUC_CONV›¿ªtm–ê¨Öfails“unless“Ótm“Öis“of“the“form“Ó"SUC˜n"Ö,“where“Ón“Öis“a“n¬rumeral.Ž¡‘êñëâExampleŽŸC·‘êñëÓ#SUC_CONV–¿ª"SUC“33";;ŽŸ ™š‘êñë|-–¿ªSUC“33“=“34ŽŽŽŒ‹~Ú ÌU ýFÓ ”/ß ýáä‘ÇaŸ³¸ä‰Ç>|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘Çaó1߆µT cmtt12ÜADD_CONVÖ,‘ê¨5Ž©‘ÇaÜAND_CONVÖ,‘ê¨5Ž¤‘ÇaÜBEQ_CONVÖ,‘ê¨6Ž¡‘ÇaÜCOND_CONVÖ,‘ê¨7Ž¡‘ÇaÜDIV_CONVÖ,‘ê¨8Ž¡‘ÇaÜEXP_CONVÖ,‘ê¨9Ž¡‘ÇaÜGE_CONVÖ,‘ê¨10Ž¦‘ÇaÜGT_CONVÖ,‘ê¨11Ž¡‘ÇaÜIMP_CONVÖ,‘ê¨12Ž¡‘ÇaÜLE_CONVÖ,‘ê¨13Ž¦‘ÇaÜLT_CONVÖ,‘ê¨14Ž¡‘ÇaÜMOD_CONVÖ,‘ê¨15Ž¦‘ÇaÜMUL_CONVÖ,‘ê¨16Ž¡‘ÇaÜNEQ_CONVÖ,‘ê¨17Ž¦‘ÇaÜNOT_CONVÖ,‘ê¨18Ž¡‘ÇaÜOR_CONVÖ,‘ê¨18Ž¡‘ÇaÜPRE_CONVÖ,‘ê¨19Ž¡‘ÇaÜRED_CONVÖ,‘ê¨22Ž¦‘ÇaÜREDUCE_CONVÖ,‘ê¨20Ž¦‘ÇaÜREDUCE_RULEÖ,‘ê¨21Ž¦‘ÇaÜREDUCE_TACÖ,‘ê¨22Ž¡‘ÇaÜSBC_CONVÖ,‘ê¨23Ž¦‘ÇaÜSUC_CONVÖ,‘ê¨24ŽŽŽŽŽŽŸ$ý’烈Û25ŽŽŒø„¡ƒ’À;èÌUÚÝ óIßêindex.tex; \ echo "\mbox{}" >>index.tex; \ echo "\end{theindex}" >>index.tex ids:; \ echo "\chapter{ML Functions in the reduce Library}" >entries.tex; \ echo "\input{entries-intro}" >>entries.tex; \ /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex index:; \ ${MAKEINDEX} reduce.idx index.tex reduce:; \ latex reduce.tex hol88-2.02.19940316/Library/reduce/Manual/entries-intro.tex0000640000212700021270000000031705027203526021342 0ustar cammcammThis chapter provides documentation on all the \ML\ functions that are made available in \HOL\ when the \ml{reduce} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/reduce/Manual/title.tex0000640000212700021270000000414605027203526017665 0ustar cammcamm% ===================================================================== % % Standard titlepage for reduce library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL reduce Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf J.\ R. \ Harrison \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf June 1991 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ J.\ R.\ Harrison 1991 \end{center} \newpage hol88-2.02.19940316/Library/reduce/Manual/index.tex0000640000212700021270000000161305535605643017661 0ustar cammcamm\begin{theindex} \item {\ptt ADD\_CONV}, 5 \item {\ptt AND\_CONV}, 5 \indexspace \item {\ptt BEQ\_CONV}, 6 \indexspace \item {\ptt COND\_CONV}, 7 \indexspace \item {\ptt DIV\_CONV}, 8 \indexspace \item {\ptt EXP\_CONV}, 9 \indexspace \item {\ptt GE\_CONV}, 10 \item {\ptt GT\_CONV}, 11 \indexspace \item {\ptt IMP\_CONV}, 12 \indexspace \item {\ptt LE\_CONV}, 13 \item {\ptt LT\_CONV}, 14 \indexspace \item {\ptt MOD\_CONV}, 15 \item {\ptt MUL\_CONV}, 16 \indexspace \item {\ptt NEQ\_CONV}, 17 \item {\ptt NOT\_CONV}, 18 \indexspace \item {\ptt OR\_CONV}, 18 \indexspace \item {\ptt PRE\_CONV}, 19 \indexspace \item {\ptt RED\_CONV}, 22 \item {\ptt REDUCE\_CONV}, 20 \item {\ptt REDUCE\_RULE}, 21 \item {\ptt REDUCE\_TAC}, 22 \indexspace \item {\ptt SBC\_CONV}, 23 \item {\ptt SUC\_CONV}, 24 \end{theindex} hol88-2.02.19940316/Library/reduce/help/0000750000212700021270000000000005227250243015527 5ustar cammcammhol88-2.02.19940316/Library/reduce/help/entries/0000750000212700021270000000000005227255747017216 5ustar cammcammhol88-2.02.19940316/Library/reduce/help/entries/ADD_CONV.doc0000640000212700021270000000100505052603053021076 0ustar cammcamm\DOC ADD_CONV \TYPE {ADD_CONV : conv} \SYNOPSIS Calculates by inference the sum of two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are numerals (e.g. {0}, {1}, {2}, {3},...), then {ADD_CONV "m + n"} returns the theorem: { |- m + n = s } \noindent where {s} is the numeral that denotes the sum of the natural numbers denoted by {m} and {n}. \FAILURE {ADD_CONV tm} fails unless {tm} is of the form {"m + n"}, where {m} and {n} are numerals. \EXAMPLE { #ADD_CONV "75 + 25";; |- 75 + 25 = 100 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/AND_CONV.doc0000640000212700021270000000153605052603054021122 0ustar cammcamm\DOC AND_CONV \TYPE {AND_CONV : conv} \SYNOPSIS Simplifies certain boolean conjunction expressions. \LIBRARY reduce \DESCRIBE If {tm} corresponds to one of the forms given below, where {t} is an arbitrary term of type {bool}, then {AND_CONV tm} returns the corresponding theorem. Note that in the last case the conjuncts need only be alpha-equivalent rather than strictly identical. { AND_CONV "T /\ t" = |- T /\ t = t AND_CONV "t /\ T" = |- t /\ T = t AND_CONV "F /\ t" = |- F /\ t = F AND_CONV "t /\ F" = |- t /\ F = F AND_CONV "t /\ t" = |- t /\ t = t } \FAILURE {AND_CONV tm} fails unless {tm} has one of the forms indicated above. \EXAMPLE { #AND_CONV "(x = T) /\ F";; |- (x = T) /\ F = F #AND_CONV "T /\ (x = T)";; |- T /\ (x = T) = (x = T) #AND_CONV "(?x. x=T) /\ (?y. y=T)";; |- (?x. x = T) /\ (?y. y = T) = (?x. x = T) } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/BEQ_CONV.doc0000640000212700021270000000160405052603055021124 0ustar cammcamm\DOC BEQ_CONV \TYPE {BEQ_CONV : conv} \SYNOPSIS Simplifies certain expressions involving boolean equality. \LIBRARY reduce \DESCRIBE If {tm} corresponds to one of the forms given below, where {t} is an arbitrary term of type {bool}, then {BEQ_CONV tm} returns the corresponding theorem. Note that in the last case the left-hand and right-hand sides need only be alpha-equivalent rather than strictly identical. { BEQ_CONV "T = t" = |- T = t = t BEQ_CONV "t = T" = |- t = T = t BEQ_CONV "F = t" = |- F = t = ~t BEQ_CONV "t = F" = |- t = F = ~t BEQ_CONV "t = t" = |- t = t = T } \FAILURE {BEQ_CONV tm} fails unless {tm} has one of the forms indicated above. \EXAMPLE { #BEQ_CONV "T = T";; |- (T = T) = T #BEQ_CONV "F = T";; |- (F = T) = F #BEQ_CONV "(!x:*#**. x = (FST x,SND x)) = (!y:*#**. y = (FST y,SND y))";; |- ((!x. x = FST x,SND x) = (!y. y = FST y,SND y)) = T } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/COND_CONV.doc0000640000212700021270000000152005052603055021235 0ustar cammcamm\DOC COND_CONV \TYPE {COND_CONV : conv} \SYNOPSIS Simplifies certain conditional expressions. \LIBRARY reduce \DESCRIBE If {tm} corresponds to one of the forms given below, where {b} has type {bool} and {t1} and {t2} have the same type, then {COND_CONV tm} returns the corresponding theorem. Note that in the last case the arms need only be alpha-equivalent rather than strictly identical. { COND_CONV "F => t1 | t2" = |- (T => t1 | t2) = t2 COND_CONV "T => t1 | t2" = |- (T => t1 | t2) = t1 COND_CONV "b => t | t = |- (b => t | t) = t } \FAILURE {COND_CONV tm} fails unless {tm} has one of the forms indicated above. \EXAMPLE { #COND_CONV "F => F | T";; |- (F => F | T) = T #COND_CONV "T => F | T";; |- (T => F | T) = F #COND_CONV "b => (\x. SUC x) | (\p. SUC p)";; |- (b => (\x. SUC x) | (\p. SUC p)) = (\x. SUC x) } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/DIV_CONV.doc0000640000212700021270000000150305052603056021136 0ustar cammcamm\DOC DIV_CONV \TYPE {DIV_CONV : conv} \SYNOPSIS Calculates by inference the result of dividing, with truncation, one numeral by another. \LIBRARY reduce \DESCRIBE If {m} and {n} are numerals (e.g. {0}, {1}, {2}, {3},...), then {DIV_CONV "m DIV n"} returns the theorem: { |- m DIV n = s } \noindent where {s} is the numeral that denotes the result of dividing the natural number denoted by {m} by the natural number denoted by {n}, with truncation. \FAILURE {DIV_CONV tm} fails unless {tm} is of the form {"m DIV n"}, where {m} and {n} are numerals, or if {n} denotes zero. \EXAMPLE { #DIV_CONV "0 DIV 0";; evaluation failed DIV_CONV #DIV_CONV "0 DIV 12";; |- 0 DIV 12 = 0 #DIV_CONV "2 DIV 0";; evaluation failed DIV_CONV #DIV_CONV "144 DIV 12";; |- 144 DIV 12 = 12 #DIV_CONV "7 DIV 2";; |- 7 DIV 2 = 3 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/EXP_CONV.doc0000640000212700021270000000132705052603057021155 0ustar cammcamm\DOC EXP_CONV \TYPE {EXP_CONV : conv} \SYNOPSIS Calculates by inference the result of raising one numeral to the power of another. \LIBRARY reduce \DESCRIBE If {m} and {n} are numerals (e.g. {0}, {1}, {2}, {3},...), then {EXP_CONV "m EXP n"} returns the theorem: { |- m EXP n = s } \noindent where {s} is the numeral that denotes the result of raising the natural number denoted by {m} to the power of the natural number denoted by {n}. \FAILURE {EXP_CONV tm} fails unless {tm} is of the form {"m EXP n"}, where {m} and {n} are numerals. \EXAMPLE { #EXP_CONV "0 EXP 0";; |- 0 EXP 0 = 1 #EXP_CONV "15 EXP 0";; |- 15 EXP 0 = 1 #EXP_CONV "12 EXP 1";; |- 12 EXP 1 = 12 #EXP_CONV "2 EXP 6";; |- 2 EXP 6 = 64 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/GE_CONV.doc0000640000212700021270000000122305052603057021007 0ustar cammcamm\DOC GE_CONV \TYPE {GE_CONV : conv} \SYNOPSIS Proves result of less-than-or-equal-to ordering on two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are both numerals (e.g. {0}, {1}, {2}, {3},...), then {GE_CONV "m >= n"} returns the theorem: { |- (m >= n) = T } \noindent if the natural number denoted by {m} is greater than or equal to that denoted by {n}, or { |- (m >= n) = F } \noindent otherwise. \FAILURE {GE_CONV tm} fails unless {tm} is of the form {"m >= n"}, where {m} and {n} are numerals. \EXAMPLE { #GE_CONV "15 >= 14";; |- 15 >= 14 = T #GE_CONV "100 >= 100";; |- 100 >= 100 = T #GE_CONV "0 >= 107";; |- 0 >= 107 = F } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/GT_CONV.doc0000640000212700021270000000116205052603060021022 0ustar cammcamm\DOC GT_CONV \TYPE {GT_CONV : conv} \SYNOPSIS Proves result of greater-than ordering on two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are both numerals (e.g. {0}, {1}, {2}, {3},...), then {GT_CONV "m > n"} returns the theorem: { |- (m > n) = T } \noindent if the natural number denoted by {m} is greater than that denoted by {n}, or { |- (m > n) = F } \noindent otherwise. \FAILURE {GT_CONV tm} fails unless {tm} is of the form {"m > n"}, where {m} and {n} are numerals. \EXAMPLE { #GT_CONV "100 > 10";; |- 100 > 10 = T #GT_CONV "15 > 15";; |- 15 > 15 = F #GT_CONV "11 > 27";; |- 11 > 27 = F } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/IMP_CONV.doc0000640000212700021270000000155105052603061021140 0ustar cammcamm\DOC IMP_CONV \TYPE {IMP_CONV : conv} \SYNOPSIS Simplifies certain implicational expressions. \LIBRARY reduce \DESCRIBE If {tm} corresponds to one of the forms given below, where {t} is an arbitrary term of type {bool}, then {IMP_CONV tm} returns the corresponding theorem. Note that in the last case the antecedent and consequent need only be alpha-equivalent rather than strictly identical. { IMP_CONV "T ==> t" = |- T ==> t = t IMP_CONV "t ==> T" = |- t ==> T = T IMP_CONV "F ==> t" = |- F ==> t = T IMP_CONV "t ==> F" = |- t ==> F = ~t IMP_CONV "t ==> t" = |- t ==> t = T } \FAILURE {IMP_CONV tm} fails unless {tm} has one of the forms indicated above. \EXAMPLE { #IMP_CONV "T ==> F";; |- T ==> F = F #IMP_CONV "F ==> x";; |- F ==> x = T #IMP_CONV "(!z:(num)list. z = z) ==> (!x:(num)list. x = x)";; |- (!z. z = z) ==> (!x. x = x) = T } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/LE_CONV.doc0000640000212700021270000000121605052603062021012 0ustar cammcamm\DOC LE_CONV \TYPE {LE_CONV : conv} \SYNOPSIS Proves result of less-than-or-equal-to ordering on two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are both numerals (e.g. {0}, {1}, {2}, {3},...), then {LE_CONV "m <= n"} returns the theorem: { |- (m <= n) = T } \noindent if the natural number denoted by {m} is less than or equal to that denoted by {n}, or { |- (m <= n) = F } \noindent otherwise. \FAILURE {LE_CONV tm} fails unless {tm} is of the form {"m <= n"}, where {m} and {n} are numerals. \EXAMPLE { #LE_CONV "12 <= 198";; |- 12 <= 198 = T #LE_CONV "46 <= 46";; |- 46 <= 46 = T #LE_CONV "13 <= 12";; |- 13 <= 12 = F } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/LT_CONV.doc0000640000212700021270000000115005052603062021026 0ustar cammcamm\DOC LT_CONV \TYPE {LT_CONV : conv} \SYNOPSIS Proves result of less-than ordering on two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are both numerals (e.g. {0}, {1}, {2}, {3},...), then {LT_CONV "m < n"} returns the theorem: { |- (m < n) = T } \noindent if the natural number denoted by {m} is less than that denoted by {n}, or { |- (m < n) = F } \noindent otherwise. \FAILURE {LT_CONV tm} fails unless {tm} is of the form {"m < n"}, where {m} and {n} are numerals. \EXAMPLE { #LT_CONV "0 < 12";; |- 0 < 12 = T #LT_CONV "13 < 13";; |- 13 < 13 = F #LT_CONV "25 < 12";; |- 25 < 12 = F } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/MOD_CONV.doc0000640000212700021270000000147505052603063021141 0ustar cammcamm\DOC MOD_CONV \TYPE {MOD_CONV : conv} \SYNOPSIS Calculates by inference the remainder after dividing one numeral by another. \LIBRARY reduce \DESCRIBE If {m} and {n} are numerals (e.g. {0}, {1}, {2}, {3},...), then {MOD_CONV "m MOD n"} returns the theorem: { |- m MOD n = s } \noindent where {s} is the numeral that denotes the remainder after dividing, with truncation, the natural number denoted by {m} by the natural number denoted by {n}. \FAILURE {MOD_CONV tm} fails unless {tm} is of the form {"m MOD n"}, where {m} and {n} are numerals, or if {n} denotes zero. \EXAMPLE { #MOD_CONV "0 MOD 0";; evaluation failed MOD_CONV #MOD_CONV "0 MOD 12";; |- 0 MOD 12 = 0 #MOD_CONV "2 MOD 0";; evaluation failed MOD_CONV #MOD_CONV "144 MOD 12";; |- 144 MOD 12 = 0 #MOD_CONV "7 MOD 2";; |- 7 MOD 2 = 1 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/MUL_CONV.doc0000640000212700021270000000112005052603064021143 0ustar cammcamm\DOC MUL_CONV \TYPE {MUL_CONV : conv} \SYNOPSIS Calculates by inference the product of two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are numerals (e.g. {0}, {1}, {2}, {3},...), then {MUL_CONV "m * n"} returns the theorem: { |- m * n = s } \noindent where {s} is the numeral that denotes the product of the natural numbers denoted by {m} and {n}. \FAILURE {MUL_CONV tm} fails unless {tm} is of the form {"m * n"}, where {m} and {n} are numerals. \EXAMPLE { #MUL_CONV "0 * 12";; |- 0 * 12 = 0 #MUL_CONV "1 * 1";; |- 1 * 1 = 1 #MUL_CONV "6 * 11";; |- 6 * 11 = 66 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/NEQ_CONV.doc0000640000212700021270000000106205052603064021136 0ustar cammcamm\DOC NEQ_CONV \TYPE {NEQ_CONV : conv} \SYNOPSIS Proves equality or inequality of two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are both numerals (e.g. {0}, {1}, {2}, {3},...), then {NEQ_CONV "m = n"} returns the theorem: { |- (m = n) = T } \noindent if {m} and {n} are identical, or { |- (m = n) = F } \noindent if {m} and {n} are distinct. \FAILURE {NEQ_CONV tm} fails unless {tm} is of the form {"m = n"}, where {m} and {n} are numerals. \EXAMPLE { #NEQ_CONV "12 = 12";; |- (12 = 12) = T #NEQ_CONV "14 = 25";; |- (14 = 25) = F } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/NOT_CONV.doc0000640000212700021270000000107605052603065021161 0ustar cammcamm\DOC NOT_CONV \TYPE {NOT_CONV : conv} \SYNOPSIS Simplifies certain boolean negation expressions. \LIBRARY reduce \DESCRIBE If {tm} corresponds to one of the forms given below, where {t} is an arbitrary term of type {bool}, then {NOT_CONV tm} returns the corresponding theorem. { NOT_CONV "~F" = |- ~F = T NOT_CONV "~T" = |- ~T = F NOT_CONV "~~t" = |- ~~t = t } \FAILURE {NOT_CONV tm} fails unless {tm} has one of the forms indicated above. \EXAMPLE { #NOT_CONV "~~~~T";; |- ~~~~T = ~~T #NOT_CONV "~~T";; |- ~~T = T #NOT_CONV "~T";; |- ~T = F } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/OR_CONV.doc0000640000212700021270000000154005052603066021036 0ustar cammcamm\DOC OR_CONV \TYPE {OR_CONV : conv} \SYNOPSIS Simplifies certain boolean disjunction expressions. \LIBRARY reduce \DESCRIBE If {tm} corresponds to one of the forms given below, where {t} is an arbitrary term of type {bool}, then {OR_CONV tm} returns the corresponding theorem. Note that in the last case the disjuncts need only be alpha-equivalent rather than strictly identical. { OR_CONV "T \/ t" = |- T \/ t = T OR_CONV "t \/ T" = |- t \/ T = T OR_CONV "F \/ t" = |- F \/ t = t OR_CONV "t \/ F" = |- t \/ F = t OR_CONV "t \/ t" = |- t \/ t = t } \FAILURE {OR_CONV tm} fails unless {tm} has one of the forms indicated above. \EXAMPLE { #OR_CONV "F \/ T";; |- F \/ T = T #OR_CONV "X \/ F";; |- X \/ F = X #OR_CONV "(!n. n + 1 = SUC n) \/ (!m. m + 1 = SUC m)";; |- (!n. n + 1 = SUC n) \/ (!m. m + 1 = SUC m) = (!n. n + 1 = SUC n) } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/PRE_CONV.doc0000640000212700021270000000107205052603066021144 0ustar cammcamm\DOC PRE_CONV \TYPE {PRE_CONV : conv} \SYNOPSIS Calculates by inference the predecessor of a numeral. \LIBRARY reduce \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {PRE_CONV "PRE n"} returns the theorem: { |- PRE n = s } \noindent where {s} is the numeral that denotes the predecessor of the natural number denoted by {n}. \FAILURE {PRE_CONV tm} fails unless {tm} is of the form {"PRE n"}, where {n} is a numeral. \EXAMPLE { #PRE_CONV "PRE 0";; |- PRE 0 = 0 #PRE_CONV "PRE 1";; |- PRE 1 = 0 #PRE_CONV "PRE 22";; |- PRE 22 = 21 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/REDUCE_CONV.doc0000640000212700021270000000215105052603067021465 0ustar cammcamm\DOC REDUCE_CONV \TYPE {REDUCE_CONV : conv} \SYNOPSIS Performs arithmetic or boolean reduction at all levels possible. \LIBRARY reduce \DESCRIBE The conversion {REDUCE_CONV} attempts to apply, in bottom-up order to all suitable redexes, one of the following conversions from the {reduce} library (only one can succeed): { ADD_CONV AND_CONV BEQ_CONV COND_CONV DIV_CONV EXP_CONV GE_CONV GT_CONV IMP_CONV LE_CONV LT_CONV MOD_CONV MUL_CONV NEQ_CONV NOT_CONV OR_CONV PRE_CONV SBC_CONV SUC_CONV } \noindent In particular, it will prove the appropriate reduction for an arbitrarily complicated expression constructed from numerals and the boolean constants {T} and {F}. \FAILURE Never fails, but may give a reflexive equation. \EXAMPLE { #REDUCE_CONV "(2=3) = F";; |- ((2 = 3) = F) = T #REDUCE_CONV "(100 < 200) => (2 EXP (8 DIV 2)) | (3 EXP ((26 EXP 0) * 3))";; |- (100 < 200 => 2 EXP (8 DIV 2) | 3 EXP ((26 EXP 0) * 3)) = 16 #REDUCE_CONV "(15 = 16) \/ (15 < 16)";; |- (15 = 16) \/ 15 < 16 = T #REDUCE_CONV "0 + x";; |- 0 + x = 0 + x } \SEEALSO RED_CONV, REDUCE_RULE, REDUCE_TAC \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/REDUCE_RULE.doc0000640000212700021270000000074105052603070021464 0ustar cammcamm\DOC REDUCE_RULE \TYPE {REDUCE_RULE : (thm -> thm)} \SYNOPSIS Performs arithmetic or boolean reduction on a theorem at all levels possible. \LIBRARY reduce \DESCRIBE {REDUCE_RULE} attempts to transform a theorem by applying {REDUCE_CONV}. \FAILURE Never fails, but may just return the original theorem. \EXAMPLE { #REDUCE_RULE (ASSUME "x = (100 + (60 - 17))");; . |- x = 143 #REDUCE_RULE (REFL "100 + 12 DIV 6");; |- T } \SEEALSO RED_CONV, REDUCE_CONV, REDUCE_TAC \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/REDUCE_TAC.doc0000640000212700021270000000151105052603070021320 0ustar cammcamm\DOC REDUCE_TAC \TYPE {REDUCE_TAC : tactic} \SYNOPSIS Performs arithmetic or boolean reduction on a goal at all levels possible. \LIBRARY reduce \DESCRIBE {REDUCE_TAC} attempts to transform a goal by applying {REDUCE_CONV}. It will prove any true goal which is constructed from numerals and the boolean constants {T} and {F}. \FAILURE Never fails, but may not advance the goal. \EXAMPLE The following example takes a couple of minutes' CPU time: { #g "((1 EXP 3) + (12 EXP 3) = 1729) /\ ((9 EXP 3) + (10 EXP 3) = 1729)";; "((1 EXP 3) + (12 EXP 3) = 1729) /\ ((9 EXP 3) + (10 EXP 3) = 1729)" () : void #e REDUCE_TAC;; OK.. goal proved |- ((1 EXP 3) + (12 EXP 3) = 1729) /\ ((9 EXP 3) + (10 EXP 3) = 1729) Previous subproof: goal proved () : void } \SEEALSO RED_CONV, REDUCE_CONV, REDUCE_RULE \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/RED_CONV.doc0000640000212700021270000000151205052603071021123 0ustar cammcamm\DOC RED_CONV \TYPE {RED_CONV : conv} \SYNOPSIS Performs arithmetic or boolean reduction at top level if possible. \LIBRARY reduce \DESCRIBE The conversion {RED_CONV} attempts to apply, at the top level only, one of the following conversions from the {reduce} library (only one can succeed): { ADD_CONV AND_CONV BEQ_CONV COND_CONV DIV_CONV EXP_CONV GE_CONV GT_CONV IMP_CONV LE_CONV LT_CONV MOD_CONV MUL_CONV NEQ_CONV NOT_CONV OR_CONV PRE_CONV SBC_CONV SUC_CONV } \FAILURE Fails if none of the above conversions are applicable at top level. \EXAMPLE { #RED_CONV "(2=3) = F";; |- ((2 = 3) = F) = ~(2 = 3) #RED_CONV "15 DIV 13";; |- 15 DIV 13 = 1 #RED_CONV "100 + 100";; |- 100 + 100 = 200 #RED_CONV "0 + x";; evaluation failed RED_CONV } \SEEALSO REDUCE_CONV, REDUCE_RULE, REDUCE_TAC \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/SBC_CONV.doc0000640000212700021270000000114205052603072021120 0ustar cammcamm\DOC SBC_CONV \TYPE {SBC_CONV : conv} \SYNOPSIS Calculates by inference the difference of two numerals. \LIBRARY reduce \DESCRIBE If {m} and {n} are numerals (e.g. {0}, {1}, {2}, {3},...), then {SBC_CONV "m - n"} returns the theorem: { |- m - n = s } \noindent where {s} is the numeral that denotes the difference of the natural numbers denoted by {m} and {n}. \FAILURE {SBC_CONV tm} fails unless {tm} is of the form {"m - n"}, where {m} and {n} are numerals. \EXAMPLE { #SBC_CONV "25 - 30";; |- 25 - 30 = 0 #SBC_CONV "200 - 200";; |- 200 - 200 = 0 #SBC_CONV "60 - 17";; |- 60 - 17 = 43 } \ENDDOC hol88-2.02.19940316/Library/reduce/help/entries/SUC_CONV.doc0000640000212700021270000000076205052603073021153 0ustar cammcamm\DOC SUC_CONV \TYPE {SUC_CONV : conv} \SYNOPSIS Calculates by inference the successor of a numeral. \LIBRARY reduce \DESCRIBE If {n} is a numeral (e.g. {0}, {1}, {2}, {3},...), then {SUC_CONV "SUC n"} returns the theorem: { |- SUC n = s } \noindent where {s} is the numeral that denotes the successor of the natural number denoted by {n}. \FAILURE {SUC_CONV tm} fails unless {tm} is of the form {"SUC n"}, where {n} is a numeral. \EXAMPLE { #SUC_CONV "SUC 33";; |- SUC 33 = 34 } \ENDDOC hol88-2.02.19940316/Library/reduce/Makefile0000640000212700021270000000265705072121755016255 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: reduce # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # [In fact there are no theories in this library] # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # ===================================================================== Hol=../../hol all: reduce_ml.o; clean:; rm -f boolconv_ml.o arithconv_ml.o reduce_ml.o clobber: clean; reduce_ml.o: arithconv_ml.o boolconv_ml.o reduce.ml; \ echo 'set_flag(`abort_when_fail`,true);;' \ 'compilet `reduce`;;' \ 'quit();;' | ${Hol} arithconv_ml.o: arithconv.ml; \ echo 'set_flag(`abort_when_fail`,true);;' \ 'compilet `arithconv`;;' \ 'quit();;' | ${Hol} boolconv_ml.o: boolconv.ml; \ echo 'set_flag(`abort_when_fail`,true);;' \ 'compilet `boolconv`;;' \ 'quit();;' | ${Hol} hol88-2.02.19940316/Library/reduce/READ-ME0000640000212700021270000000543205027203527015542 0ustar cammcammLIBRARY: reduce DESCRIPTION: Tools for the reduction of boolean and numeric expressions. The library works entirely by inference (but uses num_CONV). AUTHOR: John Harrison University of Cambridge Computer Laboratory New Museums Site Pembroke Street Cambridge CB2 3QG England. jrh@cl.cam.ac.uk DATE: 18th May 1991 NOTES: To maximize flexibility, the library is split into three parts: (1) boolconv.ml - Conversions for boolean expressions (2) arithconv.ml - Conversions for arithmetic constant-expressions (3) reduce.ml - General reduction tools using both the above. The first two parts can be loaded separately. The boolean conversions essentially package up the standard rewrites. The arithmetic conversions demand that all operands are actually numeric constants, so for example `ADD_CONV "0 + x"' will fail. BEQ_CONV and COND_CONV perform a similar function to the inbuilt conversions bool_EQ_CONV and COND_CONV, but are included for the sake of completeness. NEQ_CONV and ADD_CONV reproduce the function of the inbuilt num_EQ_CONV and ADD_CONV, but are significantly more efficient in many circumstances. I have tried to make asymptotic performance fast both in terms of the number of primitive inferences performed and the CPU time taken. Inevitably, the use of a unary number representation requires a prohibitively large amount of computation for some fairly small numbers. All loops are explicitly iterative (the current version of ML doesn't optimize tail calls), so there should be no problems with space usage. A slight speedup could be obtained by coupling certain conversions (eg. SBC_CONV -> ADD_CONV -> MUL_CONV -> EXP_CONV) at an ML-integer rather than HOL-term level, but the code would be less clean. One candidate for improvement is RED_CONV, which could explicitly check the head operator then choose the appropriate basic conversion. There is also scope for some top-down optimization not admitted by the reduction strategy of REDUCE_CONV. For example in the current version the evaluation of `REDUCE_CONV "T ==> (2 EXP 5) | (2 EXP 6)"' evaluates of both exponential subterms. Comments, bug reports and suggested improvements are welcome, preferably via the email address given above. hol88-2.02.19940316/Library/reduce/arithconv.ml0000640000212700021270000004705305036071126017137 0ustar cammcamm%****************************************************************************** ** LIBRARY: reduce (part II) ** ** ** ** DESCRIPTION: Conversions to reduce arithmetic constant expressions ** ** ** ** AUTHOR: John Harrison ** ** University of Cambridge Computer Laboratory ** ** New Museums Site ** ** Pembroke Street ** ** Cambridge CB2 3QG ** ** England. ** ** ** ** jrh@cl.cam.ac.uk ** ** ** ** DATE: 18th May 1991 ** ******************************************************************************% %-----------------------------------------------------------------------% % dest_op - Split application down spine, checking head operator % %-----------------------------------------------------------------------% let dest_op op tm = snd ((assert (curry $= op) # I) (strip_comb tm));; %-----------------------------------------------------------------------% % term_of_int - Convert ML integer to object level numeric constant % %-----------------------------------------------------------------------% let term_of_int = let ty = ":num" in \n. mk_const(string_of_int n, ty);; %-----------------------------------------------------------------------% % int_of_term - Convert object level numeric constant to ML integer % %-----------------------------------------------------------------------% let int_of_term = int_of_string o fst o dest_const;; %-----------------------------------------------------------------------% % provelt x y = |- [x] < [y], if true, else undefined. % %-----------------------------------------------------------------------% let provelt = let ltstep = PROVE("!x. (z = SUC y) ==> (x < y) ==> (x < z)", GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC (theorem `prim_rec` `LESS_SUC`)) and ltbase = PROVE("(y = SUC x) ==> (x < y)", DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC (theorem `prim_rec` `LESS_SUC_REFL`)) and bistep = PROVE("(SUC x < SUC y) = (x < y)", MATCH_ACCEPT_TAC (theorem `arithmetic` `LESS_MONO_EQ`)) and bibase = PROVE("!x. 0 < (SUC x)", MATCH_ACCEPT_TAC (theorem `prim_rec` `LESS_0`)) and ltop = "$<" and eqop = "$=:bool->bool->bool" and rhs = "x < y" and xv = "x:num" and yv = "y:num" and zv = "z:num" and Lo = "$< 0" in \x y. let xn = term_of_int x and yn = term_of_int y in if 4*(y - x) < 5*x then let x' = x + 1 in let xn' = term_of_int x' in let step = SPEC xn ltstep in letref z,zn,zn',th = x',xn',xn', MP (INST [(xn,xv);(xn',yv)] ltbase) (num_CONV xn') in while z < y do (zn':=term_of_int(z:=z+1); th := MP (MP (INST [(zn,yv); (zn',zv)] step) (num_CONV zn')) th; zn:=zn'); th else let lhs = mk_comb(mk_comb(ltop,xn),yn) in let pat = mk_comb(mk_comb(eqop,lhs),rhs) in letref w, z, wn, zn, th = x, y, xn, yn, REFL lhs in while w > 0 do (th := let tran = TRANS (SUBST [(num_CONV wn,xv); (num_CONV zn,yv)] pat th) in tran (INST[((wn:=term_of_int(w:=w-1)),xv); ((zn:=term_of_int(z:=z-1)),yv)] bistep)); EQ_MP (SYM (TRANS th (AP_TERM Lo (num_CONV zn)))) (SPEC (term_of_int(z-1)) bibase);; %-----------------------------------------------------------------------% % NEQ_CONV "[x] = [y]" = |- ([x] = [y]) = [x=y -> T | F] % %-----------------------------------------------------------------------% let NEQ_CONV = let eq1 = PROVE ("(x < y) ==> ((x = y) = F)", ONCE_REWRITE_TAC[] THEN MATCH_ACCEPT_TAC (theorem `prim_rec` `LESS_NOT_EQ`)) and eq2 = PROVE ("(y < x) ==> ((x = y) = F)", ONCE_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MATCH_ACCEPT_TAC (theorem `prim_rec` `LESS_NOT_EQ`)) and neqop = "=:num->num->bool" and xv = "x:num" and yv = "y:num" in \tm. (let [xn;yn] = dest_op neqop tm in let x = int_of_term xn and y = int_of_term yn in if x = y then EQT_INTRO (REFL xn) else if x < y then MP (INST [(xn,xv);(yn,yv)] eq1) (provelt x y) else MP (INST [(xn,xv);(yn,yv)] eq2) (provelt y x)) ? failwith `NEQ_CONV`;; %-----------------------------------------------------------------------% % LT_CONV "[x] < [y]" = |- ([x] < [y]) = [x T | F] % %-----------------------------------------------------------------------% let LT_CONV = let lt1 = PROVE("!x. (x < x) = F", REWRITE_TAC[theorem `prim_rec` `LESS_REFL`]) and lt2 = PROVE("(y < x) ==> ((x < y) = F)", PURE_ONCE_REWRITE_TAC[EQ_CLAUSES] THEN REPEAT DISCH_TAC THEN IMP_RES_TAC (theorem `arithmetic` `LESS_ANTISYM`)) and ltop = "$<" and xv = "x:num" and yv = "y:num" in \tm. (let [xn;yn] = dest_op ltop tm in let x = int_of_term xn and y = int_of_term yn in if x < y then EQT_INTRO (provelt x y) else if x = y then SPEC xn lt1 else MP (INST [(xn,xv);(yn,yv)] lt2) (provelt y x)) ? failwith `LT_CONV`;; %-----------------------------------------------------------------------% % GT_CONV "[x] > [y]" = |- ([x] > [y]) = [x>y -> T | F] % %-----------------------------------------------------------------------% let GT_CONV = let gt1 = PROVE("!x. (x > x) = F", REWRITE_TAC[theorem `prim_rec` `LESS_REFL`; definition `arithmetic` `GREATER`]) and gt2 = PROVE("(x < y) ==> ((x > y) = F)", PURE_REWRITE_TAC [EQ_CLAUSES; definition `arithmetic` `GREATER`] THEN REPEAT DISCH_TAC THEN IMP_RES_TAC (theorem `arithmetic` `LESS_ANTISYM`)) and gt3 = PROVE("(y < x) ==> ((x > y) = T)", DISCH_THEN (SUBST1_TAC o SYM o EQT_INTRO) THEN MATCH_ACCEPT_TAC (definition `arithmetic` `GREATER`)) and gtop = "$>" and xv = "x:num" and yv = "y:num" in \tm. (let [xn;yn] = dest_op gtop tm in let x = int_of_term xn and y = int_of_term yn in if x = y then SPEC xn gt1 else if x < y then MP (INST [(xn,xv);(yn,yv)] gt2) (provelt x y) else MP (INST [(xn,xv); (yn,yv)] gt3) (provelt y x)) ? failwith `GT_CONV`;; %-----------------------------------------------------------------------% % LE_CONV "[x] <= [y]" = |- ([x]<=> [y]) = [x<=y -> T | F] % %-----------------------------------------------------------------------% let LE_CONV = let le1 = PROVE("!x. (x <= x) = T", REWRITE_TAC[theorem `arithmetic` `LESS_EQ_REFL`]) and le2 = PROVE("(x < y) ==> ((x <= y) = T)", DISCH_THEN (ACCEPT_TAC o EQT_INTRO o MATCH_MP (theorem `arithmetic` `LESS_IMP_LESS_OR_EQ`))) and le3 = PROVE("(y < x) ==> ((x <= y) = F)", PURE_ONCE_REWRITE_TAC[EQ_CLAUSES] THEN REPEAT DISCH_TAC THEN IMP_RES_TAC (theorem `arithmetic` `LESS_EQ_ANTISYM`)) and leop = "$<=" and xv = "x:num" and yv = "y:num" in \tm. (let [xn;yn] = dest_op leop tm in let x = int_of_term xn and y = int_of_term yn in if x = y then SPEC xn le1 else if x < y then MP (INST [(xn,xv);(yn,yv)] le2) (provelt x y) else MP (INST [(xn,xv);(yn,yv)] le3) (provelt y x)) ? failwith `LE_CONV`;; %-----------------------------------------------------------------------% % GE_CONV "[x] >= [y]" = |- ([x] >= [y]) = [x>=y -> T | F] % %-----------------------------------------------------------------------% let GE_CONV = let ge1 = PROVE("!x. (x >= x) = T", REWRITE_TAC[definition `arithmetic` `GREATER_OR_EQ`]) and ge2 = PROVE("(y < x) ==> ((x >= y) = T)", DISCH_TAC THEN ASM_REWRITE_TAC[definition `arithmetic` `GREATER_OR_EQ`; definition `arithmetic` `GREATER`]) and ge3 = PROVE("(x < y) ==> ((x >= y) = F)", PURE_REWRITE_TAC (EQ_CLAUSES. (map (definition `arithmetic`) [`GREATER_OR_EQ`; `GREATER`])) THEN PURE_ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC (PURE_REWRITE_RULE [definition `arithmetic` `LESS_OR_EQ`] (theorem `arithmetic` `LESS_EQ_ANTISYM`))) and geop = "$>=" and xv = "x:num" and yv = "y:num" in \tm. (let [xn;yn] = dest_op geop tm in let x = int_of_term xn and y = int_of_term yn in if x = y then SPEC xn ge1 else if x < y then MP (INST [(xn,xv);(yn,yv)] ge3) (provelt x y) else MP (INST [(xn,xv);(yn,yv)] ge2) (provelt y x)) ? failwith `GE_CONV`;; %-----------------------------------------------------------------------% % SUC_CONV "SUC [x]" = |- SUC [x] = [x+1] % %-----------------------------------------------------------------------% let SUC_CONV = let sucop = "SUC" in \tm. (let [xn] = dest_op sucop tm in SYM (num_CONV (term_of_int (1 + (int_of_term xn))))) ? failwith `SUC_CONV`;; %-----------------------------------------------------------------------% % PRE_CONV "PRE [n]" = |- PRE [n] = [n-1] % %-----------------------------------------------------------------------% let PRE_CONV = let preop = "PRE" and zero = "0" and xv = "x:num" and yv = "y:num" and spree = PROVE("(x = SUC y) ==> (PRE x = y)", DISCH_TAC THEN ASM_REWRITE_TAC[theorem `prim_rec` `PRE`]) and szero = PROVE("PRE 0 = 0",REWRITE_TAC[theorem `prim_rec` `PRE`]) in \tm. (let [xn] = dest_op preop tm in if xn = zero then szero else MP (INST[(xn,xv);(term_of_int((int_of_term xn) - 1),yv)] spree) (num_CONV xn)) ? failwith `PRE_CONV`;; %-----------------------------------------------------------------------% % SBC_CONV "[x] - [y]" = |- ([x] - [y]) = [x - y] % %-----------------------------------------------------------------------% let SBC_CONV = let subm = PROVE("(x < y) ==> (x - y = 0)", PURE_ONCE_REWRITE_TAC[theorem `arithmetic` `SUB_EQ_0`] THEN MATCH_ACCEPT_TAC (theorem `arithmetic` `LESS_IMP_LESS_OR_EQ`)) and step = PROVE("(SUC x) - (SUC y) = x - y", MATCH_ACCEPT_TAC (theorem `arithmetic` `SUB_MONO_EQ`)) and base1 = PROVE("!x. x - 0 = x", REWRITE_TAC[theorem `arithmetic` `SUB_0`]) and base2 = PROVE("!x. x - x = 0", MATCH_ACCEPT_TAC(theorem `arithmetic` `SUB_EQUAL_0`)) and less0 = PROVE("!x. 0 < SUC x", REWRITE_TAC[theorem `prim_rec` `LESS_0`]) and swap = PROVE("(x - z = y) ==> (0 < y) ==> (x - y = z)", let [sub_less_0; sub_sub; less_imp_less_or_eq; add_sym; add_sub] = map (theorem `arithmetic`) [`SUB_LESS_0`; `SUB_SUB`; `LESS_IMP_LESS_OR_EQ`; `ADD_SYM`; `ADD_SUB`] in DISCH_THEN (SUBST1_TAC o SYM) THEN PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL sub_less_0)] THEN DISCH_THEN (SUBST1_TAC o SPEC "x:num" o MATCH_MP sub_sub o MATCH_MP less_imp_less_or_eq) THEN PURE_ONCE_REWRITE_TAC [add_sym] THEN PURE_ONCE_REWRITE_TAC[add_sub] THEN REFL_TAC) and lop = "$< 0" and minusop = "$-" and eqop = "$=:num->num->bool" and rhs = "x - y" and xv = "x:num" and yv = "y:num" and zv = "z:num" in let sprove x y = let xn = term_of_int x and yn = term_of_int y in let lhs = mk_comb(mk_comb(minusop,xn),yn) in let pat = mk_comb(mk_comb(eqop,lhs),rhs) in letref w, z, wn, zn, th = x, y, xn, yn, REFL lhs in while (z > 0) do (th := let tran = TRANS (SUBST [(num_CONV wn,xv); (num_CONV zn,yv)] pat th) in tran (INST [((wn := term_of_int(w:=w-1)),xv); ((zn := term_of_int(z:=z-1)),yv)] step)); TRANS th (SPEC wn base1) in \tm. (let [xn;yn] = dest_op minusop tm in let x = int_of_term xn and y = int_of_term yn in if x < y then MP (INST[(xn,xv);(yn,yv)] subm) (provelt x y) else if y = 0 then SPEC xn base1 else if x = y then SPEC xn base2 else if y < (x - y) then sprove x y else let z = x - y in let zn = term_of_int z in MP (MP (INST[(xn,xv);(yn,yv);(zn,zv)] swap) (sprove x z)) (EQ_MP (AP_TERM lop (SYM (num_CONV yn))) (SPEC (term_of_int (y-1)) less0))) ? failwith `SBC_CONV`;; %-----------------------------------------------------------------------% % ADD_CONV "[x] + [y]" = |- [x] + [y] = [x+y] % %-----------------------------------------------------------------------% let ADD_CONV = let subadd = PROVE ("(z - y = x) ==> 0 < x ==> (x + y = z)", DISCH_THEN (SUBST1_TAC o SYM) THEN PURE_ONCE_REWRITE_TAC[SYM (SPEC_ALL (theorem `arithmetic` `SUB_LESS_0`))] THEN DISCH_THEN (SUBST1_TAC o MATCH_MP (theorem `arithmetic` `SUB_ADD`) o MATCH_MP (theorem `arithmetic` `LESS_IMP_LESS_OR_EQ`)) THEN REFL_TAC) and [raz; laz] = CONJUNCTS(PROVE("(!x. x + 0 = x) /\ (!y. 0 + y = y)", REWRITE_TAC[definition `arithmetic` `ADD`; theorem `arithmetic` `ADD_0`])) and lo = PROVE("!n. 0 < SUC n",MATCH_ACCEPT_TAC(theorem `prim_rec` `LESS_0`)) and plusop = "$+" and minusop = "$-" and lop = "$< 0" and xv = "x:num" and yv = "y:num" and zv = "z:num" in \tm. (let [xn;yn] = dest_op plusop tm in let x = int_of_term xn and y = int_of_term yn in if x = 0 then SPEC yn laz else if y = 0 then SPEC xn raz else let zn = term_of_int(x + y) in let p1 = SBC_CONV (mk_comb(mk_comb(minusop,zn),yn)) and p2 = EQ_MP (AP_TERM lop (SYM (num_CONV xn))) (SPEC (term_of_int (int_of_term xn - 1)) lo) and chain = INST[(xn,xv); (yn,yv); (zn,zv)] subadd in MP (MP chain p1) p2) ? failwith `ADD_CONV`;; %-----------------------------------------------------------------------% % MUL_CONV "[x] * [y]" = |- [x] * [y] = [x*y] % %-----------------------------------------------------------------------% let MUL_CONV = let [mbase; mstep; mzero] = CONJUNCTS (PROVE ("(!y. 0 * y = 0) /\ (!y x. (SUC x) * y = (x * y) + y) /\ (!n. n * 0 = 0)", REWRITE_TAC[definition `arithmetic` `MULT`; theorem `arithmetic` `MULT_0`])) and msym = PROVE("!m n. m * n = n * m", MATCH_ACCEPT_TAC (theorem `arithmetic` `MULT_SYM`)) and multop = "$*" and xv = "x:num" and pv = "p:num" and zero = "0" and plusop = "$+" and eqop = "=:num->num->bool" in let mulpr x y = let xn = term_of_int x and yn = term_of_int y in let step = SPEC yn mstep in let pat = mk_comb(mk_comb(eqop,(mk_comb(mk_comb(multop,xv),yn))), mk_comb(mk_comb(plusop,pv),yn)) in letref w, wn, p, th = 0, zero, 0, SPEC yn mbase in while w < x do (th := TRANS (let st = SPEC wn step in SUBST [(SYM (num_CONV(wn:=term_of_int(w:=w+1))),xv); (th,pv)] pat st) (ADD_CONV (mk_comb(mk_comb(plusop,(term_of_int p)),yn))); p := p + y); th in \tm. (let [xn;yn] = dest_op multop tm in let x = int_of_term xn and y = int_of_term yn in if x = 0 then SPEC yn mbase else if y = 0 then SPEC xn mzero else if x < y then mulpr x y else TRANS (SPECL [xn;yn] msym) (mulpr y x)) ? failwith `MUL_CONV`;; %-----------------------------------------------------------------------% % EXP_CONV "[x] EXP [y]" = |- [x] EXP [y] = [x**y] % %-----------------------------------------------------------------------% let EXP_CONV = let [ebase; estep] = CONJUNCTS (PROVE ("(!m. m EXP 0 = 1) /\ (!m n. m EXP (SUC n) = m * (m EXP n))", REWRITE_TAC[definition `arithmetic` `EXP`])) and expop = "EXP" and multop = "$*" and zero = "0" and ev = "e:num" and eqop = "$=:num->num->bool" and yv = "y:num" in \tm. (let [xn;yn] = dest_op expop tm in let x = int_of_term xn and y = int_of_term yn and step = SPEC xn estep in let pat = mk_comb(mk_comb(eqop,mk_comb(mk_comb(expop,xn),yv)), mk_comb(mk_comb(multop,xn),ev)) in letref z, zn, e, th = 0, zero, 1, SPEC xn ebase in while z < y do (th := TRANS (let st = SPEC zn step in SUBST [(SYM (num_CONV(zn:=term_of_int(z:=z+1))),yv); (th,ev)] pat st) (MUL_CONV (mk_comb(mk_comb(multop,xn),term_of_int e))); e := x * e); th) ? failwith `EXP_CONV`;; %-----------------------------------------------------------------------% % DIV_CONV "[x] DIV [y]" = |- [x] DIV [y] = [x div y] % %-----------------------------------------------------------------------% let DIV_CONV = let divt = PROVE("(q * y = p) ==> (p + r = x) ==> (r < y) ==> (x DIV y = q)", REPEAT DISCH_TAC THEN MATCH_MP_TAC (theorem `arithmetic` `DIV_UNIQUE`) THEN EXISTS_TAC "r:num" THEN ASM_REWRITE_TAC[]) and divop = "$DIV" and multop = "$*" and plusop = "$+" and xv,yv,pv,qv,rv = "x:num","y:num","p:num","q:num","r:num" in \tm. (let [xn;yn] = dest_op divop tm in let x = int_of_term xn and y = int_of_term yn in let q = x / y in let p = q * y in let r = x - p in let pn = term_of_int p and qn = term_of_int q and rn = term_of_int r in let p1 = MUL_CONV (mk_comb(mk_comb(multop,qn),yn)) and p2 = ADD_CONV (mk_comb(mk_comb(plusop,pn),rn)) and p3 = provelt r y and chain = INST[(xn,xv); (yn,yv); (pn,pv); (qn,qv); (rn,rv)] divt in MP (MP (MP chain p1) p2) p3) ? failwith `DIV_CONV`;; %-----------------------------------------------------------------------% % MOD_CONV "[x] MOD [y]" = |- [x] MOD [y] = [x mod y] % %-----------------------------------------------------------------------% let MOD_CONV = let modt = PROVE("(q * y = p) ==> (p + r = x) ==> (r < y) ==> (x MOD y = r)", REPEAT DISCH_TAC THEN MATCH_MP_TAC (theorem `arithmetic` `MOD_UNIQUE`) THEN EXISTS_TAC "q:num" THEN ASM_REWRITE_TAC[]) and modop = "$MOD" and multop = "$*" and plusop = "$+" and xv,yv,pv,qv,rv = "x:num","y:num","p:num","q:num","r:num" in \tm. (let [xn;yn] = dest_op modop tm in let x = int_of_term xn and y = int_of_term yn in let q = x / y in let p = q * y in let r = x - p in let pn = term_of_int p and qn = term_of_int q and rn = term_of_int r in let p1 = MUL_CONV (mk_comb(mk_comb(multop,qn),yn)) and p2 = ADD_CONV (mk_comb(mk_comb(plusop,pn),rn)) and p3 = provelt r y and chain = INST[(xn,xv); (yn,yv); (pn,pv); (qn,qv); (rn,rv)] modt in MP (MP (MP chain p1) p2) p3) ? failwith `MOD_CONV`;; hol88-2.02.19940316/Library/reduce/boolconv.ml0000640000212700021270000002037605111010514016746 0ustar cammcamm%****************************************************************************** ** LIBRARY: reduce (Part I) ** ** ** ** DESCRIPTION: Conversions for reducing boolean expressions. ** ** ** ** AUTHOR: John Harrison ** ** University of Cambridge Computer Laboratory ** ** New Museums Site ** ** Pembroke Street ** ** Cambridge CB2 3QG ** ** England. ** ** ** ** jrh@cl.cam.ac.uk ** ** ** ** DATE: 18th May 1991 ** ******************************************************************************% %-----------------------------------------------------------------------% % dest_op - Split application down spine, checking head operator % %-----------------------------------------------------------------------% let dest_op op tm = snd ((assert (curry $= op) # I) (strip_comb tm));; %-----------------------------------------------------------------------% % NOT_CONV "~F" = |- ~F = T % % NOT_CONV "~T" = |- ~T = F % % NOT_CONV "~~t" = |- ~~t = t % %-----------------------------------------------------------------------% let NOT_CONV = let [c1;c2;c3] = CONJUNCTS (PROVE("(~T = F) /\ (~F = T) /\ (!t. ~~t = t)", REWRITE_TAC[NOT_CLAUSES])) and T = "T" and F = "F" and notop = "$~" in \tm. (let [xn] = dest_op notop tm in if xn = T then c1 else if xn = F then c2 else let [xn] = dest_op notop xn in SPEC xn c3) ? failwith `NOT_CONV`;; %-----------------------------------------------------------------------% % AND_CONV "T /\ t" = |- T /\ t = t % % AND_CONV "t /\ T" = |- t /\ T = t % % AND_CONV "F /\ t" = |- F /\ t = F % % AND_CONV "t /\ F" = |- t /\ F = F % % AND_CONV "t /\ t" = |- t /\ t = t % %-----------------------------------------------------------------------% let AND_CONV = let [c1;c2;c3;c4;c5] = CONJUNCTS (PROVE("(!t. T /\ t = t) /\ (!t. t /\ T = t) /\ (!t. F /\ t = F) /\ (!t. t /\ F = F) /\ (!t. t /\ t = t)",REWRITE_TAC[AND_CLAUSES])) and T = "T" and F = "F" and andop = "$/\" and zv = "z:bool" and beqop = "=:bool->bool->bool" in \tm. (let [xn;yn] = dest_op andop tm in if xn = T then SPEC yn c1 else if yn = T then SPEC xn c2 else if xn = F then SPEC yn c3 else if yn = F then SPEC xn c4 else if xn = yn then SPEC xn c5 else if aconv xn yn then SUBST [(ALPHA xn yn,zv)] (mk_comb(mk_comb(beqop,mk_comb(mk_comb(andop,xn),zv)),xn)) (SPEC xn c5) else fail) ? failwith `AND_CONV`;; %-----------------------------------------------------------------------% % OR_CONV "T \/ t" = |- T \/ t = T % % OR_CONV "t \/ T" = |- t \/ T = T % % OR_CONV "F \/ t" = |- F \/ t = t % % OR_CONV "t \/ F" = |- t \/ F = t % % OR_CONV "t \/ t" = |- t \/ t = t % %-----------------------------------------------------------------------% let OR_CONV = let [c1;c2;c3;c4;c5] = CONJUNCTS (PROVE("(!t. T \/ t = T) /\ (!t. t \/ T = T) /\ (!t. F \/ t = t) /\ (!t. t \/ F = t) /\ (!t. t \/ t = t)",REWRITE_TAC[OR_CLAUSES])) and T = "T" and F = "F" and orop = "$\/" and zv = "z:bool" and beqop = "=:bool->bool->bool" in \tm. (let [xn;yn] = dest_op orop tm in if xn = T then SPEC yn c1 else if yn = T then SPEC xn c2 else if xn = F then SPEC yn c3 else if yn = F then SPEC xn c4 else if xn = yn then SPEC xn c5 else if aconv xn yn then SUBST [(ALPHA xn yn,zv)] (mk_comb(mk_comb(beqop,mk_comb(mk_comb(orop,xn),zv)),xn)) (SPEC xn c5) else fail) ? failwith `OR_CONV`;; %-----------------------------------------------------------------------% % IMP_CONV "T ==> t" = |- T ==> t = t % % IMP_CONV "t ==> T" = |- t ==> T = T % % IMP_CONV "F ==> t" = |- F ==> t = T % % IMP_CONV "t ==> F" = |- t ==> F = ~t % % IMP_CONV "t ==> t" = |- t ==> t = T % %-----------------------------------------------------------------------% let IMP_CONV = let [c1;c2;c3;c4;c5] = CONJUNCTS (PROVE("(!t. (T ==> t) = t) /\ (!t. (t ==> T) = T) /\ (!t. (F ==> t) = T) /\ (!t. (t ==> F) = ~t) /\ (!t. (t ==> t) = T)",REWRITE_TAC[IMP_CLAUSES])) and T = "T" and F = "F" and impop = "$==>" and zv = "z:bool" and beqop = "=:bool->bool->bool" in \tm. (let [xn;yn] = dest_op impop tm in if xn = T then SPEC yn c1 else if yn = T then SPEC xn c2 else if xn = F then SPEC yn c3 else if yn = F then SPEC xn c4 else if xn = yn then SPEC xn c5 else if aconv xn yn then SUBST [(ALPHA xn yn,zv)] (mk_comb(mk_comb(beqop,mk_comb(mk_comb(impop,xn),zv)),T)) (SPEC xn c5) else fail) ? failwith `IMP_CONV`;; %-----------------------------------------------------------------------% % BEQ_CONV "T = t" = |- T = t = t % % BEQ_CONV "t = T" = |- t = T = t % % BEQ_CONV "F = t" = |- F = t = ~t % % BEQ_CONV "t = F" = |- t = F = ~t % % BEQ_CONV "t = t" = |- t = t = T % %-----------------------------------------------------------------------% let BEQ_CONV = let [c1;c2;c3;c4;c5] = CONJUNCTS (PROVE("(!t. (T = t) = t) /\ (!t. (t = T) = t) /\ (!t. (F = t) = ~t) /\ (!t. (t = F) = ~t) /\ (!t:bool. (t = t) = T)", REWRITE_TAC[EQ_CLAUSES])) and T = "T" and F = "F" and beqop = "$=:bool->bool->bool" and zv = "z:bool" in \tm. (let [xn;yn] = dest_op beqop tm in if xn = T then SPEC yn c1 else if yn = T then SPEC xn c2 else if xn = F then SPEC yn c3 else if yn = F then SPEC xn c4 else if xn = yn then SPEC xn c5 else if aconv xn yn then EQT_INTRO (ALPHA xn yn) else fail) ? failwith `BEQ_CONV`;; %-----------------------------------------------------------------------% % COND_CONV "F => t1 | t2" = |- (T => t1 | t2) = t2 % % COND_CONV "T => t1 | t2" = |- (T => t1 | t2) = t1 % % COND_CONV "b => t | t = |- (b => t | t) = t % %-----------------------------------------------------------------------% let COND_CONV = let [c1;c2;c3] = CONJUNCTS (PROVE("(!t1 t2. (T => t1 | t2) = (t1:*)) /\ (!t1 t2. (F => t1 | t2) = (t2:*)) /\ (!b t. (b => t | t) = (t:*))", REWRITE_TAC[COND_CLAUSES; COND_ID])) and T = "T" and F = "F" and ty = ":*" in \tm. (let (b,t1,t2) = dest_cond tm in if b = T then SPECL[t1;t2] (INST_TYPE[(type_of t1,ty)] c1) else if b = F then SPECL[t1;t2] (INST_TYPE[(type_of t1,ty)] c2) else if t1 = t2 then SPECL[b;t1] (INST_TYPE[(type_of t1,ty)] c3) else if aconv t1 t2 then TRANS (AP_TERM (rator tm) (ALPHA t2 t1)) (SPECL [b; t1] (INST_TYPE [(type_of t1,ty)] c3)) else fail) ? failwith `COND_CONV`;; hol88-2.02.19940316/Library/reduce/reduce.ml0000640000212700021270000000634405036073324016411 0ustar cammcamm%****************************************************************************** ** LIBRARY: reduce (part III) ** ** ** ** DESCRIPTION: Reduction tools using all the conversions in the library ** ** ** ** AUTHOR: John Harrison ** ** University of Cambridge Computer Laboratory ** ** New Museums Site ** ** Pembroke Street ** ** Cambridge CB2 3QG ** ** England. ** ** ** ** jrh@cl.cam.ac.uk ** ** ** ** DATE: 18th May 1991 ** ** REVISED: 8th July 1991 ** ******************************************************************************% %-----------------------------% % Extend the help search path % %-----------------------------% tty_write `Extending help search path`; let path = library_pathname()^`/reduce/help/entries/` in set_help_search_path (union [path] (help_search_path()));; %------------------------------% % Load the boolean conversions % %------------------------------% tty_write `\ Loading boolean conversions`; load (library_pathname()^`/reduce/boolconv`,get_flag_value `print_lib`);; %---------------------------------% % Load the arithmetic conversions % %---------------------------------% tty_write `\ Loading arithmetic conversions`; load (library_pathname()^`/reduce/arithconv`,get_flag_value `print_lib`);; tty_write `\ Loading general conversions, rule and tactic`;; %-----------------------------------------------------------------------% % RED_CONV - Try all the conversions in the library % %-----------------------------------------------------------------------% let RED_CONV = let FAIL_CONV (s:string) (tm:term) = (failwith s) :thm in itlist $ORELSEC [ADD_CONV; AND_CONV; BEQ_CONV; COND_CONV; DIV_CONV; EXP_CONV; GE_CONV; GT_CONV; IMP_CONV; LE_CONV; LT_CONV; MOD_CONV; MUL_CONV; NEQ_CONV; NOT_CONV; OR_CONV; PRE_CONV; SBC_CONV; SUC_CONV] (FAIL_CONV `RED_CONV`);; %-----------------------------------------------------------------------% % REDUCE_CONV - Perform above reductions at any depth. % %-----------------------------------------------------------------------% let REDUCE_CONV = DEPTH_CONV RED_CONV;; %-----------------------------------------------------------------------% % REDUCE_RULE and REDUCE_TAC - Inference rule and tactic versions. % %-----------------------------------------------------------------------% let REDUCE_RULE = CONV_RULE REDUCE_CONV;; let REDUCE_TAC = CONV_TAC REDUCE_CONV;; hol88-2.02.19940316/Library/parser/0000750000212700021270000000000005533117214014624 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/0000750000212700021270000000000005227250244016403 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/HOL/0000750000212700021270000000000005227256302017026 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/HOL/Makefile0000640000212700021270000000303104716761163020474 0ustar cammcamm# Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol_12/hol # General definitions for all generated parsers: GENERAL=/usr/groups/hol/hol_12/Library/parser/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. term_help_ml.o: term_help.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `term_help`;;'\ 'quit();;' | $(HOL) # Now compile the declarations: type_decls_ml.o: term_help_ml.o type_decls.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `term_help`;;'\ 'compilet `type_decls`;;'\ 'quit();;' | $(HOL) term_decls_ml.o: type_decls_ml.o term_decls.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `term_help`;;'\ 'loadf `type_decls`;;'\ 'compilet `term_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions type_ml.o: term_decls_ml.o type.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `term_help`;;'\ 'loadf `type_decls`;;'\ 'loadf `term_decls`;;'\ 'compilet `type`;;'\ 'quit();;' | $(HOL) term_ml.o: term.ml type_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `term_help`;;'\ 'loadf `type_decls`;;'\ 'loadf `term_decls`;;'\ 'loadf `type`;;'\ 'compilet `term`;;'\ 'quit();;' | $(HOL) all:: term_ml.o @echo '===> Parser "term" built.' hol88-2.02.19940316/Library/parser/Examples/HOL/READ-ME0000640000212700021270000000223105034370633017762 0ustar cammcammThis directory contains a subset of the HOL term parser. In order to accomplish the typechecking properly, some lisp hacks were implemented by MJCG. We parse to a recursive data type that is then sent to the HOL typechecker for conversion to a term. The datatype is defined to mirror the construction of the underlying representation of terms as much as possible. The type parser defined in the user guide is incorporated into the term parser. In order to do so, modifications were required to the action symbols defined for the raw type parser. The functionality is the same, it was only necessary to modify them to reflect the new data type they are dealing with. The term parser is a more extended excercise in operator precedence. For that reason, the grammar is looks extensive. It is, however, only repetitive. The files *.grm contain the grammars for the term parser. term_help.ml defines the action symbols. To make, change the pathnames in Makefile to suit your purposes. To load in the parser, change the pathname to general.ml in loader.ml, and then perform a loadf on it. The parser may be re-generated from scratch by parsing *.grm in any order. hol88-2.02.19940316/Library/parser/Examples/HOL/term.grm0000640000212700021270000002371404716764672020534 0ustar cammcammFIRST_CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 *`. CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 ' *`. USEFUL [(`\``,`\``)]. MAIN_LOOP --> Term [EOF]. Term --> [\\] {preterm_abs(Var_or_const,Abstraction)} | Term1 more_Term. Abstraction --> [.] Term | [\\] {preterm_abs(Var_or_const,Abstraction)} | {preterm_abs(Var_or_const,Abstraction)}. Term1 --> [~] {mk_unop_typed(`~`,Term1,`bool`,`bool`)} | [(] Term [)] is_typed | [\[] Term_list is_typed | [CONS] {mk_binop_untyped(`CONS`,Term,Term)} | Var_or_const. Term_list --> [\]] {preterm_const(`NIL`)} | {mk_cons(Term,rest_of_list)}. rest_of_list --> [;] {mk_cons(Term,rest_of_list)} | [\]] {preterm_const(`NIL`)}. Var_or_const --> [`] {string_const(WORD)} [`] is_typed | [NIL] {preterm_const(`NIL`)} is_typed | {num_const(TOKEN)} is_typed | {bool_const(TOKEN)} is_typed | {preterm_var(TOKEN)} is_typed. is_typed --> [:] {change_to_typed(POP,typ)} | []. more_Term --> [o] {mk_binop_untyped(`o`,POP,Term)} | [Sum] {mk_binop_untyped(`Sum`,POP,Term)} | [IS_ASSUMPTION_OF] {mk_binop_untyped(`IS_ASSUMPTION_OF`,POP,Term)} | [=] Term1 EQ_lower {mk_binop_untyped(`=`,POP,more_EQ)} {mk_binop_untyped(`=`,POP,POP)} EQ_higher | [<=>] Term1 IFF_lower {mk_binop_typed(`<=>`,POP,more_IFF,`bool`,`bool`,`bool`)} {mk_binop_typed(`<=>`,POP,POP,`bool`,`bool`,`bool`)} IFF_higher | [==>] Term1 IMP_lower {mk_binop_typed(`==>`,POP,more_IMP,`bool`,`bool`,`bool`)} {mk_binop_typed(`==>`,POP,POP,`bool`,`bool`,`bool`)} IMP_higher | [\\/] Term1 DISJ_lower {mk_binop_typed(`\\/`,POP,more_DISJ,`bool`,`bool`,`bool`)} {mk_binop_typed(`\\/`,POP,POP,`bool`,`bool`,`bool`)} DISJ_higher | [/\\] Term1 CONJ_lower {mk_binop_typed(`/\\`,POP,more_CONJ,`bool`,`bool`,`bool`)} {mk_binop_typed(`/\\`,POP,POP,`bool`,`bool`,`bool`)} CONJ_higher | [>] Term1 BOOL_lower {mk_binop_typed(`>`,POP,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`>`,POP,POP,`num`,`num`,`bool`)} BOOL_higher | [<] Term1 BOOL_lower {mk_binop_typed(`<`,POP,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`<`,POP,POP,`num`,`num`,`bool`)} BOOL_higher | [>=] Term1 BOOL_lower {mk_binop_typed(`>=`,POP,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`>=`,POP,POP,`num`,`num`,`bool`)} BOOL_higher | [<=] Term1 BOOL_lower {mk_binop_typed(`<=`,POP,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`<=`,POP,POP,`num`,`num`,`bool`)} BOOL_higher | [+] Term1 P_M_lower {mk_binop_typed(`+`,POP,more_P_M,`num`,`num`,`num`)} {mk_binop_typed(`+`,POP,POP,`num`,`num`,`num`)} P_M_higher | [-] Term1 P_M_lower {mk_binop_typed(`-`,POP,more_P_M,`num`,`num`,`num`)} {mk_binop_typed(`-`,POP,POP,`num`,`num`,`num`)} P_M_higher | [*] Term1 MLT_lower {mk_binop_typed(`*`,POP,more_MLT,`num`,`num`,`num`)} {mk_binop_typed(`*`,POP,POP,`num`,`num`,`num`)} MLT_higher | [DIV] Term1 D_M_lower {mk_binop_typed(`DIV`,POP,more_D_M,`num`,`num`,`num`)} {mk_binop_typed(`DIV`,POP,POP,`num`,`num`,`num`)} D_M_higher | [MOD] Term1 D_M_lower {mk_binop_typed(`MOD`,POP,more_D_M,`num`,`num`,`num`)} {mk_binop_typed(`MOD`,POP,POP,`num`,`num`,`num`)} D_M_higher | [EXP] {mk_binop_typed(`EXP`,Term1,more_EXP,`num`,`num`,`num`)} {mk_binop_typed(`EXP`,POP,POP,`num`,`num`,`num`)} EXP_higher | {IS_infix(WORD)} {arbit_binop3(POP,POP,Term1,more_arbit)} arbit_higher | []. more_arbit --> {IS_infix(WORD)} {arbit_binop2(POP,Term1,more_arbit)} | {dummy}. more_EXP --> [EXP] Term1 EXP_lower {mk_binop_typed(`EXP`,POP,more_EXP,`num`,`num`,`num`)} | {dummy}. EXP_lower --> {IS_infix(WORD)} {arbit_binop3(POP,POP,Term1,more_arbit)} | []. more_D_M --> [DIV] Term1 D_M_lower {mk_binop_typed(`DIV`,POP,more_D_M,`num`,`num`,`num`)} | [MOD] Term1 D_M_lower {mk_binop_typed(`MOD`,POP,more_D_M,`num`,`num`,`num`)} | {dummy}. D_M_lower --> [EXP] {mk_binop_typed(`EXP`,Term1,more_EXP,`num`,`num`,`num`)} {mk_binop_typed(`EXP`,POP,POP,`num`,`num`,`num`)} | EXP_lower. more_MLT --> [*] Term1 MLT_lower {mk_binop_typed(`*`,POP,more_MLT,`num`,`num`,`num`)} | {dummy}. MLT_lower --> [DIV] {mk_binop_typed(`DIV`,Term1,more_D_M,`num`,`num`,`num`)} {mk_binop_typed(`DIV`,POP,POP,`num`,`num`,`num`)} | [MOD] {mk_binop_typed(`MOD`,Term1,more_D_M,`num`,`num`,`num`)} {mk_binop_typed(`MOD`,POP,POP,`num`,`num`,`num`)} | D_M_lower. more_P_M --> [+] Term1 P_M_lower {mk_binop_typed(`+`,POP,more_P_M,`num`,`num`,`num`)} | [-] Term1 P_M_lower {mk_binop_typed(`-`,POP,more_P_M,`num`,`num`,`num`)} | {dummy}. P_M_lower --> [*] {mk_binop_typed(`*`,Term1,more_MLT,`num`,`num`,`num`)} {mk_binop_typed(`*`,POP,POP,`num`,`num`,`num`)} | MLT_lower. more_BOOL --> [<] Term1 BOOL_lower {mk_binop_typed(`<`,POP,more_BOOL,`num`,`num`,`bool`)} | [>] Term1 BOOL_lower {mk_binop_typed(`>`,POP,more_BOOL,`num`,`num`,`bool`)} | [<=] Term1 BOOL_lower {mk_binop_typed(`<=`,POP,more_BOOL,`num`,`num`,`bool`)} | [>=] Term1 BOOL_lower {mk_binop_typed(`>=`,POP,more_BOOL,`num`,`num`,`bool`)} | {dummy}. BOOL_lower --> [+] {mk_binop_typed(`+`,Term1,more_P_M,`num`,`num`,`num`)} {mk_binop_typed(`+`,POP,POP,`num`,`num`,`num`)} | [-] {mk_binop_typed(`-`,Term1,more_P_M,`num`,`num`,`num`)} {mk_binop_typed(`-`,POP,POP,`num`,`num`,`num`)} | P_M_lower. more_CONJ --> [/\\] Term1 CONJ_lower {mk_binop_typed(`/\\`,POP,more_CONJ,`bool`,`bool`,`bool`)} | {dummy}. CONJ_lower --> [<] {mk_binop_typed(`<`,Term1,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`<`,POP,POP,`num`,`num`,`bool`)} | [>] {mk_binop_typed(`>`,Term1,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`>`,POP,POP,`num`,`num`,`bool`)} | [<=] {mk_binop_typed(`<=`,Term1,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`<=`,POP,POP,`num`,`num`,`bool`)} | [>=] {mk_binop_typed(`>=`,Term1,more_BOOL,`num`,`num`,`bool`)} {mk_binop_typed(`>=`,POP,POP,`num`,`num`,`bool`)} | BOOL_lower. more_DISJ --> [\\/] Term1 DISJ_lower {mk_binop_typed(`\\/`,POP,more_DISJ,`bool`,`bool`,`bool`)} | {dummy}. DISJ_lower --> [/\\] {mk_binop_typed(`/\\`,Term1,more_CONJ,`bool`,`bool`,`bool`)} {mk_binop_typed(`/\\`,POP,POP,`bool`,`bool`,`bool`)} | CONJ_lower. more_IMP --> [==>] Term1 IMP_lower {mk_binop_typed(`==>`,POP,more_IMP,`bool`,`bool`,`bool`)} | {dummy}. IMP_lower --> [\\/] {mk_binop_typed(`\\/`,Term1,more_DISJ,`bool`,`bool`,`bool`)} {mk_binop_typed(`\\/`,POP,POP,`bool`,`bool`,`bool`)} | DISJ_lower. more_IFF --> [<=>] Term1 IFF_lower {mk_binop_typed(`<=>`,POP,more_IFF,`bool`,`bool`,`bool`)} | {dummy}. IFF_lower --> [==>] {mk_binop_typed(`==>`,Term1,more_IMP,`bool`,`bool`,`bool`)} {mk_binop_typed(`==>`,POP,POP,`bool`,`bool`,`bool`)} | IMP_lower. more_EQ --> [=] Term1 EQ_lower {mk_binop_untyped(`=`,POP,POP)} | {dummy}. EQ_lower --> [<=>] {mk_binop_typed(`<=>`,Term1,more_IFF,`bool`,`bool`,`bool`)} {mk_binop_typed(`<=>`,POP,POP,`bool`,`bool`,`bool`)} | IFF_lower. arbit_higher --> [EXP] {mk_binop_typed(`EXP`,POP,Term,`num`,`num`,`num`)} | EXP_higher. EXP_higher --> [MOD] {mk_binop_typed(`MOD`,POP,Term,`num`,`num`,`num`)} | [DIV] {mk_binop_typed(`DIV`,POP,Term,`bool`,`bool`,`num`)} | D_M_higher. D_M_higher --> [*] {mk_binop_typed(`*`,POP,Term,`num`,`num`,`num`)} | MLT_higher. MLT_higher --> [+] {mk_binop_typed(`+`,POP,Term,`num`,`num`,`num`)} | [-] {mk_binop_typed(`-`,POP,Term,`num`,`num`,`num`)} | P_M_higher. P_M_higher --> [<] {mk_binop_typed(`<`,POP,Term,`num`,`num`,`bool`)} | [<=] {mk_binop_typed(`<=`,POP,Term,`num`,`num`,`bool`)} | [>] {mk_binop_typed(`>`,POP,Term,`num`,`num`,`bool`)} | [>=] {mk_binop_typed(`>=`,POP,Term,`num`,`num`,`bool`)} | BOOL_higher. BOOL_higher --> [/\\] {mk_binop_typed(`/\\`,POP,Term,`bool`,`bool`,`bool`)} | CONJ_higher. CONJ_higher --> [\\/] {mk_binop_typed(`\\/`,POP,Term,`bool`,`bool`,`bool`)} | DISJ_higher. DISJ_higher --> [==>] {mk_binop_typed(`==>`,POP,Term,`bool`,`bool`,`bool`)} | IMP_higher. IMP_higher --> [<=>] {mk_binop_typed(`<=>`,POP,Term,`bool`,`bool`,`bool`)} | IFF_higher. IFF_higher --> [=] {mk_binop_untyped(`=`,POP,Term)} | EQ_higher. EQ_higher --> [o] {mk_binop_untyped(`o`,POP,Term)} | [Sum] {mk_binop_untyped(`Sum`,POP,Term)} | [IS_ASSUMPTION_OF] {mk_binop_untyped(`IS_ASSUMPTION_OF`,POP,Term)} | []. hol88-2.02.19940316/Library/parser/Examples/HOL/type.ml0000640000212700021270000003420205034370741020343 0ustar cammcammtyname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`tyname`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = mk_type_name(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `tyname` whitespace lst `nil`);; tyvar:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`tyvar`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = mk_type_var(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `tyvar` whitespace lst `nil`);; typ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typ`,expected,WORD); (let (type1_0 , result_list , prev, lst) = type1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push type1_0 result_list in let (more_type_1 , result_list , prev, lst) = more_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_type_1 result_list in do_return result_list whitespace `typ` prev lst `nil`);; more_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_type`,expected,WORD); if WORD = `#` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(type1_0,POP_1) in let result_list = push tmp_2 result_list in let (more_prod_type_2 , result_list , prev, lst) = more_prod_type lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push more_prod_type_2 result_list in let (sum_or_fun_type_3 , result_list , prev, lst) = sum_or_fun_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push sum_or_fun_type_3 result_list in do_return result_list whitespace `more_type` prev lst `nil`) else fail ? if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`fun`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_type` prev lst `nil`) else fail ? if WORD = `+` then (let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push type1_0 result_list in let (more_sum_type_1 , result_list , prev, lst) = more_sum_type lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push more_sum_type_1 result_list in let (fun_type_2 , result_list , prev, lst) = fun_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push fun_type_2 result_list in do_return result_list whitespace `more_type` prev lst `nil`) else fail ? (do_return result_list whitespace `more_type` WORD lst expected);; more_prod_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_prod_type`,expected,WORD); if WORD = `#` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(type1_0,POP_1) in let result_list = push tmp_2 result_list in let (more_prod_type_2 , result_list , prev, lst) = more_prod_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_prod_type_2 result_list in do_return result_list whitespace `more_prod_type` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_defd_type(POP_0,`prod`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_prod_type` WORD lst expected);; sum_or_fun_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`sum_or_fun_type`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`sum`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `sum_or_fun_type` prev lst `nil`) else fail ? if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`fun`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `sum_or_fun_type` prev lst `nil`) else fail ? (do_return result_list whitespace `sum_or_fun_type` WORD lst expected);; more_sum_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_sum_type`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = add_to_list_rev(POP_0,POP_1) in let result_list = push tmp_2 result_list in let (type1_2 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push type1_2 result_list in let (more_sum_type_3 , result_list , prev, lst) = more_sum_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_sum_type_3 result_list in do_return result_list whitespace `more_sum_type` prev lst `nil`) else fail ? if WORD = `#` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(type1_0,POP_1) in let result_list = push tmp_2 result_list in let (more_prod_type_2 , result_list , prev, lst) = more_prod_type lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push more_prod_type_2 result_list in let (more_sum_type_3 , result_list , prev, lst) = more_sum_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_sum_type_3 result_list in do_return result_list whitespace `more_sum_type` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = add_to_list_rev(POP_0,POP_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_defd_type(POP_2,`sum`) in let result_list = push tmp_3 result_list in do_return result_list whitespace `more_sum_type` WORD lst expected);; fun_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`fun_type`,expected,WORD); if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`fun`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `fun_type` prev lst `nil`) else fail ? (do_return result_list whitespace `fun_type` WORD lst expected);; type1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`type1`,expected,WORD); if WORD = `(` then (let (typ_0 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push typ_0 result_list in let (poss_cmpnd_type_1 , result_list , prev, lst) = poss_cmpnd_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_cmpnd_type_1 result_list in do_return result_list whitespace `type1` prev lst `nil`) else fail ? (let (tyname_0 , result_list , prev, lst) = tyname lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push tyname_0 result_list in let (more_type1_1 , result_list , prev, lst) = more_type1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_1 result_list in do_return result_list whitespace `type1` prev lst `nil`) ? (let (tyvar_0 , result_list , prev, lst) = tyvar lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push tyvar_0 result_list in let (more_type1_1 , result_list , prev, lst) = more_type1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_1 result_list in do_return result_list whitespace `type1` prev lst `nil`);; poss_cmpnd_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_cmpnd_type`,expected,WORD); if WORD = `)` then (let (more_type1_0 , result_list , prev, lst) = more_type1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_0 result_list in do_return result_list whitespace `poss_cmpnd_type` prev lst `nil`) else fail ? if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,typ_1) in let result_list = push tmp_2 result_list in let (rest_of_cmpnd_2 , result_list , prev, lst) = rest_of_cmpnd lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_cmpnd_2 result_list in do_return result_list whitespace `poss_cmpnd_type` prev lst `nil`) else fail ? fail;; rest_of_cmpnd:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_cmpnd`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,typ_1) in let result_list = push tmp_2 result_list in let (rest_of_cmpnd_2 , result_list , prev, lst) = rest_of_cmpnd lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_cmpnd_2 result_list in do_return result_list whitespace `rest_of_cmpnd` prev lst `nil`) else fail ? if WORD = `)` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (WORD,lst) = gnt lst whitespace whitespace in let TOKENS = explode WORD in let TOKEN_1 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_2 = MK_type(POP_0,TOKEN_1) in let result_list = push tmp_2 result_list in let (more_type1_2 , result_list , prev, lst) = more_type1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_2 result_list in do_return result_list whitespace `rest_of_cmpnd` prev lst `nil`) else fail ? fail;; more_type1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_type1`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let TOKEN_1 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_2 = MK_type(POP_0,TOKEN_1) in let result_list = push tmp_2 result_list in let (more_type1_2 , result_list , prev, lst) = more_type1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_2 result_list in do_return result_list whitespace `more_type1` prev lst `nil`) ? (do_return result_list whitespace `more_type1` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/HOL/loader.ml0000640000212700021270000000171404723165717020643 0ustar cammcamm% Generated parser load file First load some basic definitions: % loadf `/anfs/bigdisc/jvt/fake12/Library/parser/general`;; % Insert any other files you want loaded here: % loadf `/anfs/bigdisc/jvt/fake12/Library/parser/Examples/HOL/term_help`;; % Now load the declarations: % loadf `/anfs/bigdisc/jvt/fake12/Library/parser/Examples/HOL/type_decls`;; loadf `/anfs/bigdisc/jvt/fake12/Library/parser/Examples/HOL/term_decls`;; % Finally load in the function definitions: % loadf `/anfs/bigdisc/jvt/fake12/Library/parser/Examples/HOL/type`;; loadf `/anfs/bigdisc/jvt/fake12/Library/parser/Examples/HOL/term`;; let SEPS = [(`[`,[]);(`]`,[]);(`(`,[]);(`)`,[]);(`+`,[]);(`*`,[]); (`:`,[]);(`=`,[`=`;`>`]);(`\\`,[`/`]);(`/`,[`\\`]); (`<`,[`=`]);(`>`,[`=`]);(`-`,[`>`]);(`#`,[]);(`~`,[]); (`.`,[]);(`,`,[])];; let parse thing = preterm_to_term (PARSE_text(thing,[],SEPS));; set_string_escape 0;; new_syntax_block(`<<`,`>>`,`parse`);; hol88-2.02.19940316/Library/parser/Examples/HOL/term_help.ml0000640000212700021270000001001204716763636021351 0ustar cammcamm% Dest_ functions for pre_terms that do the same as their counterparts in HOL. % let Dest_var (preterm_var x) = x and Dest_const(preterm_const x) = x and Dest_comb(preterm_comb(x,y)) = x,y and left_comb (preterm_comb(x,y)) = x and right_comb (preterm_comb(x,y)) = y and Dest_abs (preterm_abs x) = x and Dest_type (preterm_typed(x,y)) = x,y and Dest_antiquot(preterm_antiquot x) = x;; % Create various types of constants. % let string_const WORD = preterm_const (`\``^WORD^`\``) and bool_const WORD = if mem WORD [`T`;`F`] then preterm_typed (preterm_const WORD,mk_type(`bool`,[])) else preterm_var WORD and num_const WORD = if can int_of_string WORD then preterm_typed (preterm_const WORD,mk_type(`num`,[])) else failwith `non-num`;; % Sometimes we need a dummy variable as a placeholder when the parser is unwinding. % let dummy() = preterm_var `$$FOO$$` and inner(op,T,ty1,ty2,ty3) = preterm_comb(preterm_typed(preterm_const op,mk_type(`fun`,[mk_type(ty1,[]); mk_type(`fun`,[mk_type(ty2,[]); mk_type(ty3,[])])])), T);; % Make the operators, and check to see that we aren't dealing with a placeholder. % let mk_binop_untyped(op,T1,T2) = if can Dest_var T2 then if (Dest_var T2) = `$$FOO$$` then T1 else preterm_comb (preterm_comb(preterm_const op,T1),T2) else preterm_comb (preterm_comb(preterm_const op,T1),T2) and mk_binop_typed (op,T1,T2,ty1,ty2,ty3) = if can Dest_var T2 then if (Dest_var T2) = `$$FOO$$` then T1 else preterm_comb(inner (op,T1,ty1,ty2,ty3),T2) else preterm_comb(inner (op,T1,ty1,ty2,ty3),T2) and mk_unop_untyped(op,thing) = preterm_comb(preterm_const op,thing) and mk_unop_typed(op,thing,typ1,typ2) = preterm_comb(preterm_typed(preterm_const op,mk_type(`fun`,[mk_type(typ1,[]);mk_type(typ2,[])])), thing);; % Functions to make "generic" pre-terms. % let IS_infix thing = if is_infix thing then preterm_const thing else fail and arbit_binop3(prev,op,T1,T2) = let c = Dest_const op in preterm_comb(preterm_comb (preterm_const c,prev),mk_binop_untyped(c,T1,T2)) and arbit_binop2(op,T1,T2) = let c = Dest_const op in mk_binop_untyped(c,T1,T2);; let mk_uncurry thing = preterm_comb(preterm_const `UNCURRY`,thing);; % Modified functions from the type parser. % let mk_type_name thing = preterm_typed (preterm_var`foo`,mk_type(thing,[])) and mk_type_var thing = preterm_typed (preterm_var`foo`,mk_vartype thing) and add_to_list (lst,thing) = let _,ty1 = Dest_type lst and _,ty2 = Dest_type thing in preterm_typed (preterm_var `foo`,mk_type(`prod`,[ty1; ty2])) and add_to_list_rev (lst,thing) = let _,ty1 = Dest_type lst and _,ty2 = Dest_type thing in preterm_typed (preterm_var `foo`,mk_type(`prod`,[ty2; ty1])) and MK_type(lst,op) = let _,ty = Dest_type lst in preterm_typed (preterm_var `foo`,mk_type(op,[ty])) and MK_bin_type(op,type1,typ) = let _,ty1 = Dest_type type1 and _,ty2 = Dest_type typ in preterm_typed (preterm_var `foo`,mk_type(op,[ty1;ty2]));; letrec convert_to_list ty = let name,lst = dest_type ty in if null lst then [mk_type(name,[])] else (hd lst) . (convert_to_list (hd (tl lst)));; letrec fix_defd(lst,op,result) = if null lst then result else fix_defd(tl lst,op,mk_type(op,[hd lst;result]));; let MK_defd_type(thing,op) = let _,foo = Dest_type thing in let ty = convert_to_list foo in preterm_typed (preterm_var `foo`, fix_defd(tl (tl ty),op,mk_type(op,[hd (tl ty);hd ty])));; let change_to_typed(prev,typ) = let _,ty = Dest_type typ in if can Dest_var prev then preterm_typed (preterm_var (Dest_var prev),ty) else preterm_typed (preterm_const (Dest_const prev),ty);; let mk_cons(car,cdr) = preterm_comb(preterm_comb (preterm_const `CONS`,car),cdr);; hol88-2.02.19940316/Library/parser/Examples/HOL/type_decls.ml0000640000212700021270000000546004716763341021531 0ustar cammcammletref tyname (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref tyvar (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref typ (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_type (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_prod_type (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref sum_or_fun_type (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_sum_type (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref fun_type (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref type1 (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref poss_cmpnd_type (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref rest_of_cmpnd (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_type1 (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/HOL/type.grm0000640000212700021270000000225504716612710020524 0ustar cammcammtyname --> {mk_type_name(TOKEN)}. tyvar --> {mk_type_var(TOKEN)}. typ --> type1 more_type. more_type --> [#] {add_to_list(type1,POP)} more_prod_type sum_or_fun_type | [->] {MK_bin_type(`fun`,POP,typ)} | [+] type1 more_sum_type fun_type | []. more_prod_type --> [#] {add_to_list(type1,POP)} more_prod_type | {MK_defd_type(POP,`prod`)}. sum_or_fun_type --> [+] {MK_bin_type(`sum`,POP,typ)} | [->] {MK_bin_type(`fun`,POP,typ)} | []. more_sum_type --> [+] {add_to_list_rev(POP,POP)} type1 more_sum_type | [#] {add_to_list(type1,POP)} more_prod_type more_sum_type | {add_to_list_rev(POP,POP)} {MK_defd_type(POP,`sum`)}. fun_type --> [->] {MK_bin_type(`fun`,POP,typ)} | []. type1 --> [(] typ poss_cmpnd_type | tyname more_type1 | tyvar more_type1. poss_cmpnd_type --> [)] more_type1 | [,] {add_to_list(POP,typ)} rest_of_cmpnd. rest_of_cmpnd --> [,] {add_to_list(POP,typ)} rest_of_cmpnd | [)] {MK_type(POP,TOKEN)} more_type1. more_type1 --> {MK_type(POP,TOKEN)} more_type1 | []. hol88-2.02.19940316/Library/parser/Examples/HOL/term.ml0000640000212700021270000023753305034370720020342 0ustar cammcammMAIN_LOOP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MAIN_LOOP`,expected,WORD); (let (Term_0 , result_list , prev, lst) = Term lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push Term_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `nil` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in do_return result_list whitespace `MAIN_LOOP` WORD lst expected);; let PARSE_file (in_file,whitespace,separators) = let white = if null whitespace then [` `;`\T`;`\L`] else whitespace and inf = open_file `in` in_file in let WORD = e_w_s inf (hd white) white in let lst = read_input inf [] white separators WORD IGNORE USEFUL in let (WORD,lst) = (hd lst,tl lst) in let result = fst (MAIN_LOOP lst (hd white) WORD [] FIRST_CHARS CHARS `nil`) in result ? fail;; let PARSE_text (text,whitespace,separators) = let outf = open_file `out` `/tmp/.000HOL` in write_string text outf; close_file outf; let result = PARSE_file (`/tmp/.000HOL`,whitespace,separators) in unlink `/tmp/.000HOL`; result;; Term:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`Term`,expected,WORD); if WORD = `\\` then (let (Var_or_const_0 , result_list , prev, lst) = Var_or_const lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (Abstraction_1 , result_list , prev, lst) = Abstraction lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = preterm_abs(Var_or_const_0,Abstraction_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `Term` prev lst `nil`) else fail ? (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (more_Term_1 , result_list , prev, lst) = more_Term lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_Term_1 result_list in do_return result_list whitespace `Term` prev lst `nil`);; Abstraction:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`Abstraction`,expected,WORD); if WORD = `.` then (let (Term_0 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push Term_0 result_list in do_return result_list whitespace `Abstraction` prev lst `nil`) else fail ? if WORD = `\\` then (let (Var_or_const_0 , result_list , prev, lst) = Var_or_const lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (Abstraction_1 , result_list , prev, lst) = Abstraction lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = preterm_abs(Var_or_const_0,Abstraction_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `Abstraction` prev lst `nil`) else fail ? (let (Var_or_const_0 , result_list , prev, lst) = Var_or_const lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let (Abstraction_1 , result_list , prev, lst) = Abstraction lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = preterm_abs(Var_or_const_0,Abstraction_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `Abstraction` prev lst `nil`);; Term1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`Term1`,expected,WORD); if WORD = `~` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = mk_unop_typed(`~`,Term1_0,`bool`,`bool`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `Term1` prev lst `nil`) else fail ? if WORD = `(` then (let (Term_0 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push Term_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `Term1` in let TOKENS = explode WORD in let (is_typed_1 , result_list , prev, lst) = is_typed lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_1 result_list in do_return result_list whitespace `Term1` prev lst `nil`) else fail ? if WORD = `[` then (let (Term_list_0 , result_list , prev, lst) = Term_list lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term_list_0 result_list in let (is_typed_1 , result_list , prev, lst) = is_typed lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_1 result_list in do_return result_list whitespace `Term1` prev lst `nil`) else fail ? if WORD = `CONS` then (let (Term_0 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (Term_1 , result_list , prev, lst) = Term lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`CONS`,Term_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `Term1` prev lst `nil`) else fail ? (let (Var_or_const_0 , result_list , prev, lst) = Var_or_const lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push Var_or_const_0 result_list in do_return result_list whitespace `Term1` prev lst `nil`);; Term_list:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`Term_list`,expected,WORD); if WORD = `]` then (let tmp_0 = preterm_const(`NIL`) in let result_list = push tmp_0 result_list in do_return result_list whitespace `Term_list` whitespace lst expected) else fail ? (let (Term_0 , result_list , prev, lst) = Term lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let (rest_of_list_1 , result_list , prev, lst) = rest_of_list lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_cons(Term_0,rest_of_list_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `Term_list` prev lst `nil`);; rest_of_list:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_list`,expected,WORD); if WORD = `;` then (let (Term_0 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (rest_of_list_1 , result_list , prev, lst) = rest_of_list lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_cons(Term_0,rest_of_list_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_list` prev lst `nil`) else fail ? if WORD = `]` then (let tmp_0 = preterm_const(`NIL`) in let result_list = push tmp_0 result_list in do_return result_list whitespace `rest_of_list` whitespace lst expected) else fail ? fail;; Var_or_const:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`Var_or_const`,expected,WORD); if WORD = `\`` then (let (WORD,lst) = gnt lst whitespace whitespace in let TOKENS = explode WORD in let WORD_0 = WORD in let tmp_1 = string_const(WORD_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\`` WORD lst `Var_or_const` in let TOKENS = explode WORD in let (is_typed_1 , result_list , prev, lst) = is_typed lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_1 result_list in do_return result_list whitespace `Var_or_const` prev lst `nil`) else fail ? if WORD = `NIL` then (let tmp_0 = preterm_const(`NIL`) in let result_list = push tmp_0 result_list in let (is_typed_0 , result_list , prev, lst) = is_typed lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_0 result_list in do_return result_list whitespace `Var_or_const` prev lst `nil`) else fail ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_1 = num_const(TOKEN_0) in let result_list = push tmp_1 result_list in let (is_typed_1 , result_list , prev, lst) = is_typed lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_1 result_list in do_return result_list whitespace `Var_or_const` prev lst `nil`) ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_1 = bool_const(TOKEN_0) in let result_list = push tmp_1 result_list in let (is_typed_1 , result_list , prev, lst) = is_typed lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_1 result_list in do_return result_list whitespace `Var_or_const` prev lst `nil`) ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_1 = preterm_var(TOKEN_0) in let result_list = push tmp_1 result_list in let (is_typed_1 , result_list , prev, lst) = is_typed lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push is_typed_1 result_list in do_return result_list whitespace `Var_or_const` prev lst `nil`);; is_typed:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`is_typed`,expected,WORD); if WORD = `:` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = change_to_typed(POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `is_typed` prev lst `nil`) else fail ? (do_return result_list whitespace `is_typed` WORD lst expected);; more_Term:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_Term`,expected,WORD); if WORD = `o` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`o`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `Sum` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`Sum`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `IS_ASSUMPTION_OF` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`IS_ASSUMPTION_OF`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (EQ_lower_1 , result_list , prev, lst) = EQ_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push EQ_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_EQ_3 , result_list , prev, lst) = more_EQ lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_untyped(`=`,POP_2,more_EQ_3) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_untyped(`=`,POP_4,POP_5) in let result_list = push tmp_6 result_list in let (EQ_higher_6 , result_list , prev, lst) = EQ_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push EQ_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `<=>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (IFF_lower_1 , result_list , prev, lst) = IFF_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push IFF_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_IFF_3 , result_list , prev, lst) = more_IFF lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`<=>`,POP_2,more_IFF_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`<=>`,POP_4,POP_5,`bool`,`bool`,`bool`) in let result_list = push tmp_6 result_list in let (IFF_higher_6 , result_list , prev, lst) = IFF_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push IFF_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `==>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (IMP_lower_1 , result_list , prev, lst) = IMP_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push IMP_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_IMP_3 , result_list , prev, lst) = more_IMP lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`==>`,POP_2,more_IMP_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`==>`,POP_4,POP_5,`bool`,`bool`,`bool`) in let result_list = push tmp_6 result_list in let (IMP_higher_6 , result_list , prev, lst) = IMP_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push IMP_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `\\/` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (DISJ_lower_1 , result_list , prev, lst) = DISJ_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push DISJ_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_DISJ_3 , result_list , prev, lst) = more_DISJ lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`\\/`,POP_2,more_DISJ_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`\\/`,POP_4,POP_5,`bool`,`bool`,`bool`) in let result_list = push tmp_6 result_list in let (DISJ_higher_6 , result_list , prev, lst) = DISJ_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push DISJ_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `/\\` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (CONJ_lower_1 , result_list , prev, lst) = CONJ_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push CONJ_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_CONJ_3 , result_list , prev, lst) = more_CONJ lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`/\\`,POP_2,more_CONJ_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`/\\`,POP_4,POP_5,`bool`,`bool`,`bool`) in let result_list = push tmp_6 result_list in let (CONJ_higher_6 , result_list , prev, lst) = CONJ_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push CONJ_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`>`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`>`,POP_4,POP_5,`num`,`num`,`bool`) in let result_list = push tmp_6 result_list in let (BOOL_higher_6 , result_list , prev, lst) = BOOL_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push BOOL_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `<` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`<`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`<`,POP_4,POP_5,`num`,`num`,`bool`) in let result_list = push tmp_6 result_list in let (BOOL_higher_6 , result_list , prev, lst) = BOOL_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push BOOL_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `>=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`>=`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`>=`,POP_4,POP_5,`num`,`num`,`bool`) in let result_list = push tmp_6 result_list in let (BOOL_higher_6 , result_list , prev, lst) = BOOL_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push BOOL_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `<=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`<=`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`<=`,POP_4,POP_5,`num`,`num`,`bool`) in let result_list = push tmp_6 result_list in let (BOOL_higher_6 , result_list , prev, lst) = BOOL_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push BOOL_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `+` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (P_M_lower_1 , result_list , prev, lst) = P_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push P_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_P_M_3 , result_list , prev, lst) = more_P_M lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`+`,POP_2,more_P_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`+`,POP_4,POP_5,`num`,`num`,`num`) in let result_list = push tmp_6 result_list in let (P_M_higher_6 , result_list , prev, lst) = P_M_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push P_M_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `-` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (P_M_lower_1 , result_list , prev, lst) = P_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push P_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_P_M_3 , result_list , prev, lst) = more_P_M lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`-`,POP_2,more_P_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`-`,POP_4,POP_5,`num`,`num`,`num`) in let result_list = push tmp_6 result_list in let (P_M_higher_6 , result_list , prev, lst) = P_M_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push P_M_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `*` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (MLT_lower_1 , result_list , prev, lst) = MLT_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push MLT_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_MLT_3 , result_list , prev, lst) = more_MLT lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`*`,POP_2,more_MLT_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`*`,POP_4,POP_5,`num`,`num`,`num`) in let result_list = push tmp_6 result_list in let (MLT_higher_6 , result_list , prev, lst) = MLT_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push MLT_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `DIV` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (D_M_lower_1 , result_list , prev, lst) = D_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push D_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_D_M_3 , result_list , prev, lst) = more_D_M lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`DIV`,POP_2,more_D_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`DIV`,POP_4,POP_5,`num`,`num`,`num`) in let result_list = push tmp_6 result_list in let (D_M_higher_6 , result_list , prev, lst) = D_M_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push D_M_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `MOD` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (D_M_lower_1 , result_list , prev, lst) = D_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push D_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_D_M_3 , result_list , prev, lst) = more_D_M lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_4 = mk_binop_typed(`MOD`,POP_2,more_D_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_binop_typed(`MOD`,POP_4,POP_5,`num`,`num`,`num`) in let result_list = push tmp_6 result_list in let (D_M_higher_6 , result_list , prev, lst) = D_M_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push D_M_higher_6 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? if WORD = `EXP` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_EXP_1 , result_list , prev, lst) = more_EXP lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_binop_typed(`EXP`,Term1_0,more_EXP_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`EXP`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in let (EXP_higher_4 , result_list , prev, lst) = EXP_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push EXP_higher_4 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) else fail ? (let WORD_0 = WORD in let tmp_1 = IS_infix(WORD_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (Term1_3 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_arbit_4 , result_list , prev, lst) = more_arbit lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_5 = arbit_binop3(POP_1,POP_2,Term1_3,more_arbit_4) in let result_list = push tmp_5 result_list in let (arbit_higher_5 , result_list , prev, lst) = arbit_higher lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push arbit_higher_5 result_list in do_return result_list whitespace `more_Term` prev lst `nil`) ? (do_return result_list whitespace `more_Term` WORD lst expected);; more_arbit:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_arbit`,expected,WORD); (let WORD_0 = WORD in let tmp_1 = IS_infix(WORD_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (Term1_2 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_arbit_3 , result_list , prev, lst) = more_arbit lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = arbit_binop2(POP_1,Term1_2,more_arbit_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_arbit` prev lst `nil`) ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_arbit` WORD lst expected);; more_EXP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_EXP`,expected,WORD); if WORD = `EXP` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (EXP_lower_1 , result_list , prev, lst) = EXP_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push EXP_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_EXP_3 , result_list , prev, lst) = more_EXP lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`EXP`,POP_2,more_EXP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_EXP` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_EXP` WORD lst expected);; EXP_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`EXP_lower`,expected,WORD); (let WORD_0 = WORD in let tmp_1 = IS_infix(WORD_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (Term1_3 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_arbit_4 , result_list , prev, lst) = more_arbit lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_5 = arbit_binop3(POP_1,POP_2,Term1_3,more_arbit_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `EXP_lower` prev lst `nil`) ? (do_return result_list whitespace `EXP_lower` WORD lst expected);; more_D_M:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_D_M`,expected,WORD); if WORD = `DIV` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (D_M_lower_1 , result_list , prev, lst) = D_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push D_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_D_M_3 , result_list , prev, lst) = more_D_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`DIV`,POP_2,more_D_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_D_M` prev lst `nil`) else fail ? if WORD = `MOD` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (D_M_lower_1 , result_list , prev, lst) = D_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push D_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_D_M_3 , result_list , prev, lst) = more_D_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`MOD`,POP_2,more_D_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_D_M` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_D_M` WORD lst expected);; D_M_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`D_M_lower`,expected,WORD); if WORD = `EXP` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_EXP_1 , result_list , prev, lst) = more_EXP lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`EXP`,Term1_0,more_EXP_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`EXP`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `D_M_lower` prev lst `nil`) else fail ? (let (EXP_lower_0 , result_list , prev, lst) = EXP_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push EXP_lower_0 result_list in do_return result_list whitespace `D_M_lower` prev lst `nil`);; more_MLT:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_MLT`,expected,WORD); if WORD = `*` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (MLT_lower_1 , result_list , prev, lst) = MLT_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push MLT_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_MLT_3 , result_list , prev, lst) = more_MLT lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`*`,POP_2,more_MLT_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_MLT` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_MLT` WORD lst expected);; MLT_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MLT_lower`,expected,WORD); if WORD = `DIV` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_D_M_1 , result_list , prev, lst) = more_D_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`DIV`,Term1_0,more_D_M_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`DIV`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `MLT_lower` prev lst `nil`) else fail ? if WORD = `MOD` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_D_M_1 , result_list , prev, lst) = more_D_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`MOD`,Term1_0,more_D_M_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`MOD`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `MLT_lower` prev lst `nil`) else fail ? (let (D_M_lower_0 , result_list , prev, lst) = D_M_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push D_M_lower_0 result_list in do_return result_list whitespace `MLT_lower` prev lst `nil`);; more_P_M:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_P_M`,expected,WORD); if WORD = `+` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (P_M_lower_1 , result_list , prev, lst) = P_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push P_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_P_M_3 , result_list , prev, lst) = more_P_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`+`,POP_2,more_P_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_P_M` prev lst `nil`) else fail ? if WORD = `-` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (P_M_lower_1 , result_list , prev, lst) = P_M_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push P_M_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_P_M_3 , result_list , prev, lst) = more_P_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`-`,POP_2,more_P_M_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_P_M` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_P_M` WORD lst expected);; P_M_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`P_M_lower`,expected,WORD); if WORD = `*` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_MLT_1 , result_list , prev, lst) = more_MLT lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`*`,Term1_0,more_MLT_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`*`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `P_M_lower` prev lst `nil`) else fail ? (let (MLT_lower_0 , result_list , prev, lst) = MLT_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push MLT_lower_0 result_list in do_return result_list whitespace `P_M_lower` prev lst `nil`);; more_BOOL:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_BOOL`,expected,WORD); if WORD = `<` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`<`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_BOOL` prev lst `nil`) else fail ? if WORD = `>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`>`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_BOOL` prev lst `nil`) else fail ? if WORD = `<=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`<=`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_BOOL` prev lst `nil`) else fail ? if WORD = `>=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (BOOL_lower_1 , result_list , prev, lst) = BOOL_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push BOOL_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_BOOL_3 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`>=`,POP_2,more_BOOL_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_BOOL` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_BOOL` WORD lst expected);; BOOL_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`BOOL_lower`,expected,WORD); if WORD = `+` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_P_M_1 , result_list , prev, lst) = more_P_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`+`,Term1_0,more_P_M_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`+`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `BOOL_lower` prev lst `nil`) else fail ? if WORD = `-` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_P_M_1 , result_list , prev, lst) = more_P_M lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`-`,Term1_0,more_P_M_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`-`,POP_2,POP_3,`num`,`num`,`num`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `BOOL_lower` prev lst `nil`) else fail ? (let (P_M_lower_0 , result_list , prev, lst) = P_M_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push P_M_lower_0 result_list in do_return result_list whitespace `BOOL_lower` prev lst `nil`);; more_CONJ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_CONJ`,expected,WORD); if WORD = `/\\` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (CONJ_lower_1 , result_list , prev, lst) = CONJ_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push CONJ_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_CONJ_3 , result_list , prev, lst) = more_CONJ lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`/\\`,POP_2,more_CONJ_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_CONJ` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_CONJ` WORD lst expected);; CONJ_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`CONJ_lower`,expected,WORD); if WORD = `<` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_BOOL_1 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`<`,Term1_0,more_BOOL_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`<`,POP_2,POP_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `CONJ_lower` prev lst `nil`) else fail ? if WORD = `>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_BOOL_1 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`>`,Term1_0,more_BOOL_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`>`,POP_2,POP_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `CONJ_lower` prev lst `nil`) else fail ? if WORD = `<=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_BOOL_1 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`<=`,Term1_0,more_BOOL_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`<=`,POP_2,POP_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `CONJ_lower` prev lst `nil`) else fail ? if WORD = `>=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_BOOL_1 , result_list , prev, lst) = more_BOOL lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`>=`,Term1_0,more_BOOL_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`>=`,POP_2,POP_3,`num`,`num`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `CONJ_lower` prev lst `nil`) else fail ? (let (BOOL_lower_0 , result_list , prev, lst) = BOOL_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push BOOL_lower_0 result_list in do_return result_list whitespace `CONJ_lower` prev lst `nil`);; more_DISJ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_DISJ`,expected,WORD); if WORD = `\\/` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (DISJ_lower_1 , result_list , prev, lst) = DISJ_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push DISJ_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_DISJ_3 , result_list , prev, lst) = more_DISJ lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`\\/`,POP_2,more_DISJ_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_DISJ` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_DISJ` WORD lst expected);; DISJ_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`DISJ_lower`,expected,WORD); if WORD = `/\\` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_CONJ_1 , result_list , prev, lst) = more_CONJ lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`/\\`,Term1_0,more_CONJ_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`/\\`,POP_2,POP_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `DISJ_lower` prev lst `nil`) else fail ? (let (CONJ_lower_0 , result_list , prev, lst) = CONJ_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push CONJ_lower_0 result_list in do_return result_list whitespace `DISJ_lower` prev lst `nil`);; more_IMP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_IMP`,expected,WORD); if WORD = `==>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (IMP_lower_1 , result_list , prev, lst) = IMP_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push IMP_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_IMP_3 , result_list , prev, lst) = more_IMP lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`==>`,POP_2,more_IMP_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_IMP` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_IMP` WORD lst expected);; IMP_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`IMP_lower`,expected,WORD); if WORD = `\\/` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_DISJ_1 , result_list , prev, lst) = more_DISJ lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`\\/`,Term1_0,more_DISJ_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`\\/`,POP_2,POP_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `IMP_lower` prev lst `nil`) else fail ? (let (DISJ_lower_0 , result_list , prev, lst) = DISJ_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push DISJ_lower_0 result_list in do_return result_list whitespace `IMP_lower` prev lst `nil`);; more_IFF:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_IFF`,expected,WORD); if WORD = `<=>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (IFF_lower_1 , result_list , prev, lst) = IFF_lower lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push IFF_lower_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (more_IFF_3 , result_list , prev, lst) = more_IFF lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_4 = mk_binop_typed(`<=>`,POP_2,more_IFF_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_IFF` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_IFF` WORD lst expected);; IFF_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`IFF_lower`,expected,WORD); if WORD = `==>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_IMP_1 , result_list , prev, lst) = more_IMP lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`==>`,Term1_0,more_IMP_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`==>`,POP_2,POP_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `IFF_lower` prev lst `nil`) else fail ? (let (IMP_lower_0 , result_list , prev, lst) = IMP_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push IMP_lower_0 result_list in do_return result_list whitespace `IFF_lower` prev lst `nil`);; more_EQ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_EQ`,expected,WORD); if WORD = `=` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push Term1_0 result_list in let (EQ_lower_1 , result_list , prev, lst) = EQ_lower lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push EQ_lower_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_untyped(`=`,POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_EQ` prev lst `nil`) else fail ? (let tmp_0 = dummy() in let result_list = push tmp_0 result_list in do_return result_list whitespace `more_EQ` WORD lst expected);; EQ_lower:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`EQ_lower`,expected,WORD); if WORD = `<=>` then (let (Term1_0 , result_list , prev, lst) = Term1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (more_IFF_1 , result_list , prev, lst) = more_IFF lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`<=>`,Term1_0,more_IFF_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_binop_typed(`<=>`,POP_2,POP_3,`bool`,`bool`,`bool`) in let result_list = push tmp_4 result_list in do_return result_list whitespace `EQ_lower` prev lst `nil`) else fail ? (let (IFF_lower_0 , result_list , prev, lst) = IFF_lower lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push IFF_lower_0 result_list in do_return result_list whitespace `EQ_lower` prev lst `nil`);; arbit_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`arbit_higher`,expected,WORD); if WORD = `EXP` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`EXP`,POP_0,Term_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `arbit_higher` prev lst `nil`) else fail ? (let (EXP_higher_0 , result_list , prev, lst) = EXP_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push EXP_higher_0 result_list in do_return result_list whitespace `arbit_higher` prev lst `nil`);; EXP_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`EXP_higher`,expected,WORD); if WORD = `MOD` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`MOD`,POP_0,Term_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `EXP_higher` prev lst `nil`) else fail ? if WORD = `DIV` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`DIV`,POP_0,Term_1,`bool`,`bool`,`num`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `EXP_higher` prev lst `nil`) else fail ? (let (D_M_higher_0 , result_list , prev, lst) = D_M_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push D_M_higher_0 result_list in do_return result_list whitespace `EXP_higher` prev lst `nil`);; D_M_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`D_M_higher`,expected,WORD); if WORD = `*` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`*`,POP_0,Term_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `D_M_higher` prev lst `nil`) else fail ? (let (MLT_higher_0 , result_list , prev, lst) = MLT_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push MLT_higher_0 result_list in do_return result_list whitespace `D_M_higher` prev lst `nil`);; MLT_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MLT_higher`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`+`,POP_0,Term_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `MLT_higher` prev lst `nil`) else fail ? if WORD = `-` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`-`,POP_0,Term_1,`num`,`num`,`num`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `MLT_higher` prev lst `nil`) else fail ? (let (P_M_higher_0 , result_list , prev, lst) = P_M_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push P_M_higher_0 result_list in do_return result_list whitespace `MLT_higher` prev lst `nil`);; P_M_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`P_M_higher`,expected,WORD); if WORD = `<` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`<`,POP_0,Term_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `P_M_higher` prev lst `nil`) else fail ? if WORD = `<=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`<=`,POP_0,Term_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `P_M_higher` prev lst `nil`) else fail ? if WORD = `>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`>`,POP_0,Term_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `P_M_higher` prev lst `nil`) else fail ? if WORD = `>=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`>=`,POP_0,Term_1,`num`,`num`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `P_M_higher` prev lst `nil`) else fail ? (let (BOOL_higher_0 , result_list , prev, lst) = BOOL_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push BOOL_higher_0 result_list in do_return result_list whitespace `P_M_higher` prev lst `nil`);; BOOL_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`BOOL_higher`,expected,WORD); if WORD = `/\\` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`/\\`,POP_0,Term_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `BOOL_higher` prev lst `nil`) else fail ? (let (CONJ_higher_0 , result_list , prev, lst) = CONJ_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push CONJ_higher_0 result_list in do_return result_list whitespace `BOOL_higher` prev lst `nil`);; CONJ_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`CONJ_higher`,expected,WORD); if WORD = `\\/` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`\\/`,POP_0,Term_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `CONJ_higher` prev lst `nil`) else fail ? (let (DISJ_higher_0 , result_list , prev, lst) = DISJ_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push DISJ_higher_0 result_list in do_return result_list whitespace `CONJ_higher` prev lst `nil`);; DISJ_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`DISJ_higher`,expected,WORD); if WORD = `==>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`==>`,POP_0,Term_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `DISJ_higher` prev lst `nil`) else fail ? (let (IMP_higher_0 , result_list , prev, lst) = IMP_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push IMP_higher_0 result_list in do_return result_list whitespace `DISJ_higher` prev lst `nil`);; IMP_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`IMP_higher`,expected,WORD); if WORD = `<=>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_typed(`<=>`,POP_0,Term_1,`bool`,`bool`,`bool`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `IMP_higher` prev lst `nil`) else fail ? (let (IFF_higher_0 , result_list , prev, lst) = IFF_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push IFF_higher_0 result_list in do_return result_list whitespace `IMP_higher` prev lst `nil`);; IFF_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`IFF_higher`,expected,WORD); if WORD = `=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`=`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `IFF_higher` prev lst `nil`) else fail ? (let (EQ_higher_0 , result_list , prev, lst) = EQ_higher lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push EQ_higher_0 result_list in do_return result_list whitespace `IFF_higher` prev lst `nil`);; EQ_higher:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`EQ_higher`,expected,WORD); if WORD = `o` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`o`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `EQ_higher` prev lst `nil`) else fail ? if WORD = `Sum` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`Sum`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `EQ_higher` prev lst `nil`) else fail ? if WORD = `IS_ASSUMPTION_OF` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (Term_1 , result_list , prev, lst) = Term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_binop_untyped(`IS_ASSUMPTION_OF`,POP_0,Term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `EQ_higher` prev lst `nil`) else fail ? (do_return result_list whitespace `EQ_higher` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/HOL/term_decls.ml0000640000212700021270000002455204716763570021526 0ustar cammcammFIRST_CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 *`;; CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 ' *`;; USEFUL := [(`\``,`\``)];; letref MAIN_LOOP (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref Term (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref Abstraction (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref Term1 (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref Term_list (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref rest_of_list (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref Var_or_const (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref is_typed (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_Term (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_arbit (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_EXP (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref EXP_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_D_M (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref D_M_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_MLT (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref MLT_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_P_M (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref P_M_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_BOOL (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref BOOL_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_CONJ (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref CONJ_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_DISJ (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref DISJ_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_IMP (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref IMP_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_IFF (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref IFF_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref more_EQ (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref EQ_lower (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref arbit_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref EXP_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref D_M_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref MLT_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref P_M_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref BOOL_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref CONJ_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref DISJ_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref IMP_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref IFF_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letref EQ_higher (lst:string list) (whitespace:string)(prev:string) (result_list:preterm list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:preterm,fail:preterm list,fail:string,fail:string list);; letrec TOKEN_1 TOKENS CHARS = if null TOKENS then () else if mem (hd TOKENS) CHARS then TOKEN_1 (tl TOKENS) CHARS else fail;; let TOKEN TOKENS FIRST_CHARS CHARS next expected = if mem (hd TOKENS) FIRST_CHARS then (TOKEN_1 (tl TOKENS) CHARS; let wrd = implode TOKENS in if expected = `nil` then wrd else if expected = next then wrd else fail) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/ella/0000750000212700021270000000000005227256423017325 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/ella/ella_files/0000750000212700021270000000000005227256463021430 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/ella/ella_files/parity.ella0000640000212700021270000000114604577674071023610 0ustar cammcammTYPE bit = NEW(t | f). FN PARITY_SPEC = (bit: in) -> bit: BEGIN SEQ STATE VAR parity INIT t; CASE in OF t: op := f, f: op := t ESAC; OUTPUT parity END. FN NOT = (bit: in) -> bit: CASE in OF f: t, t: f ESAC. FN MUX = (bit: cntl in1 in2) -> bit: CASE cntl OF t: in1, f: in2 ESAC. FN REG = (bit) -> bit: DELAY(f, 1). FN PARITY_IMP = (bit: in) -> bit: BEGIN MAKE NOT: l1, MUX: l3 out, REG: l2 l5. JOIN (in,l1,l2) -> l3, t -> l5, (l5, l3, l4) -> out, out -> l2, l2 -> l1. OUTPUT out END. hol88-2.02.19940316/Library/parser/Examples/ella/ella_files/lifo.ella0000640000212700021270000000404104577674021023221 0ustar cammcammINT stacksize = 8. TYPE dataitem = NEW datum/(0..255), data = NEW (somedata&dataitem |nodata), exception= NEW (ok |stackoverflow |stackunderflow |full), stack_pointer = NEW point/(1..stacksize). FN S_P_REGISTER = (stack_pointer) -> stack_pointer: DELAY (p&point/1,1). FN OVERFLOW_REGISTER = (exception) -> exception: DELAY (ok,1). FN MEMORY = ([stacksize]data) -> [stacksize]data: DELAY ([stacksize]nodata,1). FN STACK = ([stacksize]data: a, exception: b,stack_pointer: c) -> ([stacksize]data, exception, stack_pointer): (MEMORY a, OVERFLOW_REGISTER b, S_P_REGISTER c). TYPE contrl = NEW (push |pop |donothing). FN INCR = (stack_pointer: number) -> stack_pointer: CASE number OF p&point/stacksize: full ELSE ( FN INC = (pointer: num) -> pointer: ARITH num+1. LET inc = INC (number//p). OUTPUT p&inc ) ESAC. FN DECR = (stack_pointer: number) -> stack_pointer: CASE number OF full: p&point/stacksize ELSE ( FN DEC = (pointer: num) -> pointer: ARITH num-1. LET dec = DEC (number//p). OUTPUT p&dec ) ESAC. FN PUSH = (data: dataelement, [stacksize]data: memory, stack_pointer: s_p_register) -> [stacksize]data: BEGIN SEQ VAR mem := [stacksize]nodata; mem := memory; mem [[s_p_register//p]] := dataelement; OUTPUT mem END. FN LIFO = (data: dataelement, contrl: push_or_pop) -> (data, exception): ( MAKE STACK: stack. LET memory = stack[1], overflow_register = stack[2], s_p_register = stack[3]. JOIN CASE push_or_pop OF pop: CASE sp_p_register OF p&point/1: (memory, stackunderflow, s_p_register) ELSE (memory, ok, DECR s_p_register) ESAC, push: CASE s_p_register OF full: (memory, stackoverflow, s_p_register) ELSE (PUSH(dataelement,memory,s_p_register), ok, INCR s_p_register) ESAC, donothing: (memory, ok, s_p_register) ESAC -> stack. OUTPUT (memory [[(DECR s_p_register)//p]], overflow_register) ). hol88-2.02.19940316/Library/parser/Examples/ella/A1_1.grm0000640000212700021270000000115104577674625020533 0ustar cammcamm% A1.1 BASICS % FIRST_CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0`. CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 _`. USEFUL [(`"`,`"`)]. IGNORE [(`#`,`\L`)]. integer --> {MK_digit(TOKEN)}. char --> {MK_char(TOKEN)}. name --> {MK_name(TOKEN)}. fnname --> {MK_fnname(TOKEN)}. typename --> {MK_typename(TOKEN)}. macname --> fnname. biopname --> fnname. string --> ["] {MK_string(WORD)} ["]. hol88-2.02.19940316/Library/parser/Examples/ella/A1_10.grm0000640000212700021270000000675404577673401020620 0ustar cammcamm% A1.10 SEQUENCES % sequence --> [BEGIN] sequence_BE [END] | [(] sequence_br [)]. sequence_BE --> [SEQ] poss_seq_step [OUTPUT] {MK_two(`sequence_BEGINEND`,unit,POP)}. sequence_br --> [SEQ] poss_seq_step [OUTPUT] {MK_two(`sequence_brackets`,unit,POP)}. poss_seq_step --> {MK_one(`sequencestep`,sequencestep)} [;] more_seq_steps | {MK_zero(`sequencestep`)}. more_seq_steps --> {MK_one(`sequencestep`,sequencestep)} {add_to_list(POP,POP)} [;] more_seq_steps | []. sequencestep --> [LET] letitem more_letitems {MK_one(`step_LET`,POP)} | [VAR] varitem more_varitems {MK_one(`sequencestep_VAR`,POP)} | [STATE] [VAR] statevaritem more_statevaritems {MK_one(`sequencestep_STATEVAR`,POP)} | [PVAR] statevaritem more_statevaritems {MK_one(`sequencestep_PVAR`,POP)} | [PRINT] printitem more_printitems {MK_one(`step_PRINT`,POP)} | [FAULT] faultitem more_faultitems {MK_one(`step_FAULT`,POP)} | declaration | statement. varitem --> name [:=] {MK_two(`varitem`,POP,unit)}. more_varitems --> {add_to_list(POP,varitem)} more_varitems | []. statevaritem --> name init_or_other. init_or_other --> [INIT] {MK_two(`statevaritem_INIT`,POP,const1)} {MK_one(`statevaritem`,POP)} | [::=] {MK_two(`statevaritem`,POP,const1)}. more_statevaritems --> {add_to_list(POP,statevaritem)} more_statevaritems | []. statement --> [IF] boolean [THEN] statement poss_ifseq_else [FI] | [CASE] unit [OF] seqchoices poss_caseseq_else [ESAC] | [\[] [INT] name [=] int [..] {MK_four(`statement_INT`,POP,POP,int,statement)} | [(] statement more_statements [)] {MK_one(`statements`,POP)} | {MK_one(`varname`,varname)} [:=] {MK_two(`statement_assign`,POP,unit)}. poss_ifseq_else --> [ELSE] {MK_three(`statement_cond`,POP,POP,statement)} | {MK_two(`statement_cond`,POP,POP)}. poss_caseseq_else --> [ELSE] {MK_zero(`statement_ELSEOF`)} {MK_four(`statement_case`,POP,POP,POP,statement)} | [ELSEOF] seqchoices more_seq_elseofs | {MK_zero(`statement_ELSEOF`)} {MK_three(`statement_case`,POP,POP,POP)}. more_seq_elseofs --> [ELSEOF] {add_to_list(POP,seqchoices)} more_seq_elseofs | [ELSE] {MK_one(`statement_ELSEOF`,POP)} {MK_four(`statement_case`,POP,POP,POP,statement)} | {MK_one(`statement_ELSEOF`,POP)} {MK_three(`statement_case`,POP,POP,POP)}. more_statements --> [;] {add_to_list(POP,statement)} more_statements | []. seqchoices --> seqchoice more_seqchoices {MK_one(`seqchoices`,POP)}. seqchoice --> choosers [:] poss_statement. poss_statement --> {MK_two(`seqchoice`,POP,statement)} | {MK_one(`seqchoice`,POP)}. more_seqchoices --> [,] {add_to_list(POP,seqchoice)} more_seqchoices | []. varname --> name rest_of_varname. rest_of_varname --> {MK_two(`varname`,POP,name)} rest_of_varname | [\[] var_brackets [\]] | []. var_brackets --> [\[] {MK_two(`varname_unit`,POP,unit)} [\]] | int var_int_stuff. var_int_stuff --> [..] {MK_three(`varname_int_range`,POP,POP,int)} | {MK_two(`varname_int`,POP,POP)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_11.grm0000640000212700021270000000307204577673401020607 0ustar cammcamm% A1.11 MACROS % macdec --> macname macdec_type. macdec_type --> [=] [FNSET] mac_FNSET | [\{] macspec [\}] [=] input [->] typ [:] {MK_five(`macdec`,POP,POP,POP,POP,fnbody)} | [=] input [->] typ [:] {MK_four(`macdec`,POP,POP,POP,fnbody)}. mac_FNSET --> [\[] int [\]] [(] input [->] {MK_two(`fnarrow`,POP,typ)} [)] {MK_two(`fnset`,POP,POP)} [:] {MK_one(`fnbody`,fnbody)} {MK_three(`macdec`,POP,POP,POP)} | [(] input [->] {MK_two(`fnarrow`,POP,typ)} more_mac_inputs [)] {MK_one(`fnarrows`,POP)} [:] {MK_one(`fnbody`,fnbody)} {MK_three(`macdec`,POP,POP,POP)}. more_mac_inputs --> [,] input [->] {MK_two(`fnarrow`,POP,typ)} {add_to_list(POP,POP)} more_mac_inputs | []. macspec --> [INT] {MK_one(`mactype_INT`,macspec_body)} {MK_one(`mactype`,POP)} more_macspecs {MK_one(`macpsec`,POP)} | [TYPE] {MK_one(`mactype_TYPE`,macspec_body)} {MK_one(`mactype`,POP)} more_macspecs {MK_one(`macpsec`,POP)}. macspec_body --> name more_mac_names. more_mac_names --> {add_to_list(POP,name)} more_mac_names | []. more_macspecs --> [INT] {MK_one(`mactype_INT`,macspec_body)} {MK_one(`mactype`,POP)} {add_to_list(POP,POP)} more_macspecs | [TYPE] {MK_one(`mactype_TYPE`,macspec_body)} {MK_one(`mactype`,POP)} {add_to_list(POP,POP)} more_macspecs | {MK_one(`mactypes`,POP)}. printable --> {MK_one(`printable`,string)} | {MK_one(`printable`,name)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_2.grm0000640000212700021270000000030204577673401020520 0ustar cammcamm% A1.2 TEXT (MAIN_LOOP is the text non-terminal) % MAIN_LOOP --> declaration [.] more_decs {MK_one(`text`,POP)}. more_decs --> {add_to_list(POP,declaration)} [.] more_decs | []. hol88-2.02.19940316/Library/parser/Examples/ella/A1_3.grm0000640000212700021270000000161204577673401020526 0ustar cammcamm% A1.3 DECLARATIONS % declaration --> [TYPE] typedec more_typedecs {MK_one(`declaration`,POP)} | [FN] fndec more_fndecs {MK_one(`declaration`,POP)} | [INT] intdec more_intdecs {MK_one(`declaration`,POP)} | [CONST] constdec more_constdecs {MK_one(`declaration`,POP)} | [MAC] macdec more_macdecs {MK_one(`declaration`,POP)}. more_typedecs --> [,] {add_to_list(POP,typedec)} more_typedecs | {MK_one(`typedecs`,POP)}. more_fndecs --> [,] {add_to_list(POP,fndec)} more_fndecs | {MK_one(`fndecs`,POP)}. more_intdecs --> [,] {add_to_list(POP,intdec)} more_intdecs | {MK_one(`intdecs`,POP)}. more_constdecs --> [,] {add_to_list(POP,constdec)} more_constdecs | {MK_one(`constdecs`,POP)}. more_macdecs --> [,] {add_to_list(POP,macdec)} more_macdecs | {MK_one(`macdecs`,POP)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_4.grm0000640000212700021270000000313104577673401020525 0ustar cammcamm% A1.4 TYPES % typedec --> name [=] {MK_two(`typedec`,POP,enum_or_type)}. enum_or_type --> [NEW] finish_enum | typ. finish_enum --> [(] name_with_typ more_enum_typ [)] | name char_or_int. char_or_int --> [/] [(] int [..] {MK_three(`enum_int`,POP,POP,int)} [)] | [(] poss_char_range more_char_ranges [)]. poss_char_range --> char is_c_range. is_c_range --> [..] {MK_three(`enum_char`,POP,POP,char)} | {MK_two(`enum_char`,POP,POP)}. more_char_ranges --> [|] {add_to_list(POP,poss_char_range)} more_char_ranges | {MK_one(`enum_chars`,POP)}. more_enum_typ --> [|] {add_to_list(POP,name_with_typ)} more_enum_typ | {MK_one(`enum_types`,POP)}. name_with_typ --> name poss_typ. poss_typ --> [&] {MK_two(`enum_type`,POP,typ)} | {MK_one(`enum_type`,POP)}. typ --> typ1 imp_typ1. imp_typ1 --> [->] {MK_two(`type`,POP,typ1)} | {MK_one(`type`,POP)}. typ1 --> [(] typ more_typs [)] {MK_one(`type_tuple`,POP)} {MK_one(`type1`,POP)} | [\[] int [\]] {MK_two(`type_int`,POP,typ)} {MK_one(`type1`,POP)} | [STRING] [\[] int [\]] {MK_two(`type_STRING`,POP,typename)} {MK_one(`type1`,POP)} | {MK_one(`type1`,typename)} | {MK_one(`type1`,typ2)}. more_typs --> [,] {add_to_list(POP,typ)} more_typs | []. typ2 --> [STRING] [\[] [INT] typename [\]] {MK_two(`type_STRING_INT`,POP,name)} {MK_one(`type2`,POP)} | [TYPE] {MK_one(`type_TYPE`,typename)} {MK_one(`type2`,POP)} | [\[] [INT] typename [\]] {MK_two(`type_INT`,POP,typ)} {MK_one(`type2`,POP)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_5.grm0000640000212700021270000000476704577673402020547 0ustar cammcamm%-------------------------------------------------------------------------% % A1.5 INTEGERS % % % % NOTE: The formula1 production has been optimised away. % %-------------------------------------------------------------------------% intdec --> name [=] {MK_two(`intdec`,POP,int)}. int --> {MK_one(`int`,formula)}. formula --> [+] {MK_unary(formula,`+`)} | [-] {MK_unary(formula,`-`)} | [INOT] {MK_unary(formula,`INOT`)} | [ABS] {MK_unary(formula,`ABS`)} | [SQRT] {MK_unary(formula,`SQRT`)} | [NOT] {MK_unary(formula,`NOT`)} | {MK_one(`formula1`,formula2)} {MK_one(`formula`,POP)} poss_ibinop. formula1 --> [+] {MK_unary(formula1,`+`)} | [-] {MK_unary(formula1,`-`)} {MK_one(`formula`,POP)} | [INOT] {MK_unary(formula1,`INOT`)} {MK_one(`formula`,POP)} | [ABS] {MK_unary(formula1,`ABS`)} {MK_one(`formula`,POP)} | [SQRT] {MK_unary(formula1,`SQRT`)} {MK_one(`formula`,POP)} | [NOT] {MK_unary(formula1,`NOT`)} {MK_one(`formula`,POP)} | {MK_one(`formula1`,formula2)} poss_ibinop. poss_ibinop --> [+] {MK_binary(POP,formula1,`+`)} | [-] {MK_binary(POP,formula1,`-`)} | [IDIV] {MK_binary(POP,formula1,`IDIV`)} | [%] {MK_binary(POP,formula1,`%`)} | [*] {MK_binary(POP,formula1,`*`)} | [MOD] {MK_binary(POP,formula1,`MOD`)} | [SL] {MK_binary(POP,formula1,`SL`)} | [SR] {MK_binary(POP,formula1,`SR`)} | [IAND] {MK_binary(POP,formula1,`IAND`)} | [IOR] {MK_binary(POP,formula1,`IOR`)} | [=] {MK_binary(POP,formula1,`=`)} | [/=] {MK_binary(POP,formula1,`/=`)} | [>] {MK_binary(POP,formula1,`>`)} | [<] {MK_binary(POP,formula1,`<`)} | [>=] {MK_binary(POP,formula1,`>=`)} | [<=] {MK_binary(POP,formula1,`<=`)} | [AND] {MK_binary(POP,formula1,`AND`)} | [OR] {MK_binary(POP,formula1,`OR`)} | []. formula2 --> [IF] boolean [THEN] int [ELSE] int [FI] {MK_three(`formula2_cond`,POP,POP,POP)} {MK_one(`formula2`,POP)} | [(] int [)] {MK_one(`formula2_int`,POP)} {MK_one(`formula2`,POP)} | {MK_one(`formula2`,name)} | {MK_one(`formula2`,integer)}. boolean --> {MK_one(`boolean`,formula)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_6.grm0000640000212700021270000000226304577673402020535 0ustar cammcamm% A1.6 CONSTANTS % constdec --> name [=] {MK_two(`constdec`,POP,const)}. const --> const1 more_consts {MK_one(`const`,POP)}. more_consts --> [|] {add_to_list(POP,const1)} more_consts | []. const1 --> [\[] int [\]] {MK_two(`const1`,POP,const1)} | [STRING] [\[] int [\]] {MK_two(`const1_STRING`,POP,const2)} {MK_one(`const1`,POP)} | {MK_one(`const1`,const2)}. const2 --> [?] {MK_one(`const2_uninit`,const2)} {MK_one(`const2`,POP)} | [(] const more_consts [)] {MK_one(`const2_tuple`,POP)} {MK_one(`const2`,POP)} | name const2_name_stuff {MK_one(`const2`,POP)}. const2_name_stuff --> [/] [(] int [..] {MK_three(`const2_int_range`,POP,POP,int)} [)] | [/] {MK_two(`const2_formula2`,POP,formula2)} | {MK_two(`const2_char`,POP,char)} | {MK_two(`const2_string`,POP,string)} | [&] {MK_two(`const2_const2`,POP,const2)} | [(] char [..] {MK_three(`const2_char_range`,POP,POP,char)} [)] | []. more_consts --> [,] {add_to_list(POP,const)} more_consts | []. hol88-2.02.19940316/Library/parser/Examples/ella/A1_7.grm0000640000212700021270000000344004577673402020534 0ustar cammcamm% A1.7 FUNCTIONS % fndec --> fnname [=] input_or_FNSET [:] {MK_one(`fnbody`,fnbody)} {MK_three(`fndec`,POP,POP,POP)}. input_or_FNSET --> [FNSET] [(] input [->] {MK_two(`fnarrow`,POP,typ)} more_input_type [)] {MK_one(`fnarrows`,POP)} {MK_one(`fnset`,POP)} | [FNSET] [\[] int [\]] [(] input [->] {MK_two(`fnarrow`,POP,typ)} [)] {MK_two(`fnset`,POP,POP)} | input [->] {MK_two(`fnarrow`,POP,typ)} {MK_one(`fnset`,POP)}. more_input_type --> [,] input [->] {MK_two(`fnarrow`,POP,typ)} {add_to_list(POP,POP)} more_input_type | []. input --> [(] inputitem more_inputs [)] {MK_one(`input`,POP)}. more_inputs --> [,] {add_to_list(POP,inputitem)} more_inputs | []. inputitem --> typ poss_name. poss_name --> [:] name more_in_names {MK_two(`inputitem`,POP,POP)} | {MK_one(`inputitem`,POP)}. more_in_names --> {add_to_list(POP,name)} more_in_names | []. fnbody --> [DELAY] [(] const1 [,] int poss_other_int_consts [)] | [ARITH] {MK_one(`fnbody_ARITH`,int)} | [BIOP] biopname poss_biopparms | [REFORM] {MK_zero(`fnbody_REFORM`)} | [IMPORT] {MK_zero(`fnbody_IMPORT`)} | [IDELAY] [(] const1 [,] {MK_two(`fnbody_IDELAY`,POP,int)} [)] | [RAM] [(] {MK_one(`fnbody_RAM`,const1)} [)] | unit. poss_other_int_consts --> [,] const1 [,] {MK_four(`fnbody_DELAY`,POP,POP,POP,int)} | [,] {MK_three(`fnbody_DELAY`,POP,POP,int)} | {MK_two(`fnbody_DELAY`,POP,POP)}. poss_biopparms --> [\{] macparams [\}] {MK_two(`fnbody_BIOP`,POP,POP)} | {MK_one(`fnbody_BIOP`,POP)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_8.grm0000640000212700021270000001002104577673402020526 0ustar cammcamm% A1.8 UNITS % unit --> [CONC] unit1 units_l {MK_one(`unit`,POP)} | unit_fn units_l {MK_one(`unit`,POP)} | unit_mac units_l {MK_one(`unit`,POP)} | unit1 units_l {MK_one(`unit`,POP)}. units_l --> [CONC] unit1 units_l | {add_to_list(POP,unit_fn)} units_l | {add_to_list(POP,unit_mac)} units_l | {add_to_list(POP,unit1)} units_l | []. unit_fn --> {MK_three(`unit_fn`,fnname,unit_names,unit1)}. unit_mac --> macname mac_poss_parms_names. mac_poss_parms_names --> [\{] macparams [\}] {MK_four(`unit_mac`,POP,POP,unit_names,unit1)} | {MK_three(`unit_mac`,POP,unit_names,unit1)}. unit_names --> [@] name more_unit_names {MK_one(`unit_names`,POP)} | {MK_zero(`unit_names`)}. more_unit_names --> [@] {add_to_list(POP,name)} more_unit_names | []. macparams --> {MK_one(`macparam`,macparam)} more_macparams. macparam --> int | typ. more_macparams --> {add_to_list(POP,macparam)} more_macparams | []. unit1 --> [\[] int [\]] {MK_two(`unit1_4`,POP,unit1)} {MK_one(`unit1`,POP)} | [\[] [INT] name [=] int [..] int [\]] {MK_four(`unit1_5`,POP,POP,POP,unit1)} | [STRING] [\[] int [\]] {MK_two(`unit1_7`,POP,unit1)} {MK_one(`unit1`,POP)} | [IO] name poss_1st_int {MK_one(`unit1`,POP)} | {MK_one(`unit1`,unit_fn)} | {MK_one(`unit1`,unit_mac)} | name [&] {MK_two(`unit1_6`,POP,unit1)} {MK_one(`unit1`,POP)} | unit2 unit1_finish {MK_one(`unit1`,POP)}. unit1_finish --> [//] {MK_two(`unit1_8`,POP,name)} | poss_unit1_names. poss_unit1_names --> [@] name unit_names {MK_two(`unit1_1`,POP,POP)} | {MK_two(`unit1_1`,POP,unit_names)}. poss_1st_int --> [\[] int [\]] poss_2nd_int | {MK_one(`unit1_9`,POP)}. poss_2nd_int --> [\[] {MK_three(`unit1_9`,POP,POP,int)} [\]] | {MK_two(`unit1_9`,POP,POP)}. unit2 --> [?] {MK_one(`unit2_uninit`,typ)} unit2_stuff | [IF] boolean [THEN] unit [ELSE] {MK_three(`unit2_cond`,POP,POP,unit)} [FI] unit2_stuff | name name_stuff unit2_stuff | unit3 unit2_stuff. unit2_stuff --> [?] {MK_one(`unit2_uninit`,typ)} {add_to_list(POP,POP)} unit2_stuff | [IF] boolean [THEN] unit [ELSE] {MK_three(`unit2_cond`,POP,POP,unit)} [FI] {add_to_list(POP,POP)} unit2_stuff | [\[] {MK_two(`unit2_int`,POP,int)} [\]] | [\[] [\[] {MK_two(`unit2_unit`,POP,unit)} [\]] [\]] | [\[] int [..] {MK_three(`unit2_int_range`,POP,POP,int)} [\]] | name name_stuff {add_to_list(POP,POP)} unit2_stuff | unit3 {add_to_list(POP,POP)} unit2_stuff | []. name_stuff --> [/] {MK_two(`const2_formula2`,POP,formula2)} | {MK_two(`const2_char`,POP,char)} | {MK_two(`const2_string`,POP,string)} | []. unit3 --> [CASE] caseclause | series | sequence | [(] unit more_units [)] {MK_one(`units`,POP)}. more_units --> [,] {add_to_list(POP,unit)} more_units | []. caseclause --> unit [OF] choices poss_case_else [ESAC]. choices --> choosers [:] {MK_two(`choice`,POP,unit)} more_choices. more_choices --> [,] choosers [:] {MK_two(`choice`,POP,unit)} {add_to_list(POP,POP)} more_choices | {MK_one(`choices`,POP)}. choosers --> {MK_one(`choosers`,const)}. poss_case_else --> [ELSE] {MK_zero(`caseclause_ELSEOF`)} {MK_four(`caseclause`,POP,POP,POP,unit)} | [ELSEOF] choices more_elseofs | {MK_zero(`caseclause_ELSEOF`)} {MK_three(`caseclause`,POP,POP,POP)}. more_elseofs --> [ELSEOF] {add_to_list(POP,choices)} more_elseofs | end_game_case. end_game_case --> [ELSE] {MK_one(`caseclause_ELSEOF`,POP)} {MK_four(`caseclause`,POP,POP,POP,unit)} | {MK_one(`caseclause_ELSEOF`,POP)} {MK_three(`caseclause`,POP,POP,POP)}. hol88-2.02.19940316/Library/parser/Examples/ella/A1_9.grm0000640000212700021270000000623304577673402020541 0ustar cammcamm% A1.9 SERIES % series --> [BEGIN] BEGIN_steps [END] {MK_one(`series`,POP)} | [(] bracket_steps [)] {MK_one(`series`,POP)}. BEGIN_steps --> [OUTPUT] {MK_one(`series_BEGINEND`,unit)} | step [.] more_B_steps. more_B_steps --> [OUTPUT] {MK_two(`series_BEGINEND`,unit,POP)} | {add_to_list(POP,step)} [.] more_B_steps. bracket_steps --> [OUTPUT] {MK_one(`series_brackets`,unit)} | step [.] more_br_steps. more_br_steps --> [OUTPUT] {MK_two(`series_brackets`,unit,POP)} | {add_to_list(POP,step)} [.] more_br_steps. step --> [MAKE] makeitem more_makeitems {MK_one(`step_MAKE`,POP)} {MK_one(`step`,POP)} | [LET] letitem more_letitems {MK_one(`step_LET`,POP)} {MK_one(`step`,POP)} | [FOR] {MK_one(`multiplier`,multiplier)} {MK_two(`step`,POP,joinstep)} | {MK_one(`step`,joinstep)} | [PRINT] printitem more_printitems {MK_one(`step_PRINT`,POP)} {MK_one(`step`,POP)} | [FAULT] faultitem more_faultitems {MK_one(`step_FAULT`,POP)} {MK_one(`step`,POP)} | declaration {MK_one(`step`,POP)}. makeitem --> [\[] int [\]] makeitem_body unit_names [:] name more_item_names {MK_one(`names`,POP)} {MK_four(`makeitem`,POP,POP,POP,POP)} | makeitem_body unit_names [:] name more_item_names {MK_one(`names`,POP)} {MK_three(`makeitem`,POP,POP,POP)}. makeitem_body --> {MK_one(`makeitem_body`,fnname)} | macname make_mac. make_mac --> [\{] macparams [\}] snd_macparams | {MK_one(`makeitem_body`,POP)}. snd_macparams --> [\{] macparams [\}] {MK_three(`makeitem_body`,POP,POP,POP)} | {MK_two(`makeitem_body`,POP,POP)}. more_makeitems --> [,] {add_to_list(POP,makeitem)} more_makeitems | []. more_item_names --> {add_to_list(POP,name)} more_item_names | []. letitem --> name [=] {MK_two(`letitem`,POP,unit)}. more_letitems --> [,] {add_to_list(POP,letitem)} more_letitems | []. joinstep --> [JOIN] joinitem more_joinitems {MK_one(`step_JOIN`,POP)}. multiplier --> [INT] name [=] int [..] {MK_three(`multiplier_INT`,POP,POP,int)} more_multipliers. more_multipliers --> [INT] name [=] int [..] {MK_three(`multiplier_INT`,POP,POP,int)} {add_to_list(POP,POP)} more_multipliers | []. joinitem --> unit [->] name rest_of_joinitem. rest_of_joinitem --> [\[] int [\]] second_join_int | {MK_two(`joinitem`,POP,POP)}. second_join_int --> [\[] int [\]] {MK_four(`joinitem`,POP,POP,POP,POP)} | {MK_three(`joinitem`,POP,POP,POP)}. more_joinitems --> [,] {add_to_list(POP,joinitem)} more_joinitems | []. printitem --> [IF] boolean [THEN] printable more_printables [FI] {MK_two(`printitem`,POP,POP)} | printable more_printables {MK_one(`printitem`,POP)}. more_printables --> {add_to_list(POP,printable)} more_printables | []. more_printitems --> [,] {add_to_list(POP,printitem)} more_printitems | []. faultitem --> {MK_one(`faultitem`,printitem)}. more_faultitems --> [,] {add_to_list(POP,faultitem)} more_faultitems | []. hol88-2.02.19940316/Library/parser/Examples/ella/A1_1.ml0000640000212700021270000000724404577676702020365 0ustar cammcamm % A1.1 BASICS % integer:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`integer`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = MK_digit(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `integer` whitespace lst `nil`);; char:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`char`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = MK_char(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `char` whitespace lst `nil`);; name:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`name`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = MK_name(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `name` whitespace lst `nil`);; fnname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`fnname`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = MK_fnname(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `fnname` whitespace lst `nil`);; typename:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typename`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = MK_typename(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `typename` whitespace lst `nil`);; macname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macname`,expected,WORD); (let (fnname_0 , result_list , prev, lst) = fnname lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push fnname_0 result_list in do_return result_list whitespace `macname` prev lst `nil`);; biopname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`biopname`,expected,WORD); (let (fnname_0 , result_list , prev, lst) = fnname lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push fnname_0 result_list in do_return result_list whitespace `biopname` prev lst `nil`);; string:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`string`,expected,WORD); if WORD = `"` then (let (WORD,lst) = gnt lst whitespace whitespace in let TOKENS = explode WORD in let WORD_0 = WORD in let tmp_1 = MK_string(WORD_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `"` WORD lst `string` in let TOKENS = explode WORD in do_return result_list whitespace `string` WORD lst expected) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/ella/A1_1_decls.ml0000640000212700021270000000534204577676703021535 0ustar cammcammFIRST_CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0`;; CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 _`;; USEFUL := [(`"`,`"`)];; IGNORE := [(`#`,`\L`)];; letref integer (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref char (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref name (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref fnname (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref typename (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref macname (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref biopname (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref string (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letrec TOKEN_1 TOKENS CHARS = if null TOKENS then () else if mem (hd TOKENS) CHARS then TOKEN_1 (tl TOKENS) CHARS else fail;; let TOKEN TOKENS FIRST_CHARS CHARS next expected = if mem (hd TOKENS) FIRST_CHARS then (TOKEN_1 (tl TOKENS) CHARS; let wrd = implode TOKENS in if expected = `nil` then wrd else if expected = next then wrd else fail) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/ella/A1_2.ml0000640000212700021270000000536405034371245020346 0ustar cammcamm % A1.2 TEXT (MAIN_LOOP is the text non-terminal) % MAIN_LOOP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MAIN_LOOP`,expected,WORD); (let (declaration_0 , result_list , prev, lst) = declaration lst whitespace WORD result_list FIRST_CHARS CHARS `.` in let result_list = push declaration_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `.` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in let (more_decs_1 , result_list , prev, lst) = more_decs lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_decs_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`text`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`);; let PARSE_file (in_file,whitespace,separators) = let white = if null whitespace then [` `;`\T`;`\L`] else whitespace and inf = open_file `in` in_file in let WORD = e_w_s inf (hd white) white in let lst = read_input inf [] white separators WORD IGNORE USEFUL in let (WORD,lst) = (hd lst,tl lst) in let result = fst (MAIN_LOOP lst (hd white) WORD [] FIRST_CHARS CHARS `nil`) in result ? fail;; let PARSE_text (text,whitespace,separators) = let outf = open_file `out` `/tmp/.000HOL` in write_string text outf; close_file outf; let result = PARSE_file (`/tmp/.000HOL`,whitespace,separators) in unlink `/tmp/.000HOL`; result;; more_decs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_decs`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (declaration_1 , result_list , prev, lst) = declaration lst whitespace WORD result_list FIRST_CHARS CHARS `.` in let tmp_2 = add_to_list(POP_0,declaration_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `.` WORD lst `more_decs` in let TOKENS = explode WORD in let (more_decs_2 , result_list , prev, lst) = more_decs lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_decs_2 result_list in do_return result_list whitespace `more_decs` prev lst `nil`) ? (do_return result_list whitespace `more_decs` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_2_decls.ml0000640000212700021270000000075004577676720021533 0ustar cammcammletref MAIN_LOOP (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_decs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_3.ml0000640000212700021270000002275205034371233020344 0ustar cammcamm % A1.3 DECLARATIONS % declaration:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`declaration`,expected,WORD); if WORD = `TYPE` then (let (typedec_0 , result_list , prev, lst) = typedec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push typedec_0 result_list in let (more_typedecs_1 , result_list , prev, lst) = more_typedecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_typedecs_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`declaration`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `declaration` prev lst `nil`) else fail ? if WORD = `FN` then (let (fndec_0 , result_list , prev, lst) = fndec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push fndec_0 result_list in let (more_fndecs_1 , result_list , prev, lst) = more_fndecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_fndecs_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`declaration`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `declaration` prev lst `nil`) else fail ? if WORD = `INT` then (let (intdec_0 , result_list , prev, lst) = intdec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push intdec_0 result_list in let (more_intdecs_1 , result_list , prev, lst) = more_intdecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_intdecs_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`declaration`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `declaration` prev lst `nil`) else fail ? if WORD = `CONST` then (let (constdec_0 , result_list , prev, lst) = constdec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push constdec_0 result_list in let (more_constdecs_1 , result_list , prev, lst) = more_constdecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_constdecs_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`declaration`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `declaration` prev lst `nil`) else fail ? if WORD = `MAC` then (let (macdec_0 , result_list , prev, lst) = macdec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push macdec_0 result_list in let (more_macdecs_1 , result_list , prev, lst) = more_macdecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macdecs_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`declaration`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `declaration` prev lst `nil`) else fail ? fail;; more_typedecs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_typedecs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typedec_1 , result_list , prev, lst) = typedec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,typedec_1) in let result_list = push tmp_2 result_list in let (more_typedecs_2 , result_list , prev, lst) = more_typedecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_typedecs_2 result_list in do_return result_list whitespace `more_typedecs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`typedecs`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_typedecs` WORD lst expected);; more_fndecs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_fndecs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (fndec_1 , result_list , prev, lst) = fndec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,fndec_1) in let result_list = push tmp_2 result_list in let (more_fndecs_2 , result_list , prev, lst) = more_fndecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_fndecs_2 result_list in do_return result_list whitespace `more_fndecs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`fndecs`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_fndecs` WORD lst expected);; more_intdecs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_intdecs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (intdec_1 , result_list , prev, lst) = intdec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,intdec_1) in let result_list = push tmp_2 result_list in let (more_intdecs_2 , result_list , prev, lst) = more_intdecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_intdecs_2 result_list in do_return result_list whitespace `more_intdecs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`intdecs`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_intdecs` WORD lst expected);; more_constdecs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_constdecs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (constdec_1 , result_list , prev, lst) = constdec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,constdec_1) in let result_list = push tmp_2 result_list in let (more_constdecs_2 , result_list , prev, lst) = more_constdecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_constdecs_2 result_list in do_return result_list whitespace `more_constdecs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`constdecs`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_constdecs` WORD lst expected);; more_macdecs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_macdecs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (macdec_1 , result_list , prev, lst) = macdec lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,macdec_1) in let result_list = push tmp_2 result_list in let (more_macdecs_2 , result_list , prev, lst) = more_macdecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macdecs_2 result_list in do_return result_list whitespace `more_macdecs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`macdecs`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_macdecs` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_3_decls.ml0000640000212700021270000000271304577676741021540 0ustar cammcammletref declaration (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_typedecs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_fndecs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_intdecs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_constdecs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_macdecs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_4.ml0000640000212700021270000005005305034371220020334 0ustar cammcamm % A1.4 TYPES % typedec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typedec`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `typedec` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (enum_or_type_2 , result_list , prev, lst) = enum_or_type lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`typedec`,POP_1,enum_or_type_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `typedec` prev lst `nil`);; enum_or_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`enum_or_type`,expected,WORD); if WORD = `NEW` then (let (finish_enum_0 , result_list , prev, lst) = finish_enum lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push finish_enum_0 result_list in do_return result_list whitespace `enum_or_type` prev lst `nil`) else fail ? (let (typ_0 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push typ_0 result_list in do_return result_list whitespace `enum_or_type` prev lst `nil`);; finish_enum:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`finish_enum`,expected,WORD); if WORD = `(` then (let (name_with_typ_0 , result_list , prev, lst) = name_with_typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push name_with_typ_0 result_list in let (more_enum_typ_1 , result_list , prev, lst) = more_enum_typ lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_enum_typ_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `finish_enum` in let TOKENS = explode WORD in do_return result_list whitespace `finish_enum` WORD lst expected) else fail ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (char_or_int_1 , result_list , prev, lst) = char_or_int lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push char_or_int_1 result_list in do_return result_list whitespace `finish_enum` prev lst `nil`);; char_or_int:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`char_or_int`,expected,WORD); if WORD = `/` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `(` WORD lst `char_or_int` in let TOKENS = explode WORD in let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `..` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `char_or_int` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (int_3 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_4 = MK_three(`enum_int`,POP_1,POP_2,int_3) in let result_list = push tmp_4 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `char_or_int` in let TOKENS = explode WORD in do_return result_list whitespace `char_or_int` WORD lst expected) else fail ? if WORD = `(` then (let (poss_char_range_0 , result_list , prev, lst) = poss_char_range lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push poss_char_range_0 result_list in let (more_char_ranges_1 , result_list , prev, lst) = more_char_ranges lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_char_ranges_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `char_or_int` in let TOKENS = explode WORD in do_return result_list whitespace `char_or_int` WORD lst expected) else fail ? fail;; poss_char_range:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_char_range`,expected,WORD); (let (char_0 , result_list , prev, lst) = char lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push char_0 result_list in let (is_c_range_1 , result_list , prev, lst) = is_c_range lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push is_c_range_1 result_list in do_return result_list whitespace `poss_char_range` prev lst `nil`);; is_c_range:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`is_c_range`,expected,WORD); if WORD = `..` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (char_2 , result_list , prev, lst) = char lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_three(`enum_char`,POP_0,POP_1,char_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `is_c_range` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`enum_char`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `is_c_range` WORD lst expected);; more_char_ranges:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_char_ranges`,expected,WORD); if WORD = `|` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (poss_char_range_1 , result_list , prev, lst) = poss_char_range lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,poss_char_range_1) in let result_list = push tmp_2 result_list in let (more_char_ranges_2 , result_list , prev, lst) = more_char_ranges lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_char_ranges_2 result_list in do_return result_list whitespace `more_char_ranges` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`enum_chars`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_char_ranges` WORD lst expected);; more_enum_typ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_enum_typ`,expected,WORD); if WORD = `|` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_with_typ_1 , result_list , prev, lst) = name_with_typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,name_with_typ_1) in let result_list = push tmp_2 result_list in let (more_enum_typ_2 , result_list , prev, lst) = more_enum_typ lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_enum_typ_2 result_list in do_return result_list whitespace `more_enum_typ` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`enum_types`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_enum_typ` WORD lst expected);; name_with_typ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`name_with_typ`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (poss_typ_1 , result_list , prev, lst) = poss_typ lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_typ_1 result_list in do_return result_list whitespace `name_with_typ` prev lst `nil`);; poss_typ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_typ`,expected,WORD); if WORD = `&` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`enum_type`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_typ` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`enum_type`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `poss_typ` WORD lst expected);; typ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typ`,expected,WORD); (let (typ1_0 , result_list , prev, lst) = typ1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push typ1_0 result_list in let (imp_typ1_1 , result_list , prev, lst) = imp_typ1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push imp_typ1_1 result_list in do_return result_list whitespace `typ` prev lst `nil`);; imp_typ1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`imp_typ1`,expected,WORD); if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ1_1 , result_list , prev, lst) = typ1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`type`,POP_0,typ1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `imp_typ1` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`type`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `imp_typ1` WORD lst expected);; typ1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typ1`,expected,WORD); if WORD = `(` then (let (typ_0 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push typ_0 result_list in let (more_typs_1 , result_list , prev, lst) = more_typs lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_typs_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `typ1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`type_tuple`,POP_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`type1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `typ1` WORD lst expected) else fail ? if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `typ1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`type_int`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`type1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `typ1` prev lst `nil`) else fail ? if WORD = `STRING` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\[` WORD lst `typ1` in let TOKENS = explode WORD in let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `typ1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typename_2 , result_list , prev, lst) = typename lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`type_STRING`,POP_1,typename_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`type1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `typ1` prev lst `nil`) else fail ? (let (typename_0 , result_list , prev, lst) = typename lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`type1`,typename_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `typ1` prev lst `nil`) ? (let (typ2_0 , result_list , prev, lst) = typ2 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`type1`,typ2_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `typ1` prev lst `nil`);; more_typs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_typs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,typ_1) in let result_list = push tmp_2 result_list in let (more_typs_2 , result_list , prev, lst) = more_typs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_typs_2 result_list in do_return result_list whitespace `more_typs` prev lst `nil`) else fail ? (do_return result_list whitespace `more_typs` WORD lst expected);; typ2:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typ2`,expected,WORD); if WORD = `STRING` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\[` WORD lst `typ2` in let TOKENS = explode WORD in let (WORD,lst) = eat_terminal `INT` WORD lst `typ2` in let TOKENS = explode WORD in let (typename_0 , result_list , prev, lst) = typename lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push typename_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `typ2` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (name_2 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`type_STRING_INT`,POP_1,name_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`type2`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `typ2` prev lst `nil`) else fail ? if WORD = `TYPE` then (let (typename_0 , result_list , prev, lst) = typename lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`type_TYPE`,typename_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`type2`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `typ2` prev lst `nil`) else fail ? if WORD = `[` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `INT` WORD lst `typ2` in let TOKENS = explode WORD in let (typename_0 , result_list , prev, lst) = typename lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push typename_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `typ2` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`type_INT`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`type2`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `typ2` prev lst `nil`) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/ella/A1_4_decls.ml0000640000212700021270000000712504577677007021537 0ustar cammcammletref typedec (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref enum_or_type (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref finish_enum (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref char_or_int (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_char_range (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref is_c_range (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_char_ranges (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_enum_typ (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref name_with_typ (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_typ (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref typ (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref imp_typ1 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref typ1 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_typs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref typ2 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_5.ml0000640000212700021270000005214305034371204020341 0ustar cammcamm %-------------------------------------------------------------------------% % A1.5 INTEGERS % % % % NOTE: The formula1 production has been optimised away. % %-------------------------------------------------------------------------% intdec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`intdec`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `intdec` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (int_2 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`intdec`,POP_1,int_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `intdec` prev lst `nil`);; int:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`int`,expected,WORD); (let (formula_0 , result_list , prev, lst) = formula lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`int`,formula_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `int` prev lst `nil`);; formula:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`formula`,expected,WORD); if WORD = `+` then (let (formula_0 , result_list , prev, lst) = formula lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula_0,`+`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula` prev lst `nil`) else fail ? if WORD = `-` then (let (formula_0 , result_list , prev, lst) = formula lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula_0,`-`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula` prev lst `nil`) else fail ? if WORD = `INOT` then (let (formula_0 , result_list , prev, lst) = formula lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula_0,`INOT`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula` prev lst `nil`) else fail ? if WORD = `ABS` then (let (formula_0 , result_list , prev, lst) = formula lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula_0,`ABS`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula` prev lst `nil`) else fail ? if WORD = `SQRT` then (let (formula_0 , result_list , prev, lst) = formula lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula_0,`SQRT`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula` prev lst `nil`) else fail ? if WORD = `NOT` then (let (formula_0 , result_list , prev, lst) = formula lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula_0,`NOT`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula` prev lst `nil`) else fail ? (let (formula2_0 , result_list , prev, lst) = formula2 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`formula1`,formula2_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula`,POP_1) in let result_list = push tmp_2 result_list in let (poss_ibinop_2 , result_list , prev, lst) = poss_ibinop lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_ibinop_2 result_list in do_return result_list whitespace `formula` prev lst `nil`);; formula1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`formula1`,expected,WORD); if WORD = `+` then (let (formula1_0 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula1_0,`+`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula1` prev lst `nil`) else fail ? if WORD = `-` then (let (formula1_0 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula1_0,`-`) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `formula1` prev lst `nil`) else fail ? if WORD = `INOT` then (let (formula1_0 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula1_0,`INOT`) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `formula1` prev lst `nil`) else fail ? if WORD = `ABS` then (let (formula1_0 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula1_0,`ABS`) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `formula1` prev lst `nil`) else fail ? if WORD = `SQRT` then (let (formula1_0 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula1_0,`SQRT`) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `formula1` prev lst `nil`) else fail ? if WORD = `NOT` then (let (formula1_0 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_unary(formula1_0,`NOT`) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `formula1` prev lst `nil`) else fail ? (let (formula2_0 , result_list , prev, lst) = formula2 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`formula1`,formula2_0) in let result_list = push tmp_1 result_list in let (poss_ibinop_1 , result_list , prev, lst) = poss_ibinop lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_ibinop_1 result_list in do_return result_list whitespace `formula1` prev lst `nil`);; poss_ibinop:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_ibinop`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`+`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `-` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`-`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `IDIV` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`IDIV`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `%` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`%`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `*` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`*`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `MOD` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`MOD`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `SL` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`SL`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `SR` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`SR`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `IAND` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`IAND`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `IOR` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`IOR`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`=`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `/=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`/=`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`>`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `<` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`<`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `>=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`>=`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `<=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`<=`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `AND` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`AND`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? if WORD = `OR` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula1_1 , result_list , prev, lst) = formula1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_binary(POP_0,formula1_1,`OR`) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ibinop` prev lst `nil`) else fail ? (do_return result_list whitespace `poss_ibinop` WORD lst expected);; formula2:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`formula2`,expected,WORD); if WORD = `IF` then (let (boolean_0 , result_list , prev, lst) = boolean lst whitespace whitespace result_list FIRST_CHARS CHARS `THEN` in let result_list = push boolean_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `THEN` WORD lst `formula2` in let TOKENS = explode WORD in let (int_1 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `ELSE` in let result_list = push int_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `ELSE` WORD lst `formula2` in let TOKENS = explode WORD in let (int_2 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `FI` in let result_list = push int_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `FI` WORD lst `formula2` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = MK_three(`formula2_cond`,POP_3,POP_4,POP_5) in let result_list = push tmp_6 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_6 , pop_list ) = (pop pop_list) in let tmp_7 = MK_one(`formula2`,POP_6) in let result_list = push tmp_7 result_list in do_return result_list whitespace `formula2` WORD lst expected) else fail ? if WORD = `(` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `formula2` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`formula2_int`,POP_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`formula2`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `formula2` WORD lst expected) else fail ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`formula2`,name_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula2` prev lst `nil`) ? (let (integer_0 , result_list , prev, lst) = integer lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`formula2`,integer_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `formula2` prev lst `nil`);; boolean:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`boolean`,expected,WORD); (let (formula_0 , result_list , prev, lst) = formula lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`boolean`,formula_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `boolean` prev lst `nil`);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_5_decls.ml0000640000212700021270000000323704577677052021540 0ustar cammcammletref intdec (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref int (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref formula (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref formula1 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_ibinop (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref formula2 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref boolean (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_6.ml0000640000212700021270000003127405034371165020352 0ustar cammcamm % A1.6 CONSTANTS % constdec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`constdec`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `constdec` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (const_2 , result_list , prev, lst) = const lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`constdec`,POP_1,const_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `constdec` prev lst `nil`);; const:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`const`,expected,WORD); (let (const1_0 , result_list , prev, lst) = const1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push const1_0 result_list in let (more_consts_1 , result_list , prev, lst) = more_consts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_consts_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`const`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `const` prev lst `nil`);; more_consts:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_consts`,expected,WORD); if WORD = `|` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (const1_1 , result_list , prev, lst) = const1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,const1_1) in let result_list = push tmp_2 result_list in let (more_consts_2 , result_list , prev, lst) = more_consts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_consts_2 result_list in do_return result_list whitespace `more_consts` prev lst `nil`) else fail ? (do_return result_list whitespace `more_consts` WORD lst expected);; const1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`const1`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `const1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (const1_2 , result_list , prev, lst) = const1 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`const1`,POP_1,const1_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `const1` prev lst `nil`) else fail ? if WORD = `STRING` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\[` WORD lst `const1` in let TOKENS = explode WORD in let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `const1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (const2_2 , result_list , prev, lst) = const2 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`const1_STRING`,POP_1,const2_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`const1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `const1` prev lst `nil`) else fail ? (let (const2_0 , result_list , prev, lst) = const2 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`const1`,const2_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `const1` prev lst `nil`);; const2:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`const2`,expected,WORD); if WORD = `?` then (let (const2_0 , result_list , prev, lst) = const2 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`const2_uninit`,const2_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`const2`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `const2` prev lst `nil`) else fail ? if WORD = `(` then (let (const_0 , result_list , prev, lst) = const lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push const_0 result_list in let (more_consts_1 , result_list , prev, lst) = more_consts lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_consts_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `const2` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`const2_tuple`,POP_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`const2`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `const2` WORD lst expected) else fail ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (const2_name_stuff_1 , result_list , prev, lst) = const2_name_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push const2_name_stuff_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`const2`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `const2` prev lst `nil`);; const2_name_stuff:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`const2_name_stuff`,expected,WORD); if WORD = `/` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `(` WORD lst `const2_name_stuff` in let TOKENS = explode WORD in let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `..` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `const2_name_stuff` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (int_3 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_4 = MK_three(`const2_int_range`,POP_1,POP_2,int_3) in let result_list = push tmp_4 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `const2_name_stuff` in let TOKENS = explode WORD in do_return result_list whitespace `const2_name_stuff` WORD lst expected) else fail ? if WORD = `/` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula2_1 , result_list , prev, lst) = formula2 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_formula2`,POP_0,formula2_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `const2_name_stuff` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (char_1 , result_list , prev, lst) = char lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_char`,POP_0,char_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `const2_name_stuff` prev lst `nil`) ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (string_1 , result_list , prev, lst) = string lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_string`,POP_0,string_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `const2_name_stuff` prev lst `nil`) ? if WORD = `&` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (const2_1 , result_list , prev, lst) = const2 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_const2`,POP_0,const2_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `const2_name_stuff` prev lst `nil`) else fail ? if WORD = `(` then (let (char_0 , result_list , prev, lst) = char lst whitespace whitespace result_list FIRST_CHARS CHARS `..` in let result_list = push char_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `const2_name_stuff` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (char_3 , result_list , prev, lst) = char lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_4 = MK_three(`const2_char_range`,POP_1,POP_2,char_3) in let result_list = push tmp_4 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `const2_name_stuff` in let TOKENS = explode WORD in do_return result_list whitespace `const2_name_stuff` WORD lst expected) else fail ? (do_return result_list whitespace `const2_name_stuff` WORD lst expected);; more_consts:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_consts`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (const_1 , result_list , prev, lst) = const lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,const_1) in let result_list = push tmp_2 result_list in let (more_consts_2 , result_list , prev, lst) = more_consts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_consts_2 result_list in do_return result_list whitespace `more_consts` prev lst `nil`) else fail ? (do_return result_list whitespace `more_consts` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_6_decls.ml0000640000212700021270000000325504577677064021544 0ustar cammcammletref constdec (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref const (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_consts (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref const1 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref const2 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref const2_name_stuff (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_consts (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_7.ml0000640000212700021270000005017005034371153020344 0ustar cammcamm % A1.7 FUNCTIONS % fndec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`fndec`,expected,WORD); (let (fnname_0 , result_list , prev, lst) = fnname lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push fnname_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `fndec` in let TOKENS = explode WORD in let (input_or_FNSET_1 , result_list , prev, lst) = input_or_FNSET lst whitespace WORD result_list FIRST_CHARS CHARS `:` in let result_list = push input_or_FNSET_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `fndec` in let TOKENS = explode WORD in let (fnbody_2 , result_list , prev, lst) = fnbody lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_one(`fnbody`,fnbody_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = MK_three(`fndec`,POP_3,POP_4,POP_5) in let result_list = push tmp_6 result_list in do_return result_list whitespace `fndec` prev lst `nil`);; input_or_FNSET:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`input_or_FNSET`,expected,WORD); if WORD = `FNSET` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `(` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (input_0 , result_list , prev, lst) = input lst whitespace WORD result_list FIRST_CHARS CHARS `->` in let result_list = push input_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_3 = MK_two(`fnarrow`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (more_input_type_3 , result_list , prev, lst) = more_input_type lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_input_type_3 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = MK_one(`fnarrows`,POP_4) in let result_list = push tmp_5 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = MK_one(`fnset`,POP_5) in let result_list = push tmp_6 result_list in do_return result_list whitespace `input_or_FNSET` WORD lst expected) else fail ? if WORD = `FNSET` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\[` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (WORD,lst) = eat_terminal `(` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (input_1 , result_list , prev, lst) = input lst whitespace WORD result_list FIRST_CHARS CHARS `->` in let result_list = push input_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (typ_3 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_4 = MK_two(`fnarrow`,POP_2,typ_3) in let result_list = push tmp_4 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = MK_two(`fnset`,POP_4,POP_5) in let result_list = push tmp_6 result_list in do_return result_list whitespace `input_or_FNSET` WORD lst expected) else fail ? (let (input_0 , result_list , prev, lst) = input lst whitespace WORD result_list FIRST_CHARS CHARS `->` in let result_list = push input_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `input_or_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`fnarrow`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`fnset`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `input_or_FNSET` prev lst `nil`);; more_input_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_input_type`,expected,WORD); if WORD = `,` then (let (input_0 , result_list , prev, lst) = input lst whitespace whitespace result_list FIRST_CHARS CHARS `->` in let result_list = push input_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `more_input_type` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_3 = MK_two(`fnarrow`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = add_to_list(POP_3,POP_4) in let result_list = push tmp_5 result_list in let (more_input_type_5 , result_list , prev, lst) = more_input_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_input_type_5 result_list in do_return result_list whitespace `more_input_type` prev lst `nil`) else fail ? (do_return result_list whitespace `more_input_type` WORD lst expected);; input:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`input`,expected,WORD); if WORD = `(` then (let (inputitem_0 , result_list , prev, lst) = inputitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push inputitem_0 result_list in let (more_inputs_1 , result_list , prev, lst) = more_inputs lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_inputs_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `input` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`input`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `input` WORD lst expected) else fail ? fail;; more_inputs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_inputs`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (inputitem_1 , result_list , prev, lst) = inputitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,inputitem_1) in let result_list = push tmp_2 result_list in let (more_inputs_2 , result_list , prev, lst) = more_inputs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_inputs_2 result_list in do_return result_list whitespace `more_inputs` prev lst `nil`) else fail ? (do_return result_list whitespace `more_inputs` WORD lst expected);; inputitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`inputitem`,expected,WORD); (let (typ_0 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push typ_0 result_list in let (poss_name_1 , result_list , prev, lst) = poss_name lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_name_1 result_list in do_return result_list whitespace `inputitem` prev lst `nil`);; poss_name:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_name`,expected,WORD); if WORD = `:` then (let (name_0 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (more_in_names_1 , result_list , prev, lst) = more_in_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_in_names_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_two(`inputitem`,POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `poss_name` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`inputitem`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `poss_name` WORD lst expected);; more_in_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_in_names`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_1 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,name_1) in let result_list = push tmp_2 result_list in let (more_in_names_2 , result_list , prev, lst) = more_in_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_in_names_2 result_list in do_return result_list whitespace `more_in_names` prev lst `nil`) ? (do_return result_list whitespace `more_in_names` WORD lst expected);; fnbody:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`fnbody`,expected,WORD); if WORD = `DELAY` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `(` WORD lst `fnbody` in let TOKENS = explode WORD in let (const1_0 , result_list , prev, lst) = const1 lst whitespace WORD result_list FIRST_CHARS CHARS `,` in let result_list = push const1_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `,` WORD lst `fnbody` in let TOKENS = explode WORD in let (int_1 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push int_1 result_list in let (poss_other_int_consts_2 , result_list , prev, lst) = poss_other_int_consts lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push poss_other_int_consts_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `fnbody` in let TOKENS = explode WORD in do_return result_list whitespace `fnbody` WORD lst expected) else fail ? if WORD = `ARITH` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`fnbody_ARITH`,int_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `fnbody` prev lst `nil`) else fail ? if WORD = `BIOP` then (let (biopname_0 , result_list , prev, lst) = biopname lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push biopname_0 result_list in let (poss_biopparms_1 , result_list , prev, lst) = poss_biopparms lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_biopparms_1 result_list in do_return result_list whitespace `fnbody` prev lst `nil`) else fail ? if WORD = `REFORM` then (let tmp_0 = MK_zero(`fnbody_REFORM`) in let result_list = push tmp_0 result_list in do_return result_list whitespace `fnbody` whitespace lst expected) else fail ? if WORD = `IMPORT` then (let tmp_0 = MK_zero(`fnbody_IMPORT`) in let result_list = push tmp_0 result_list in do_return result_list whitespace `fnbody` whitespace lst expected) else fail ? if WORD = `IDELAY` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `(` WORD lst `fnbody` in let TOKENS = explode WORD in let (const1_0 , result_list , prev, lst) = const1 lst whitespace WORD result_list FIRST_CHARS CHARS `,` in let result_list = push const1_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `,` WORD lst `fnbody` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (int_2 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_3 = MK_two(`fnbody_IDELAY`,POP_1,int_2) in let result_list = push tmp_3 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `fnbody` in let TOKENS = explode WORD in do_return result_list whitespace `fnbody` WORD lst expected) else fail ? if WORD = `RAM` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `(` WORD lst `fnbody` in let TOKENS = explode WORD in let (const1_0 , result_list , prev, lst) = const1 lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_1 = MK_one(`fnbody_RAM`,const1_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `fnbody` in let TOKENS = explode WORD in do_return result_list whitespace `fnbody` WORD lst expected) else fail ? (let (unit_0 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push unit_0 result_list in do_return result_list whitespace `fnbody` prev lst `nil`);; poss_other_int_consts:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_other_int_consts`,expected,WORD); if WORD = `,` then (let (const1_0 , result_list , prev, lst) = const1 lst whitespace whitespace result_list FIRST_CHARS CHARS `,` in let result_list = push const1_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `,` WORD lst `poss_other_int_consts` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (int_4 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_5 = MK_four(`fnbody_DELAY`,POP_1,POP_2,POP_3,int_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `poss_other_int_consts` prev lst `nil`) else fail ? if WORD = `,` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (int_2 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_three(`fnbody_DELAY`,POP_0,POP_1,int_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `poss_other_int_consts` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`fnbody_DELAY`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_other_int_consts` WORD lst expected);; poss_biopparms:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_biopparms`,expected,WORD); if WORD = `{` then (let (macparams_0 , result_list , prev, lst) = macparams lst whitespace whitespace result_list FIRST_CHARS CHARS `\}` in let result_list = push macparams_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `poss_biopparms` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_two(`fnbody_BIOP`,POP_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `poss_biopparms` WORD lst expected) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`fnbody_BIOP`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `poss_biopparms` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_7_decls.ml0000640000212700021270000000522304577677107021540 0ustar cammcammletref fndec (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref input_or_FNSET (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_input_type (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref input (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_inputs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref inputitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_name (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_in_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref fnbody (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_other_int_consts (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_biopparms (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_8.ml0000640000212700021270000013614305034371125020351 0ustar cammcamm % A1.8 UNITS % unit:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit`,expected,WORD); if WORD = `CONC` then (let (unit1_0 , result_list , prev, lst) = unit1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push unit1_0 result_list in let (units_l_1 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit` prev lst `nil`) else fail ? (let (unit_fn_0 , result_list , prev, lst) = unit_fn lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push unit_fn_0 result_list in let (units_l_1 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit` prev lst `nil`) ? (let (unit_mac_0 , result_list , prev, lst) = unit_mac lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push unit_mac_0 result_list in let (units_l_1 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit` prev lst `nil`) ? (let (unit1_0 , result_list , prev, lst) = unit1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push unit1_0 result_list in let (units_l_1 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit` prev lst `nil`);; units_l:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`units_l`,expected,WORD); if WORD = `CONC` then (let (unit1_0 , result_list , prev, lst) = unit1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push unit1_0 result_list in let (units_l_1 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_1 result_list in do_return result_list whitespace `units_l` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_fn_1 , result_list , prev, lst) = unit_fn lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,unit_fn_1) in let result_list = push tmp_2 result_list in let (units_l_2 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_2 result_list in do_return result_list whitespace `units_l` prev lst `nil`) ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_mac_1 , result_list , prev, lst) = unit_mac lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,unit_mac_1) in let result_list = push tmp_2 result_list in let (units_l_2 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_2 result_list in do_return result_list whitespace `units_l` prev lst `nil`) ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit1_1 , result_list , prev, lst) = unit1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,unit1_1) in let result_list = push tmp_2 result_list in let (units_l_2 , result_list , prev, lst) = units_l lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push units_l_2 result_list in do_return result_list whitespace `units_l` prev lst `nil`) ? (do_return result_list whitespace `units_l` WORD lst expected);; unit_fn:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit_fn`,expected,WORD); (let (fnname_0 , result_list , prev, lst) = fnname lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let (unit_names_1 , result_list , prev, lst) = unit_names lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let (unit1_2 , result_list , prev, lst) = unit1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_three(`unit_fn`,fnname_0,unit_names_1,unit1_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit_fn` prev lst `nil`);; unit_mac:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit_mac`,expected,WORD); (let (macname_0 , result_list , prev, lst) = macname lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push macname_0 result_list in let (mac_poss_parms_names_1 , result_list , prev, lst) = mac_poss_parms_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push mac_poss_parms_names_1 result_list in do_return result_list whitespace `unit_mac` prev lst `nil`);; mac_poss_parms_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`mac_poss_parms_names`,expected,WORD); if WORD = `{` then (let (macparams_0 , result_list , prev, lst) = macparams lst whitespace whitespace result_list FIRST_CHARS CHARS `\}` in let result_list = push macparams_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `mac_poss_parms_names` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (unit_names_3 , result_list , prev, lst) = unit_names lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let (unit1_4 , result_list , prev, lst) = unit1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_5 = MK_four(`unit_mac`,POP_1,POP_2,unit_names_3,unit1_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `mac_poss_parms_names` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_names_1 , result_list , prev, lst) = unit_names lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let (unit1_2 , result_list , prev, lst) = unit1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_three(`unit_mac`,POP_0,unit_names_1,unit1_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `mac_poss_parms_names` prev lst `nil`);; unit_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit_names`,expected,WORD); if WORD = `@` then (let (name_0 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (more_unit_names_1 , result_list , prev, lst) = more_unit_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_unit_names_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit_names`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit_names` prev lst `nil`) else fail ? (let tmp_0 = MK_zero(`unit_names`) in let result_list = push tmp_0 result_list in do_return result_list whitespace `unit_names` WORD lst expected);; more_unit_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_unit_names`,expected,WORD); if WORD = `@` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_1 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,name_1) in let result_list = push tmp_2 result_list in let (more_unit_names_2 , result_list , prev, lst) = more_unit_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_unit_names_2 result_list in do_return result_list whitespace `more_unit_names` prev lst `nil`) else fail ? (do_return result_list whitespace `more_unit_names` WORD lst expected);; macparams:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macparams`,expected,WORD); (let (macparam_0 , result_list , prev, lst) = macparam lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`macparam`,macparam_0) in let result_list = push tmp_1 result_list in let (more_macparams_1 , result_list , prev, lst) = more_macparams lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macparams_1 result_list in do_return result_list whitespace `macparams` prev lst `nil`);; macparam:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macparam`,expected,WORD); (let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push int_0 result_list in do_return result_list whitespace `macparam` prev lst `nil`) ? (let (typ_0 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push typ_0 result_list in do_return result_list whitespace `macparam` prev lst `nil`);; more_macparams:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_macparams`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (macparam_1 , result_list , prev, lst) = macparam lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,macparam_1) in let result_list = push tmp_2 result_list in let (more_macparams_2 , result_list , prev, lst) = more_macparams lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macparams_2 result_list in do_return result_list whitespace `more_macparams` prev lst `nil`) ? (do_return result_list whitespace `more_macparams` WORD lst expected);; unit1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit1`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `unit1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit1_2 , result_list , prev, lst) = unit1 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`unit1_4`,POP_1,unit1_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`unit1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `unit1` prev lst `nil`) else fail ? if WORD = `[` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `INT` WORD lst `unit1` in let TOKENS = explode WORD in let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `unit1` in let TOKENS = explode WORD in let (int_1 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `..` in let result_list = push int_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `unit1` in let TOKENS = explode WORD in let (int_2 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push int_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `unit1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let (unit1_6 , result_list , prev, lst) = unit1 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_7 = MK_four(`unit1_5`,POP_3,POP_4,POP_5,unit1_6) in let result_list = push tmp_7 result_list in do_return result_list whitespace `unit1` prev lst `nil`) else fail ? if WORD = `STRING` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\[` WORD lst `unit1` in let TOKENS = explode WORD in let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `unit1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit1_2 , result_list , prev, lst) = unit1 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`unit1_7`,POP_1,unit1_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`unit1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `unit1` prev lst `nil`) else fail ? if WORD = `IO` then (let (name_0 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (poss_1st_int_1 , result_list , prev, lst) = poss_1st_int lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_1st_int_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit1`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit1` prev lst `nil`) else fail ? (let (unit_fn_0 , result_list , prev, lst) = unit_fn lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`unit1`,unit_fn_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `unit1` prev lst `nil`) ? (let (unit_mac_0 , result_list , prev, lst) = unit_mac lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`unit1`,unit_mac_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `unit1` prev lst `nil`) ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `&` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `&` WORD lst `unit1` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit1_2 , result_list , prev, lst) = unit1 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`unit1_6`,POP_1,unit1_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`unit1`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `unit1` prev lst `nil`) ? (let (unit2_0 , result_list , prev, lst) = unit2 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push unit2_0 result_list in let (unit1_finish_1 , result_list , prev, lst) = unit1_finish lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit1_finish_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`unit1`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit1` prev lst `nil`);; unit1_finish:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit1_finish`,expected,WORD); if WORD = `//` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_1 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`unit1_8`,POP_0,name_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `unit1_finish` prev lst `nil`) else fail ? (let (poss_unit1_names_0 , result_list , prev, lst) = poss_unit1_names lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push poss_unit1_names_0 result_list in do_return result_list whitespace `unit1_finish` prev lst `nil`);; poss_unit1_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_unit1_names`,expected,WORD); if WORD = `@` then (let (name_0 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (unit_names_1 , result_list , prev, lst) = unit_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit_names_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_two(`unit1_1`,POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `poss_unit1_names` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_names_1 , result_list , prev, lst) = unit_names lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`unit1_1`,POP_0,unit_names_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_unit1_names` prev lst `nil`);; poss_1st_int:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_1st_int`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `poss_1st_int` in let TOKENS = explode WORD in let (poss_2nd_int_1 , result_list , prev, lst) = poss_2nd_int lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push poss_2nd_int_1 result_list in do_return result_list whitespace `poss_1st_int` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`unit1_9`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `poss_1st_int` WORD lst expected);; poss_2nd_int:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_2nd_int`,expected,WORD); if WORD = `[` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (int_2 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let tmp_3 = MK_three(`unit1_9`,POP_0,POP_1,int_2) in let result_list = push tmp_3 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `poss_2nd_int` in let TOKENS = explode WORD in do_return result_list whitespace `poss_2nd_int` WORD lst expected) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`unit1_9`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_2nd_int` WORD lst expected);; unit2:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit2`,expected,WORD); if WORD = `?` then (let (typ_0 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`unit2_uninit`,typ_0) in let result_list = push tmp_1 result_list in let (unit2_stuff_1 , result_list , prev, lst) = unit2_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_1 result_list in do_return result_list whitespace `unit2` prev lst `nil`) else fail ? if WORD = `IF` then (let (boolean_0 , result_list , prev, lst) = boolean lst whitespace whitespace result_list FIRST_CHARS CHARS `THEN` in let result_list = push boolean_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `THEN` WORD lst `unit2` in let TOKENS = explode WORD in let (unit_1 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `ELSE` in let result_list = push unit_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `ELSE` WORD lst `unit2` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (unit_4 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `FI` in let tmp_5 = MK_three(`unit2_cond`,POP_2,POP_3,unit_4) in let result_list = push tmp_5 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `FI` WORD lst `unit2` in let TOKENS = explode WORD in let (unit2_stuff_5 , result_list , prev, lst) = unit2_stuff lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_5 result_list in do_return result_list whitespace `unit2` prev lst `nil`) else fail ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (name_stuff_1 , result_list , prev, lst) = name_stuff lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push name_stuff_1 result_list in let (unit2_stuff_2 , result_list , prev, lst) = unit2_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_2 result_list in do_return result_list whitespace `unit2` prev lst `nil`) ? (let (unit3_0 , result_list , prev, lst) = unit3 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push unit3_0 result_list in let (unit2_stuff_1 , result_list , prev, lst) = unit2_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_1 result_list in do_return result_list whitespace `unit2` prev lst `nil`);; unit2_stuff:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit2_stuff`,expected,WORD); if WORD = `?` then (let (typ_0 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`unit2_uninit`,typ_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = add_to_list(POP_1,POP_2) in let result_list = push tmp_3 result_list in let (unit2_stuff_3 , result_list , prev, lst) = unit2_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_3 result_list in do_return result_list whitespace `unit2_stuff` prev lst `nil`) else fail ? if WORD = `IF` then (let (boolean_0 , result_list , prev, lst) = boolean lst whitespace whitespace result_list FIRST_CHARS CHARS `THEN` in let result_list = push boolean_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `THEN` WORD lst `unit2_stuff` in let TOKENS = explode WORD in let (unit_1 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `ELSE` in let result_list = push unit_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `ELSE` WORD lst `unit2_stuff` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (unit_4 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `FI` in let tmp_5 = MK_three(`unit2_cond`,POP_2,POP_3,unit_4) in let result_list = push tmp_5 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `FI` WORD lst `unit2_stuff` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_5 , pop_list ) = (pop pop_list) in let (POP_6 , pop_list ) = (pop pop_list) in let tmp_7 = add_to_list(POP_5,POP_6) in let result_list = push tmp_7 result_list in let (unit2_stuff_7 , result_list , prev, lst) = unit2_stuff lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_7 result_list in do_return result_list whitespace `unit2_stuff` prev lst `nil`) else fail ? if WORD = `[` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (int_1 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let tmp_2 = MK_two(`unit2_int`,POP_0,int_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `unit2_stuff` in let TOKENS = explode WORD in do_return result_list whitespace `unit2_stuff` WORD lst expected) else fail ? if WORD = `[` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\[` WORD lst `unit2_stuff` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_1 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let tmp_2 = MK_two(`unit2_unit`,POP_0,unit_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `unit2_stuff` in let TOKENS = explode WORD in let (WORD,lst) = eat_terminal `\]` WORD lst `unit2_stuff` in let TOKENS = explode WORD in do_return result_list whitespace `unit2_stuff` WORD lst expected) else fail ? if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `..` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `unit2_stuff` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (int_3 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let tmp_4 = MK_three(`unit2_int_range`,POP_1,POP_2,int_3) in let result_list = push tmp_4 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `unit2_stuff` in let TOKENS = explode WORD in do_return result_list whitespace `unit2_stuff` WORD lst expected) else fail ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (name_stuff_1 , result_list , prev, lst) = name_stuff lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push name_stuff_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = add_to_list(POP_2,POP_3) in let result_list = push tmp_4 result_list in let (unit2_stuff_4 , result_list , prev, lst) = unit2_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_4 result_list in do_return result_list whitespace `unit2_stuff` prev lst `nil`) ? (let (unit3_0 , result_list , prev, lst) = unit3 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push unit3_0 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = add_to_list(POP_1,POP_2) in let result_list = push tmp_3 result_list in let (unit2_stuff_3 , result_list , prev, lst) = unit2_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push unit2_stuff_3 result_list in do_return result_list whitespace `unit2_stuff` prev lst `nil`) ? (do_return result_list whitespace `unit2_stuff` WORD lst expected);; name_stuff:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`name_stuff`,expected,WORD); if WORD = `/` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (formula2_1 , result_list , prev, lst) = formula2 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_formula2`,POP_0,formula2_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `name_stuff` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (char_1 , result_list , prev, lst) = char lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_char`,POP_0,char_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `name_stuff` prev lst `nil`) ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (string_1 , result_list , prev, lst) = string lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`const2_string`,POP_0,string_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `name_stuff` prev lst `nil`) ? (do_return result_list whitespace `name_stuff` WORD lst expected);; unit3:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`unit3`,expected,WORD); if WORD = `CASE` then (let (caseclause_0 , result_list , prev, lst) = caseclause lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push caseclause_0 result_list in do_return result_list whitespace `unit3` prev lst `nil`) else fail ? (let (series_0 , result_list , prev, lst) = series lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push series_0 result_list in do_return result_list whitespace `unit3` prev lst `nil`) ? (let (sequence_0 , result_list , prev, lst) = sequence lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push sequence_0 result_list in do_return result_list whitespace `unit3` prev lst `nil`) ? if WORD = `(` then (let (unit_0 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push unit_0 result_list in let (more_units_1 , result_list , prev, lst) = more_units lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_units_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `unit3` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`units`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `unit3` WORD lst expected) else fail ? fail;; more_units:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_units`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_1 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,unit_1) in let result_list = push tmp_2 result_list in let (more_units_2 , result_list , prev, lst) = more_units lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_units_2 result_list in do_return result_list whitespace `more_units` prev lst `nil`) else fail ? (do_return result_list whitespace `more_units` WORD lst expected);; caseclause:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`caseclause`,expected,WORD); (let (unit_0 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `OF` in let result_list = push unit_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `OF` WORD lst `caseclause` in let TOKENS = explode WORD in let (choices_1 , result_list , prev, lst) = choices lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push choices_1 result_list in let (poss_case_else_2 , result_list , prev, lst) = poss_case_else lst whitespace prev result_list FIRST_CHARS CHARS `ESAC` in let result_list = push poss_case_else_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `ESAC` WORD lst `caseclause` in let TOKENS = explode WORD in do_return result_list whitespace `caseclause` WORD lst expected);; choices:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`choices`,expected,WORD); (let (choosers_0 , result_list , prev, lst) = choosers lst whitespace WORD result_list FIRST_CHARS CHARS `:` in let result_list = push choosers_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `choices` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_2 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_3 = MK_two(`choice`,POP_1,unit_2) in let result_list = push tmp_3 result_list in let (more_choices_3 , result_list , prev, lst) = more_choices lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_choices_3 result_list in do_return result_list whitespace `choices` prev lst `nil`);; more_choices:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_choices`,expected,WORD); if WORD = `,` then (let (choosers_0 , result_list , prev, lst) = choosers lst whitespace whitespace result_list FIRST_CHARS CHARS `:` in let result_list = push choosers_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `more_choices` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_2 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_3 = MK_two(`choice`,POP_1,unit_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = add_to_list(POP_3,POP_4) in let result_list = push tmp_5 result_list in let (more_choices_5 , result_list , prev, lst) = more_choices lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_choices_5 result_list in do_return result_list whitespace `more_choices` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`choices`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_choices` WORD lst expected);; choosers:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`choosers`,expected,WORD); (let (const_0 , result_list , prev, lst) = const lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`choosers`,const_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `choosers` prev lst `nil`);; poss_case_else:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_case_else`,expected,WORD); if WORD = `ELSE` then (let tmp_0 = MK_zero(`caseclause_ELSEOF`) in let result_list = push tmp_0 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (unit_3 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_4 = MK_four(`caseclause`,POP_0,POP_1,POP_2,unit_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `poss_case_else` prev lst `nil`) else fail ? if WORD = `ELSEOF` then (let (choices_0 , result_list , prev, lst) = choices lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push choices_0 result_list in let (more_elseofs_1 , result_list , prev, lst) = more_elseofs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_elseofs_1 result_list in do_return result_list whitespace `poss_case_else` prev lst `nil`) else fail ? (let tmp_0 = MK_zero(`caseclause_ELSEOF`) in let result_list = push tmp_0 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_three(`caseclause`,POP_0,POP_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `poss_case_else` WORD lst expected);; more_elseofs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_elseofs`,expected,WORD); if WORD = `ELSEOF` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (choices_1 , result_list , prev, lst) = choices lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,choices_1) in let result_list = push tmp_2 result_list in let (more_elseofs_2 , result_list , prev, lst) = more_elseofs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_elseofs_2 result_list in do_return result_list whitespace `more_elseofs` prev lst `nil`) else fail ? (let (end_game_case_0 , result_list , prev, lst) = end_game_case lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push end_game_case_0 result_list in do_return result_list whitespace `more_elseofs` prev lst `nil`);; end_game_case:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`end_game_case`,expected,WORD); if WORD = `ELSE` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`caseclause_ELSEOF`,POP_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (unit_4 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_5 = MK_four(`caseclause`,POP_1,POP_2,POP_3,unit_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `end_game_case` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`caseclause_ELSEOF`,POP_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_three(`caseclause`,POP_1,POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `end_game_case` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_8_decls.ml0000640000212700021270000001473504577677163021553 0ustar cammcammletref unit (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref units_l (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit_fn (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit_mac (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref mac_poss_parms_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_unit_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref macparams (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref macparam (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_macparams (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit1 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit1_finish (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_unit1_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_1st_int (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_2nd_int (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit2 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit2_stuff (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref name_stuff (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref unit3 (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_units (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref caseclause (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref choices (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_choices (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref choosers (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_case_else (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_elseofs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref end_game_case (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/READ-ME0000640000212700021270000000266604601142733020266 0ustar cammcammThe files in this directory comprise a parser for the ELLA hardware description language. The grammar is divided into the following sections: 1. A1_1.grm BASICS 2. A1_2.grm MAIN_LOOP 3. A1_3.grm DECLARATIONS 4. A1_4.grm TYPES 5. A1_5.grm INTEGERS 6. A1_6.grm CONSTANTS 7. A1_7.grm FUNCTIONS 8. A1_8.grm UNITS 9. A1_9.grm SERIES 10. A1_10.grm SEQUENCES 11. A1_11.grm MACROS These sections reflect the organization of the grammar as specified in the ELLA language reference manual. The parser converts ELLA input into a recursive data type suitable for pretty-printing. Transformation functions may then be applied to convert the data type into the HOL logic. The pretty printer is contained in the files PP_printer.ml, full-ella.ml, and PP_command.ml in the current directory, and were generated from the pretty printing language developed by Richard Boulton. To make the parser, edit the Makefile to point to the location of HOL as well as the general.ml file. The parser may be regenerated from scratch by parsing each of the *.grm files (type = ella list). The order in which they are converted is not important. To load in the generated parser, loadf the file loader.ml after editing the path to general.ml. It contains the appropriate definitions of separators, as well as a call to new_syntax_block. Sample input is provided in the ella_files directory. These may be parsed using the ELLA_file function. hol88-2.02.19940316/Library/parser/Examples/ella/PP_command.ml0000640000212700021270000000021604577673407021710 0ustar cammcamm lettype ella = print_tree;; top_print (\pt. pp full_ella_rules_fun `ella` [] pt);; % top_print (\pt. pp raw_tree_rules_fun `` [] pt);; % hol88-2.02.19940316/Library/parser/Examples/ella/PP_printer.ml0000640000212700021270000010713104577673410021753 0ustar cammcamm let max l = % : (int list -> int) % letrec max_fun m l = % : (int -> int list -> int) % if (null l) then m else if ((hd l) > m) then max_fun (hd l) (tl l) else max_fun m (tl l) in if (null l) then failwith `max -- null list given` else max_fun (hd l) (tl l);; let min l = % : (int list -> int) % letrec min_fun m l = % : (int -> int list -> int) % if (null l) then m else if ((hd l) < m) then min_fun (hd l) (tl l) else min_fun m (tl l) in if (null l) then failwith `min -- null list given` else min_fun (hd l) (tl l);; letrec space n = % : (int -> string) % if (n < 1) then `` else ` ` ^ (space (n-1));; let split_list (nh,nt) l = % : ((int # int) -> * list -> (* list # * list # * list)) % letrec get_head n lh lt = % : (int -> * list -> * list -> (* list # * list)) % if ((n < 0) or (n = 0)) then (lh,lt) else if (null lt) then failwith `split_list -- insufficient elements in list` else get_head (n - 1) (lh @ [hd lt]) (tl lt) in let (h,r) = get_head nh [] l and nm = (length l) - (nh + nt) in if (nm < 0) then failwith `split_list -- insufficient elements in list` else (h,get_head nm [] r);; letrec replace assocl (key,new) = % : ((* # **) list -> (* # **) -> (* # **) list) % if (null assocl) then [] else if (key = (fst (hd assocl))) then (key,new).(tl assocl) else (hd assocl).(replace (tl assocl) (key,new));; letrec replacel assocl changes = % : ((* # **) list -> (* # **) list -> (* # **) list) % if (null changes) then assocl else replacel (replace assocl (hd changes)) (tl changes);; abstype nat = int with Nat n = if (n < 0) then failwith `Nat -- number cannot be negative` else abs_nat n and Int n = rep_nat n and print_nat n = print_int (rep_nat n);; top_print print_nat;; let get_margin () = % : (void -> int) % let old = set_margin 0 in let new = set_margin old in old;; rectype print_tree = Print_node of string # print_tree list;; let print_tree_name pt = % : (print_tree -> string) % case pt of (Print_node (s,_)) . s;; let print_tree_children pt = % : (print_tree -> print_tree list) % case pt of (Print_node (_,l)) . l;; type metavar_binding = Bound_name of string | Bound_names of string list | Bound_child of print_tree | Bound_children of print_tree list;; lettype print_binding = (string # metavar_binding) list;; lettype print_test = (string # int) list -> print_binding -> bool;; rectype print_patt_tree = Print_metavar of name_metavar # child_metavar list | Print_loop of print_patt_tree # string # string list # print_patt_tree and name_metavar = Wild_name | Const_name of string | Var_name of string and child_metavar = Wild_child | Wild_children | Patt_child of print_patt_tree | Var_child of string | Var_children of string;; lettype print_pattern = string # print_patt_tree # print_test;; let lookup_metavar pbind mvar = % : (print_binding -> string -> metavar_binding) % (snd (assoc mvar pbind)) ? failwith `lookup_metavar -- Metavariable not found in binding`;; letrec print_merge pb1 pb2 = % : (print_binding -> print_binding -> print_binding) % if (null pb2) then pb1 else ((let p = assoc (fst (hd pb2)) pb1 in if ((snd p) = (snd(hd pb2))) then (print_merge pb1 (tl pb2)) else failwith `print_merge`) ??[`find`] (hd pb2).(print_merge pb1 (tl pb2)) );; letrec raise_binding pb = % : (print_binding -> print_binding) % if (null pb) then [] else let (m,b) = hd pb in (m,case b of (Bound_name s) . (Bound_names [s]) | (Bound_names _) . b | (Bound_child pt) . (Bound_children [pt]) | (Bound_children _) . b ).(raise_binding (tl pb));; letrec raise_bindings pb1 pb2 = % : (print_binding -> print_binding -> print_binding) % if (null pb1) then if (null pb2) then [] else failwith `raise_bindings -- inconsistent bindings` else if (null pb2) then failwith `raise_bindings -- inconsistent bindings` else let (m1,b1) = (hd pb1) and (m2,b2) = (hd pb2) in if (m1 = m2) then (m1,case (b1,b2) of (Bound_name s1,Bound_name s2) . (Bound_names (s1.[s2])) | (Bound_name s1,Bound_names sl2) . (Bound_names (s1.sl2)) | (Bound_names sl1,Bound_name s2) . (Bound_names (sl1 @ [s2])) | (Bound_names sl1,Bound_names sl2) . (Bound_names (sl1 @ sl2)) | (Bound_child pt1,Bound_child pt2) . (Bound_children (pt1.[pt2])) | (Bound_child pt1,Bound_children ptl2) . (Bound_children (pt1.ptl2)) | (Bound_children ptl1,Bound_child pt2) . (Bound_children (ptl1 @ [pt2])) | (Bound_children ptl1,Bound_children ptl2) . (Bound_children (ptl1 @ ptl2)) | (_) . failwith `raise_bindings -- ` ^ `inconsistent bindings` ).(raise_bindings (tl pb1) (tl pb2)) else failwith `raise_bindings -- inconsistent bindings`;; letrec print_tree_match ptpatt pt = % : (print_patt_tree -> print_tree -> print_binding) % letrec name_match m s = % : (name_metavar -> string -> print_binding) % case m of (Wild_name) . [] | (Const_name s') . (if (s = s') then [] else failwith `print_tree_match`) | (Var_name s') . [s',Bound_name s] and children_match ml ptl = % : (child_metavar list -> print_tree list -> print_binding) % letrec correspond ml' ptl' = % : (child_metavar list -> print_tree list -> % % (child_metavar # (print_tree list)) list) % if (null ml') then if (null ptl') then [] else failwith `print_tree_match` else case (hd ml') of (Wild_children) . ( (let (_,l,r) = split_list (0,length (tl ml')) ptl' in ((hd ml'),l).(correspond (tl ml') r)) ? failwith `print_tree_match` ) | (Var_children _) . ( (let (_,l,r) = split_list (0,length (tl ml')) ptl' in ((hd ml'),l).(correspond (tl ml') r)) ? failwith `print_tree_match` ) | (_) . (if (null ptl') then failwith `print_tree_match` else ((hd ml'),[hd ptl']).(correspond (tl ml') (tl ptl')) ) and child_match m ptl' = % : (child_metavar -> print_tree list -> print_binding) % case (m,ptl') of (Wild_child,_) . [] | (Wild_children,_) . [] | (Patt_child ptpatt',[pt']) . (print_tree_match ptpatt' pt') | (Var_child s,[pt']) . [s,Bound_child pt'] | (Var_children s,ptl') . [s,Bound_children ptl'] | (_) . failwith `print_tree_match -- ` ^ `inconsistent arguments to child_match` and merge l = % : ((child_metavar # (print_tree list)) list -> print_binding) % if (null l) then [] else print_merge (child_match (fst (hd l)) (snd (hd l))) (merge (tl l)) in merge (correspond ml ptl) and loop_match ptpatt' s fixedpb subpatt pb pt' = % : (print_patt_tree -> string -> print_binding -> print_patt_tree -> % % print_binding -> print_tree -> (print_binding # print_tree)) % let traps = [`print_tree_match`;`print_merge`] in (let mainpb = print_tree_match ptpatt' pt' in let newpt = lookup_loop_metavar mainpb s in let newpb = print_merge (print_merge mainpb (print_tree_match subpatt newpt)) fixedpb in loop_match ptpatt' s fixedpb subpatt (raise_bindings pb newpb) newpt ) ?? traps (pb,pt') and lookup_loop_metavar pb s = % : (print_binding -> string -> print_tree) % case (lookup_metavar pb s) of (Bound_child pt') . pt' | (_) . failwith `print_tree_match -- attempt to loop on non-print_tree` in case ptpatt of (Print_metavar (nm,cml)) . (print_merge (children_match cml (print_tree_children pt)) (name_match nm (print_tree_name pt))) | (Print_loop (ptpatt',s,fixl,subpatt)) . (let mainpb = print_tree_match ptpatt' pt in let newpt = lookup_loop_metavar mainpb s in let pb = print_merge mainpb (print_tree_match subpatt newpt) in let fixedpb = filter (\p. mem (fst p) fixl) pb in let (pb',pt') = loop_match ptpatt' s fixedpb subpatt pb newpt in replacel (raise_binding pb') ((s,Bound_child pt').fixedpb));; let print_pattern_match (ppatt:print_pattern) context params pt = % : (print_pattern -> string -> (string # int) list -> print_tree -> % % print_binding) % if (((fst ppatt) = ``) or ((fst ppatt) = context)) then let result = (print_tree_match (fst (snd ppatt)) pt) in (if ((snd (snd ppatt)) params result) then result else failwith `print_pattern_match`) else failwith `print_pattern_match`;; letrec change_params params param_changes = % : ((string # int) list -> (string # int) list -> (string # int) list) % if (null params) then param_changes else if (can (assoc (fst (hd params))) param_changes) then (change_params (tl params) param_changes) else (hd params).(change_params (tl params) param_changes);; rectype print_box = Null_box | Atomic_box of string | Compound_box of (nat # nat # nat) # nat # (print_box # int # int) # (print_box # int # int);; let print_box_io pb = % : (print_box -> int) % case pb of (Null_box) . 0 | (Atomic_box _) . 0 | (Compound_box ((io,_,_),_)) . (Int io);; let print_box_width pb = % : (print_box -> int) % case pb of (Null_box) . 0 | (Atomic_box s) . (length (explode s)) | (Compound_box ((_,width,_),_)) . (Int width);; let print_box_fo pb = % : (print_box -> int) % case pb of (Null_box) . 0 | (Atomic_box s) . (length (explode s)) | (Compound_box ((_,_,fo),_)) . (Int fo);; let print_box_height pb = % : (print_box -> int) % case pb of (Null_box) . 0 | (Atomic_box _) . 1 | (Compound_box (_,height,_)) . (Int height);; let print_box_sizes pb = % : (print_box -> (int # int # int) # int) % case pb of (Null_box) . ((0,0,0),0) | (Atomic_box s) . (let w = length (explode s) in ((0,w,w),1)) | (Compound_box ((io,w,fo),h,_)) . ((Int io,Int w,Int fo),Int h);; % join_boxes does not work properly with boxes of zero height. % let join_boxes x y pb1 pb2 = % : (int -> int -> print_box -> print_box -> print_box) % let ((io1,w1,fo1),h1) = print_box_sizes pb1 and ((io2,w2,fo2),h2) = print_box_sizes pb2 in let lo = x - io2 and ro = (w2 - io2) - (w1 - x) in let io = if (lo < 0) then (io1 - lo) else io1 and w = if (lo < 0) then if (ro < 0) then (w1 - lo) else w2 else if (ro < 0) then w1 else (w2 + lo) and fo = if (lo < 0) then fo2 else (fo2 + lo) and h = h1 + h2 + y and x1 = 0 and y1 = 0 and x2 = x - io1 and y2 = h1 + y in (Compound_box ((Nat io,Nat w,Nat fo),Nat h,(pb1,x1,y1),(pb2,x2,y2)));; let join_H_boxes dx pb1 pb2 = % : (nat -> print_box -> print_box -> print_box) % case (pb1,pb2) of (Null_box,_) . pb2 | (_,Null_box) . pb1 | (Atomic_box s1,Atomic_box s2) . (Atomic_box (s1 ^ (space (Int dx)) ^ s2)) | (_) . (join_boxes ((print_box_fo pb1) + (Int dx)) (-1) pb1 pb2);; let join_V_boxes di dh pb1 pb2 = % : (int -> nat -> print_box -> print_box -> print_box) % case (pb1,pb2) of (Null_box,_) . pb2 | (_,Null_box) . pb1 | (_) . (join_boxes ((print_box_io pb1) + di) (Int dh) pb1 pb2);; type print_indent = Abs of int | Inc of int;; type unbuilt_box = UB_H of (int -> int -> print_box) # (nat # (int -> int -> print_box)) list | UB_V of (int -> int -> print_box) # ((print_indent # nat) # (int -> int -> print_box)) list | UB_HV of (int -> int -> print_box) # ((nat # print_indent # nat) # (int -> int -> print_box)) list | UB_HoV of (int -> int -> print_box) # ((nat # print_indent # nat) # (int -> int -> print_box)) list;; let build_H_box m i box boxl = % : (int -> int -> (int -> int -> print_box) -> % % (nat # (int -> int -> print_box)) list -> print_box) % letrec f pb m' i boxl' = % : (print_box -> int -> int -> % % (nat # (int -> int -> print_box)) list -> print_box) % if (null boxl') then pb else let (dx,pbfn) = hd boxl' in let m'' = m' + 1 + (Int dx) and i' = i + ((print_box_fo pb) - (print_box_io pb)) + (Int dx) in f (join_H_boxes dx pb (pbfn m'' i')) m'' i (tl boxl') and gaps boxl' = % : ((nat # (int -> int -> print_box)) list -> int) % itlist (\x n. (Int (fst x)) + n) boxl' 0 in let m' = m - ((gaps boxl) + (length boxl)) in f (box m' i) m' i boxl;; let build_V_box m i box boxl = % : (int -> int -> (int -> int -> print_box) -> % % ((print_indent # nat) # (int -> int -> print_box)) list -> print_box) % letrec f pb m i i' boxl' = % : (print_box -> int -> int -> int -> % % ((print_indent # nat) # (int -> int -> print_box)) list -> % % print_box) % if (null boxl') then pb else let ((pi,dh),pbfn) = hd boxl' in let di = case pi of (Abs n) . n | (Inc n) . (n + i' - i) in f (join_V_boxes di dh pb (pbfn m (i + di))) m i (i + di) (tl boxl') in f (box m i) m i i boxl;; let build_HV_box m i box boxl = % : (int -> int -> (int -> int -> print_box) -> % % ((nat # print_indent # nat) # (int -> int -> print_box)) list -> % % print_box) % letrec fH newboxl newbox m i i' boxl' = % : ((int # nat # print_box) list -> % % (int # nat # print_box) -> int -> int -> int -> % % ((nat # print_indent # nat) # (int -> int -> print_box)) list -> % % (int # nat # print_box) list) % if (null boxl') then newbox.newboxl else let ((dx,pi,dh),pbfn) = hd boxl' and (newdi,newdh,pb) = newbox in let di = case pi of (Abs n) . n | (Inc n) . (n + i' - i) and no_break_indent = (Int dx) + (print_box_fo pb) - (print_box_io pb) in if ((di - (i' - i)) < no_break_indent) then let newb = pbfn m (i + di) in let newhb = join_H_boxes dx pb newb in if (((print_box_width newhb) > m) or ((print_box_width newhb) - (print_box_io newhb) > (m - max [i';0]))) then fH (newbox.newboxl) (di,dh,newb) m i (i + di) (tl boxl') else fH newboxl (newdi,newdh,newhb) m i i' (tl boxl') else let newhb = join_H_boxes dx pb (pbfn m (i' + no_break_indent)) in fH newboxl (newdi,newdh,newhb) m i i' (tl boxl') in let newboxl = fH [] (0,Nat 0,box m i) m i i boxl in itlist (\(di,dh,pb2) pb1. join_V_boxes di dh pb1 pb2) newboxl Null_box;; let build_HoV_box m i box boxl = % : (int -> int -> (int -> int -> print_box) -> % % ((nat # print_indent # nat) # (int -> int -> print_box)) list -> % % print_box) % letrec f newboxl m i i' boxl' = % : ((nat # int # nat # print_box) list -> int -> int -> int -> % % ((nat # print_indent # nat) # (int -> int -> print_box)) list -> % % (nat # int # nat # print_box) list) % if (null boxl') then newboxl else let ((dx,pi,dh),pbfn) = hd boxl' in let di = case pi of (Abs n) . n | (Inc n) . (n + i' - i) in f ((dx,di,dh,pbfn m (i + di)).newboxl) m i (i + di) (tl boxl') in let newb = box m i and newboxl = f [] m i i boxl in let newhb = itlist (\(dx,di,dh,pb2) pb1. join_H_boxes dx pb1 pb2) newboxl newb in let hw = print_box_width newhb and hio = print_box_io newhb in if ((hw > m) or (hw - hio > (m - max [i;0]))) then let newvb = itlist (\(dx,di,dh,pb2) pb1. join_V_boxes di dh pb1 pb2) newboxl newb in let vw = print_box_width newvb and vio = print_box_io newvb in if ((hw > vw) or (hw - hio > vw - vio)) then newvb else newhb else newhb;; let build_print_box m i unbox = % : (int -> int -> unbuilt_box -> print_box) % case unbox of (UB_H (box,boxl)) . (build_H_box m i box boxl) | (UB_V (box,boxl)) . (build_V_box m i box boxl) | (UB_HV (box,boxl)) . (build_HV_box m i box boxl) | (UB_HoV (box,boxl)) . (build_HoV_box m i box boxl);; lettype print_int_exp = (string # int) list -> print_binding -> int;; rectype print_box_spec = H_box of (nat # print_object) list | V_box of ((print_indent # nat) # print_object) list | HV_box of ((nat # print_indent # nat) # print_object) list | HoV_box of ((nat # print_indent # nat) # print_object) list and print_format = PF_empty | PF of print_box_spec | PF_branch of print_test # print_format # print_format and print_object = PO_constant of string | PO_leaf of string # (string -> string) | PO_subcall of (string # (print_tree list -> print_tree list)) # (string # print_int_exp) list | PO_context_subcall of string # (string # (print_tree list -> print_tree list)) # (string # print_int_exp) list | PO_format of print_format | PO_expand of print_box_spec;; let PF_H = PF o H_box and PF_V = PF o V_box and PF_HV = PF o HV_box and PF_HoV = PF o HoV_box;; lettype print_rule = print_pattern # print_format;; lettype print_rule_function = string -> (string # int) list -> print_tree -> (print_binding # print_format);; letrec print_rule_fun prl context params pt = % : (print_rule list -> string -> (string # int) list -> print_tree -> % % (print_binding # print_format)) % % : (print_rule list -> print_rule_function) % if (null prl) then failwith `print_rule_fun` else let traps = [`print_pattern_match`;`print_tree_match`;`print_merge`] in ( (print_pattern_match (fst (hd prl)) context params pt, snd (hd prl)) ?? traps (print_rule_fun (tl prl) context params pt) );; ml_curried_infix `then_try`;; let then_try prf1 prf2 = % : (print_rule_function -> print_rule_function -> print_rule_function) % (\context params pt. ( (prf1 context params pt) ?? [`print_rule_fun`] (prf2 context params pt) )) : print_rule_function;; let raw_tree_rules = % : (print_rule list) % [(``,Print_metavar (Var_name `n`,[Var_children `cl`;Var_child `c`]), (\x y. true)), (PF_HV [(Nat 0,Abs 0,Nat 0), PO_leaf (`n`,(\s.s)); (Nat 0,Abs 3,Nat 0), PO_format (PF_H [Nat 0, PO_constant `(`; Nat 0, PO_format (PF_HoV [(Nat 0,Abs 0,Nat 0), PO_expand (H_box [Nat 0, PO_subcall ((`cl`,(\l.l)),[]); Nat 0, PO_constant `,`]); (Nat 0,Abs 0,Nat 0), PO_subcall ((`c`,(\l.l)),[])]); Nat 0, PO_constant `)`])]); (``,Print_metavar (Var_name `n`,[]),(\x y. true)), (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]) ] : print_rule list;; let raw_tree_rules_fun = % : (print_rule_function) % print_rule_fun raw_tree_rules;; letrec expand_binding pb = % : (print_binding -> print_binding list) % letrec split_binding b pb' = % : (bool -> print_binding -> (print_binding # print_binding # bool)) % if (null pb') then ([],[],b) else let (pbhead,pbtail,flag) = split_binding b (tl pb') and (m,mb) = hd pb' in let (h,t,f) = case mb of (Bound_name _) . ((m,mb),(m,mb),flag) | (Bound_names sl) . (if (null sl) then ((m,mb),(m,mb),flag) else ((m,Bound_name (hd sl)), (m,Bound_names (tl sl)),true)) | (Bound_child _) . ((m,mb),(m,mb),flag) | (Bound_children ptl) . (if (null ptl) then ((m,mb),(m,mb),flag) else ((m,Bound_child (hd ptl)), (m,Bound_children (tl ptl)),true)) in ((h.pbhead),(t.pbtail),f) in let (newpb,restpb,more_to_do) = split_binding false pb in if more_to_do then newpb.(expand_binding restpb) else [];; letrec print_tree_to_box m i prf context params pt = % : (int -> int -> print_rule_function -> string -> (string # int) list -> % % print_tree -> print_box) % let (pbind,pf) = ( (prf context params pt) ?? [`print_rule_fun`] (raw_tree_rules_fun context params pt) ) in print_format_fun pt m i prf context params pf pbind and print_box_spec_fun oldpt m i prf context params pbind pbs = % : (print_tree -> int -> int -> print_rule_function -> string -> % % (string # int) list -> print_binding -> print_box_spec -> print_box) % let f pof xpol = % : ((print_rule_function -> string -> (string # int) list -> % % print_binding -> print_object -> (int -> int -> print_box) list) % % -> (* # print_object) list -> % % (int -> int -> print_box) # (* # (int -> int -> print_box)) list) % let xpbfnl = flat (map (\(x,po). map (\pbfn. (x,pbfn)) (pof po)) xpol) in if (null xpbfnl) then failwith `print_box_spec_fun` else (snd (hd xpbfnl),tl xpbfnl) and pof = print_object_fun oldpt prf context params pbind in build_print_box m i (case pbs of (H_box xpol) . (UB_H (f pof xpol)) | (V_box xpol) . (UB_V (f pof xpol)) | (HV_box xpol) . (UB_HV (f pof xpol)) | (HoV_box xpol) . (UB_HoV (f pof xpol))) and print_format_fun oldpt m i prf context params pf pbind = % : (print_tree -> int -> int -> print_rule_function -> string -> % % (string # int) list -> print_format -> print_binding -> print_box) % case pf of (PF_empty) . Null_box | (PF pbs) . ( (print_box_spec_fun oldpt m i prf context params pbind pbs) ?? [`print_box_spec_fun`] Null_box ) | (PF_branch (ptest,pf1,pf2)) . (if (ptest params pbind) then (print_format_fun oldpt m i prf context params pf1 pbind) else (print_format_fun oldpt m i prf context params pf2 pbind)) and print_object_fun oldpt prf context params pbind po = % : (print_tree -> print_rule_function -> string -> (string # int) list -> % % print_binding -> print_object -> (int -> print_box) list) % case po of (PO_constant s) . [\m i. Atomic_box s] | (PO_leaf (metavar,string_fun)) . (case (lookup_metavar pbind metavar) of (Bound_name s) . [\m i. Atomic_box (string_fun s)] | (Bound_names sl) . (map (\s m i. Atomic_box (string_fun s)) sl) | (_) . failwith `print_tree_to_box -- ` ^ `type of metavariable in pattern does n't match type in format`) | (PO_subcall ((metavar,list_fun),param_changes)) . (let ptl = case (if (metavar = ``) then (Bound_child oldpt) else (lookup_metavar pbind metavar)) of (Bound_child pt) . [pt] | (Bound_children ptl) . ptl | (_) . failwith (`print_tree_to_box -- ` ^ `type of metavariable in pattern ` ^ `does n't match type in format`) in map (\pt m i. print_tree_to_box m i prf context (change_params params (map (\(s,f). s,(f params pbind)) param_changes)) pt) (list_fun ptl)) | (PO_context_subcall (new_context,x)) . (print_object_fun oldpt prf new_context params pbind (PO_subcall x)) | (PO_format pf) . [\m i. print_format_fun oldpt m i prf context params pf pbind] | (PO_expand x) . (map (\pbind' m i. print_format_fun oldpt m i prf context params (PF x) pbind') (expand_binding pbind) );; let join_strings (s1,x1) (s2,x2) = % : (string # int -> string # int -> string # int) % if (x1 = x2) then if ((s1 = ``) or (s2 = ``)) then (s1 ^ s2,x1) else failwith `join_strings -- overlapping strings` else if (x1 < x2) then let sep = x2 - (x1 + length (explode s1)) in if (sep < 0) then failwith `join_strings -- overlapping strings` else (s1 ^ (space sep) ^ s2,x1) else let sep = x1 - (x2 + length (explode s2)) in if (sep < 0) then failwith `join_strings -- overlapping strings` else (s2 ^ (space sep) ^ s1,x2);; letrec merge_string_lists sl1 sl2 = % : ((string # int # int) list -> (string # int # int) list -> % % (string # int # int) list) % if (null sl1) then sl2 else if (null sl2) then sl1 else let (s1,x1,y1) = hd sl1 and (s2,x2,y2) = hd sl2 in (if (y1 = y2) then (let (s,x) = join_strings (s1,x1) (s2,x2) in (s,x,y1).(merge_string_lists (tl sl1) (tl sl2))) if (y1 < y2) then (hd sl1).(merge_string_lists (tl sl1) sl2) if (y1 > y2) then (hd sl2).(merge_string_lists sl1 (tl sl2)) else fail);; letrec stringify_print_box x y pb = % : (int -> int -> print_box -> (string # int # int) list) % case pb of (Null_box) . [] | (Atomic_box s) . [s,x,y] | (Compound_box (_,_,(pb1,x1,y1),(pb2,x2,y2))) . (merge_string_lists (stringify_print_box (x+x1) (y+y1) pb1) (stringify_print_box (x+x2) (y+y2) pb2));; letrec fill_in_strings t b sl = % : (int -> int -> (string # int # int) list -> string list) % if ((t = b) or (t > b)) then if (null sl) then [] else failwith `fill_in_strings -- string below specified region` else if (null sl) then (``).(fill_in_strings (t+1) b sl) else let (s,x,y) = hd sl in if (x < 0) then failwith (`fill_in_strings -- ` ^ `string to the left of specified region`) else if (y < t) then failwith (`fill_in_strings -- ` ^ `string above specified region`) else if (y = t) then ((space x) ^ s). (fill_in_strings (t+1) b (tl sl)) else (``).(fill_in_strings (t+1) b sl);; let print_box_to_strings i pb = % : (int -> print_box -> string list) % fill_in_strings 0 (print_box_height pb) (stringify_print_box i 0 pb);; let display_strings sl = % : (string list -> void) % do (map (\s. tty_write (s ^ `\L`)) sl);; let output_strings file app sl = % : (string -> bool -> string list -> void) % let port = if app then append_openw file else openw file in do (map (\s. write (port,(s ^ `\L`))) sl; close port);; let insert_strings sl = % : (string list -> void) % letrec terminate_strings sl' = % : (string list -> string list) % if (null sl') then [] else if (null (tl sl')) then [hd sl'] else ((hd sl') ^ `\L`).(terminate_strings (tl sl')) in do (map print_string (terminate_strings sl));; let pretty_print m i prf context params pt = % : (int -> int -> print_rule_function -> string -> (string # int) list -> % % print_tree -> void) % (display_strings o (print_box_to_strings i)) (print_tree_to_box m i prf context params pt);; let pp prf context params pt = % : (print_rule_function -> string -> (string # int) list -> print_tree -> % % void) % (insert_strings o (print_box_to_strings 0)) (print_tree_to_box (get_margin ()) 0 prf context params pt);; ml_curried_infix `is_a_member_of`;; let is_a_member_of metavar sl = % : (string -> string list -> print_test) % (\params pbind. mem (case (lookup_metavar pbind metavar) of (Bound_name s) . s | (_) . failwith (`is_a_member_of -- used on a metavar that is ` ^ `not bound to a name`)) sl) : print_test;; let bound_number s = % : (string -> ((string # int) list -> print_binding -> int)) % (\params (pbind:print_binding). (snd (assoc s params)) ? failwith (`bound_number -- `^s^` not in parameters`));; let bound_name meta = % : (string -> ((string # int) list -> print_binding -> string)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_name -- \``^meta^`' not a metavariable`)) of (Bound_name s) . s | (_) . failwith (`bound_name -- metavar \``^meta^`' not bound to a name`));; let bound_names meta = % : (string -> ((string # int) list -> print_binding -> string list)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_names -- \``^meta^`' not a metavariable`)) of (Bound_names sl) . sl | (_) . failwith (`bound_names -- metavar \``^meta^`' not bound to names`));; let bound_child meta = % : (string -> ((string # int) list -> print_binding -> print_tree)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_child -- \``^meta^`' not a metavariable`)) of (Bound_child pt) . pt | (_) . failwith (`bound_child -- metavar \``^meta^ `' not bound to a child`));; let bound_children meta = % : (string -> ((string # int) list -> print_binding -> string)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_children -- \``^meta^`' not a metavariable`)) of (Bound_children ptl) . ptl | (_) . failwith (`bound_children -- metavar \``^meta^ `' not bound to children`));; let apply0 f = % : (* -> ((string # int) list -> print_binding -> *)) % (\(params:(string # int) list) (pbind:print_binding). f);; let apply1 f val = % : ((* -> **) -> ((string # int) list -> print_binding -> *) -> % % ((string # int) list -> print_binding -> **)) % (\(params:(string # int) list) (pbind:print_binding). f (val params pbind));; let apply2 f val1 val2 = % : ((* -> ** -> **) -> % % ((string # int) list -> print_binding -> *) -> % % ((string # int) list -> print_binding -> **) -> % % ((string # int) list -> print_binding -> ***)) % (\(params:(string # int) list) (pbind:print_binding). f (val1 params pbind) (val2 params pbind));; hol88-2.02.19940316/Library/parser/Examples/ella/full-ella.ml0000640000212700021270000024514504577673410021556 0ustar cammcamm let ella_basics_rules = % : (print_rule list) % letrec quote_quote = (\dummy0. ((\s. letrec dupl s sl = if (null sl) then [] else if ((hd sl) = s) then s.s.(dupl s (tl sl)) else (hd sl).(dupl s (tl sl)) in (implode o (dupl s) o explode) ) dummy0)) and is_symbolic_prefix_op = (\dummy0. ((\op. apply1 (\s. (s = `+`) or (s = `-`)) (bound_name op) ) dummy0)) in [ ((``,(Print_metavar ((Const_name `name`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(I))))]))); ((``,(Print_metavar ((Const_name `names`), [(Var_child `name1`);(Var_children `name2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`name1`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`name2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `char`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `'`));((Nat 0),(PO_leaf (`string`,(I))))]))); ((``,(Print_metavar ((Const_name `fnname`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `uppercasename`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(I))))]))); ((``,(Print_metavar ((Const_name `symbolicname`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(I))))]))); ((``,(Print_metavar ((Const_name `macname`),[(Var_child `fnname`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`fnname`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `biopname`),[(Var_child `fnname`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`fnname`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `integervalue`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(I))))]))); ((``,(Print_metavar ((Const_name `string`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `"`)); ((Nat 0),(PO_leaf (`string`,(quote_quote `"`)))); ((Nat 0),(PO_constant `"`))]))); ((``,(Print_metavar ((Const_name `operator`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)), (PF_branch ((is_symbolic_prefix_op `string`), (PF (H_box [((Nat 0),(PO_leaf (`string`,(I))))])), (PF (H_box [((Nat 0),(PO_leaf (`string`,(I)))); ((Nat 0),(PO_constant ` `))]))))) ] : print_rule list;; let ella_basics_rules_fun = % : (print_rule_function) % print_rule_fun ella_basics_rules;; let ella_text_rules = % : (print_rule list) % [ ((``,(Print_metavar ((Const_name `text`), [(Var_child `declaration1`);(Var_children `declaration2`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 1)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`declaration1`,(I)),[]))); ((Nat 0),(PO_constant `.`))])))); (((Abs 0),(Nat 1)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`declaration2`,(I)),[]))); ((Nat 0),(PO_constant `.`))])))]))) ] : print_rule list;; let ella_text_rules_fun = % : (print_rule_function) % print_rule_fun ella_text_rules;; let ella_declarations_rules = % : (print_rule list) % [ ((``, (Print_metavar ((Const_name `declaration`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `typedecs`), [(Var_children `typedec1`);(Var_child `typedec2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `TYPE`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`typedec1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`typedec2`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `intdecs`), [(Var_children `intdec1`);(Var_child `intdec2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `INT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`intdec1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`intdec2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `constdecs`), [(Var_children `constdec1`);(Var_child `constdec2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `CONST`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`constdec1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`constdec2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `fndecs`), [(Var_children `fndec1`);(Var_child `fndec2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `FN`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`fndec1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`fndec2`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `macdecs`), [(Var_children `macdec1`);(Var_child `macdec2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `MAC`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`macdec1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`macdec2`,(I)),[])))]))))]))) ] : print_rule list;; let ella_declarations_rules_fun = % : (print_rule_function) % print_rule_fun ella_declarations_rules;; let ella_types_rules = % : (print_rule list) % [ ((``, (Print_metavar ((Const_name `typedec`),[(Var_child `name`);(Var_child `child`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `enum_types`), [(Var_children `enum_type1`);(Var_child `enum_type2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `NEW(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs (-2)),(Nat 0)), (PO_expand (H_box [((Nat 1), (PO_subcall ((`enum_type1`,(I)),[]))); ((Nat 1),(PO_constant `|`))]))); (((Nat 1),(Abs (-2)),(Nat 0)), (PO_subcall ((`enum_type2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `enum_type`),[(Var_child `name`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `enum_type`), [(Var_child `name`);(Var_child `type`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `&`)); ((Nat 0),(PO_subcall ((`type`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `enum_int`), [(Var_child `name`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `NEW`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `/`)); ((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `enum_chars`),[(Var_child `name`); (Var_children `enum_char1`); (Var_child `enum_char2`)])), (\x y. true)), (PF (H_box [((Nat 1),(PO_constant `NEW`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 1), (PO_subcall ((`enum_char1`, (I)),[]))); ((Nat 1), (PO_constant `|`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`enum_char2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))))]))); ((``,(Print_metavar ((Const_name `enum_char`),[(Var_child `char`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`char`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `enum_char`), [(Var_child `char1`);(Var_child `char2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`char1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`char2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `type`),[(Var_child `type1`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`type1`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `type`),[(Var_child `type11`);(Var_child `type12`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`type11`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `->`)); ((Nat 1),(PO_subcall ((`type12`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `type1`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `type_tuple`), [(Var_children `type1`);(Var_child `type2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`type1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`type2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))); ((``, (Print_metavar ((Const_name `type_int`),[(Var_child `int`);(Var_child `type`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`type`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `type_STRING`), [(Var_child `int`);(Var_child `name`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `STRING`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`name`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `type2`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `type_INT`),[(Var_child `name`);(Var_child `type`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_constant `INT`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`type`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `type_STRING_INT`), [(Var_child `name1`);(Var_child `name2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `STRING`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_constant `INT`)); ((Nat 1),(PO_subcall ((`name1`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`name2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `type_TYPE`),[(Var_child `name`)])), (\x y. true)),(PF (H_box [((Nat 1),(PO_constant `TYPE`)); ((Nat 1),(PO_subcall ((`name`,(I)),[])))]))) ] : print_rule list;; let ella_types_rules_fun = % : (print_rule_function) % print_rule_fun ella_types_rules;; let ella_integers_rules = % : (print_rule list) % letrec prec_val = (\dummy0. ((\symb. case symb of `+` . 2 | `-` . 2 | `*` . 1 | `%` . 1 | _ . 3 ) dummy0)) and prec = (\dummy0. ((bound_number `prec`) dummy0)) and prec_of = (\dummy0. ((\meta. apply1 prec_val (bound_name meta)) dummy0)) and prec_test = (\dummy0. ((\meta. apply2 (curry $<) (prec_of meta) prec) dummy0)) in [ ((``,(Print_metavar ((Const_name `intdec`),[(Var_child `name`);(Var_child `int`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`int`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `int`),[(Var_child `formula`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`formula`,(I)),[(`prec`,(apply0 4))])))]))); ((``,(Print_metavar ((Const_name `formula`),[(Var_child `formula1`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`formula1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `formula`), [(Var_child `formula`); (Patt_child (Print_metavar ((Const_name `operator`), [(Patt_child (Print_metavar ((Var_name `op`),[])))]))); (Var_child `formula1`)])),(\x y. true)), (PF (H_box [((Nat 0), (PO_format (PF_branch ((prec_test `op`),PF_empty, (PF (H_box [((Nat 0),(PO_constant `(`))])))))); ((Nat 0), (PO_format (PF (HV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1), (PO_subcall ((`formula`,(I)), [(`prec`,(prec_of `op`))]))); ((Nat 1),(PO_leaf (`op`,(I))))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`formula1`,(I)),[(`prec`,(prec_of `op`))])))])))); ((Nat 0), (PO_format (PF_branch ((prec_test `op`),PF_empty, (PF (H_box [((Nat 0),(PO_constant `)`))]))))))]))); ((``, (Print_metavar ((Const_name `formula1`), [(Var_child `formula2`);(Var_children `operator`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`operator`,(I)),[]))); ((Nat 0),(PO_subcall ((`formula2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `formula2`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `formula2_cond`), [(Var_child `boolean`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `IF`)); ((Nat 1),(PO_subcall ((`boolean`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `THEN`)); ((Nat 1),(PO_subcall ((`int1`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `ELSE`)); ((Nat 1),(PO_subcall ((`int2`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_constant `FI`))]))); ((``,(Print_metavar ((Const_name `formula2_int`),[(Var_child `int`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `boolean`),[(Var_child `formula`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`formula`,(I)),[(`prec`,(apply0 4))])))]))) ] : print_rule list;; let ella_integers_rules_fun = % : (print_rule_function) % print_rule_fun ella_integers_rules;; let ella_constants_rules = % : (print_rule list) % [ ((``,(Print_metavar ((Const_name `constdec`), [(Var_child `name`);(Var_child `const`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`const`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `const`), [(Var_children `const11`);(Var_child `const12`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 1),(PO_subcall ((`const11`,(I)),[]))); ((Nat 1),(PO_constant `|`))]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`const12`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const1`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `const1`),[(Var_child `int`);(Var_child `const1`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`const1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const1_STRING`), [(Var_child `int`);(Var_child `const2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `STRING`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`const2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `const2`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const2_formula2`), [(Var_child `name`);(Var_child `formula2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `/`)); ((Nat 0),(PO_subcall ((`formula2`,(I)),[(`prec`,(apply0 4))])))]))); ((``,(Print_metavar ((Const_name `const2_char`), [(Var_child `name`);(Var_child `char`)])), (\x y. true)),(PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_subcall ((`char`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const2_string`), [(Var_child `name`);(Var_child `string`)])), (\x y. true)),(PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_subcall ((`string`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const2_const2`), [(Var_child `name`);(Var_child `const2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `&`)); ((Nat 0),(PO_subcall ((`const2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const2_tuple`), [(Var_children `const1`);(Var_child `const2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`const1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`const2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `const2_uninit`),[(Var_child `const2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `?`)); ((Nat 0),(PO_subcall ((`const2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `const2_char_range`), [(Var_child `name`);(Var_child `char1`);(Var_child `char2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`char1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`char2`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `const2_int_range`), [(Var_child `name`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `/`)); ((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))) ] : print_rule list;; let ella_constants_rules_fun = % : (print_rule_function) % print_rule_fun ella_constants_rules;; let ella_functions_rules = % : (print_rule list) % [ ((``, (Print_metavar ((Const_name `fndec`), [(Var_child `fnname`);(Var_child `fnset`);(Var_child `fnbody`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1), (PO_subcall ((`fnname`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_subcall ((`fnset`,(I)),[]))); ((Nat 0),(PO_constant `:`))]))))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`fnbody`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `fnset`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `fnset`),[(Var_child `int`);(Var_child `fnarrow`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `FNSET`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`fnarrow`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))))]))); ((``, (Print_metavar ((Const_name `fnarrow`),[(Var_child `input`);(Var_child `type`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`input`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `->`)); ((Nat 1),(PO_subcall ((`type`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `fnarrows`), [(Var_children `fnarrow1`);(Var_child `fnarrow2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `FNSET`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`fnarrow1`,(I)), []))); ((Nat 0), (PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`fnarrow2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))))]))); ((``,(Print_metavar ((Const_name `input`), [(Var_children `inputitem1`);(Var_child `inputitem2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`inputitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`inputitem2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `inputitem`),[(Var_child `type`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`type`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `inputitem`), [(Var_child `type`);(Var_child `names`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`type`,(I)),[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`names`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `fnbody`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `fnbody_ARITH`),[(Var_child `int`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `ARITH`)); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`int`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `fnbody_BIOP`),[(Var_child `biopname`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `BIOP`)); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`biopname`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `fnbody_BIOP`), [(Var_child `biopname`);(Var_child `macparams`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `BIOP`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`biopname`,(I)),[]))); ((Nat 0),(PO_constant `{`)); ((Nat 0),(PO_subcall ((`macparams`,(I)),[]))); ((Nat 0),(PO_constant `}`))]))))]))); ((``,(Print_metavar ((Const_name `fnbody_REFORM`),[])),(\x y. true)), (PF (H_box [((Nat 0),(PO_constant `REFORM`))]))); ((``,(Print_metavar ((Const_name `fnbody_IMPORT`),[])),(\x y. true)), (PF (H_box [((Nat 0),(PO_constant `IMPORT`))]))); ((``,(Print_metavar ((Const_name `fnbody_DELAY`), [(Var_child `const1`);(Var_child `int`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `DELAY`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`const1`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))))]))); ((``,(Print_metavar ((Const_name `fnbody_DELAY`), [(Var_child `const1`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `DELAY`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`const1`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))))]))); ((``, (Print_metavar ((Const_name `fnbody_DELAY`),[(Var_child `const11`); (Var_child `int1`); (Var_child `const12`); (Var_child `int2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `DELAY`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`const11`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`const12`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))))]))); ((``,(Print_metavar ((Const_name `fnbody_IDELAY`), [(Var_child `const1`);(Var_child `int`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `IDELAY`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`const1`,(I)),[]))); ((Nat 0),(PO_constant `,`)); ((Nat 1),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))))]))); ((``, (Print_metavar ((Const_name `fnbody_RAM`),[(Var_child `const1`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `RAM`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_subcall ((`const1`,(I)),[]))); ((Nat 0),(PO_constant `)`))]))))]))) ] : print_rule list;; let ella_functions_rules_fun = % : (print_rule_function) % print_rule_fun ella_functions_rules;; let ella_units_rules = % : (print_rule list) % [ ((``,(Print_metavar ((Const_name `unit`),[(Var_child `unit1`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`unit1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit`),[(Var_child `unit`);(Var_child `child`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit_fn`),[(Var_child `fnname`); (Var_child `unit_names`); (Var_child `unit1`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`fnname`,(I)),[]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`unit_names`,(I)),[]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`unit1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit_mac`),[(Var_child `macname`); (Var_child `unit_names`); (Var_child `unit1`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`macname`,(I)),[]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`unit_names`,(I)),[]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`unit1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit_mac`),[(Var_child `macname`); (Var_child `macparams`); (Var_child `unit_names`); (Var_child `unit1`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`macname`,(I)),[]))); ((Nat 0),(PO_constant `{`)); ((Nat 0),(PO_subcall ((`macparams`,(I)),[]))); ((Nat 0),(PO_constant `}`))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`unit_names`,(I)),[]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`unit1`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `unit_names`),[(Var_children `name`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_constant `@`)); ((Nat 0),(PO_subcall ((`name`,(I)),[])))])))]))); ((``,(Print_metavar ((Const_name `macparams`), [(Var_children `macparam1`);(Var_child `macparam2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`macparam1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`macparam2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `macparam`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit1`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit1_1`), [(Var_child `unit2`);(Var_child `unit_names`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit2`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit_names`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `unit1_4`),[(Var_child `int`);(Var_child `unit1`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`unit1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit1_5`),[(Var_child `name`); (Var_child `int1`); (Var_child `int2`); (Var_child `unit1`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_constant `INT`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`)); ((Nat 1),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`unit1`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `unit1_6`),[(Var_child `name`);(Var_child `unit1`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `&`)); ((Nat 0),(PO_subcall ((`unit1`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `unit1_7`),[(Var_child `int`);(Var_child `unit1`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `STRING`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`unit1`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `unit1_8`),[(Var_child `unit2`);(Var_child `name`)])), (\x y. true)),(PF (H_box [((Nat 1),(PO_subcall ((`unit2`,(I)),[]))); ((Nat 1),(PO_constant `//`)); ((Nat 1),(PO_subcall ((`name`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit1_9`),[(Var_child `name`)])), (\x y. true)),(PF (H_box [((Nat 1),(PO_constant `IO`)); ((Nat 1),(PO_subcall ((`name`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `unit1_9`),[(Var_child `name`);(Var_child `int`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `IO`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))); ((``,(Print_metavar ((Const_name `unit1_9`), [(Var_child `name`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `IO`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))); ((``,(Print_metavar ((Const_name `unit2`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `unit2_uninit`),[(Var_child `type`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_constant `?`)); ((Nat 0),(PO_subcall ((`type`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `unit2_int`), [(Var_child `unit2`);(Var_child `int`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`unit2`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))); ((``,(Print_metavar ((Const_name `unit2_unit`), [(Var_child `unit2`);(Var_child `unit`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`unit2`,(I)),[]))); ((Nat 0),(PO_constant `[[`)); ((Nat 0),(PO_subcall ((`unit`,(I)),[]))); ((Nat 0),(PO_constant `]]`))]))); ((``,(Print_metavar ((Const_name `unit2_int_range`), [(Var_child `unit2`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`unit2`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))); ((``, (Print_metavar ((Const_name `unit2_cond`), [(Var_child `boolean`);(Var_child `unit1`);(Var_child `unit2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `IF`)); ((Nat 1),(PO_subcall ((`boolean`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `THEN`)); ((Nat 1),(PO_subcall ((`unit1`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `ELSE`)); ((Nat 1),(PO_subcall ((`unit2`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_constant `FI`))]))); ((``,(Print_metavar ((Const_name `unit3`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `units`), [(Var_children `unit1`);(Var_child `unit2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`unit1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`unit2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `caseclause`),[(Var_child `unit`); (Var_child `choices`); (Var_child `caseclause_elseof`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `CASE`)); ((Nat 1),(PO_subcall ((`unit`,(I)),[])))])))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `OF`)); ((Nat 1),(PO_subcall ((`choices`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_subcall ((`caseclause_elseof`,(I)),[]))); (((Abs 0),(Nat 0)),(PO_constant `ESAC`))]))); ((``,(Print_metavar ((Const_name `caseclause`),[(Var_child `unit1`); (Var_child `choices`); (Var_child `caseclause_elseof`); (Var_child `unit2`)])),(\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `CASE`)); ((Nat 1),(PO_subcall ((`unit1`,(I)),[])))])))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `OF`)); ((Nat 1),(PO_subcall ((`choices`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_subcall ((`caseclause_elseof`,(I)),[]))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `ELSE`)); ((Nat 1),(PO_subcall ((`unit2`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_constant `ESAC`))]))); ((``,(Print_metavar ((Const_name `caseclause_ELSEOF`),[(Var_children `choices`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 1),(PO_constant `ELSEOF`)); ((Nat 1),(PO_subcall ((`choices`,(I)),[])))])))]))); ((``, (Print_metavar ((Const_name `choices`), [(Var_children `choice1`);(Var_child `choice2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`choice1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`choice2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `choice`), [(Var_child `choosers`);(Var_child `unit`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`choosers`,(I)),[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `choosers`),[(Var_child `const`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`const`,(I)),[])))]))) ] : print_rule list;; let ella_units_rules_fun = % : (print_rule_function) % print_rule_fun ella_units_rules;; let ella_series_rules = % : (print_rule list) % [ ((``,(Print_metavar ((Const_name `series`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `series_BEGINEND`), [(Var_child `unit`);(Var_children `step`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)),(PO_constant `BEGIN`)); (((Abs 3),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`step`,(I)),[]))); ((Nat 0),(PO_constant `.`))]))); (((Abs 3),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_constant `OUTPUT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall ((`unit`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_constant `END`))]))); ((``,(Print_metavar ((Const_name `series_brackets`), [(Var_child `unit`);(Var_children `step`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`step`,(I)),[]))); ((Nat 0),(PO_constant `.`))]))); (((Abs 0),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_constant `OUTPUT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall ((`unit`,(I)),[])))]))))])))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `step`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `step`), [(Var_child `multiplier`);(Var_child `step_join`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `FOR`)); ((Nat 1),(PO_subcall ((`multiplier`,(I)),[])))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`step_join`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `step_MAKE`), [(Var_children `makeitem1`);(Var_child `makeitem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `MAKE`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`makeitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`makeitem2`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `step_LET`), [(Var_children `letitem1`);(Var_child `letitem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `LET`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`letitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`letitem2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `step_JOIN`), [(Var_children `joinitem1`);(Var_child `joinitem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `JOIN`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`joinitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`joinitem2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `step_PRINT`), [(Var_children `printitem1`);(Var_child `printitem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `PRINT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`printitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`printitem2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `step_FAULT`), [(Var_children `faultitem1`);(Var_child `faultitem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `FAULT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`faultitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`faultitem2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `makeitem`),[(Var_child `makeitem_body`); (Var_child `unit_names`); (Var_child `names`)])),(\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`makeitem_body`,(I)),[]))); ((Nat 1),(PO_subcall ((`unit_names`,(I)),[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`names`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `makeitem`),[(Var_child `int`); (Var_child `makeitem_body`); (Var_child `unit_names`); (Var_child `names`)])),(\x y. true)), (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_subcall ((`makeitem_body`,(I)),[]))); ((Nat 1),(PO_subcall ((`unit_names`,(I)),[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall ((`names`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `makeitem_body`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `makeitem_mac`),[(Var_child `macname`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`macname`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `makeitem_mac`), [(Var_child `macname`);(Var_child `macparams`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`macname`,(I)),[]))); ((Nat 0),(PO_constant `{`)); ((Nat 0),(PO_subcall ((`macparams`,(I)),[]))); ((Nat 0),(PO_constant `}`))]))); ((``,(Print_metavar ((Const_name `makeitem_mac`),[(Var_child `macname`); (Var_child `macparams1`); (Var_child `macparams2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`macname`,(I)),[]))); ((Nat 0),(PO_constant `{`)); ((Nat 0),(PO_subcall ((`macparams1`,(I)),[]))); ((Nat 0),(PO_constant `}`)); ((Nat 0),(PO_constant `{`)); ((Nat 0),(PO_subcall ((`macparams2`,(I)),[]))); ((Nat 0),(PO_constant `}`))]))); ((``, (Print_metavar ((Const_name `letitem`),[(Var_child `name`);(Var_child `unit`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `joinitem`),[(Var_child `unit`);(Var_child `name`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `->`)); ((Nat 1),(PO_subcall ((`name`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `joinitem`), [(Var_child `unit`);(Var_child `name`);(Var_child `int`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `->`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))))]))); ((``,(Print_metavar ((Const_name `joinitem`),[(Var_child `unit`); (Var_child `name`); (Var_child `int1`); (Var_child `int2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[]))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `->`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))))]))); ((``,(Print_metavar ((Const_name `multiplier`),[(Var_child `multiplier_int1`); (Var_children `multiplier_int2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`multiplier_int1`,(I)),[]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`multiplier_int2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `multiplier_INT`), [(Var_child `name`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `INT`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `printitem`),[(Var_child `printables`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`printables`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `printitem`), [(Var_child `boolean`);(Var_child `printables`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `IF`)); ((Nat 1),(PO_subcall ((`boolean`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `THEN`)); ((Nat 1),(PO_subcall ((`printables`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_constant `FI`))]))); ((``,(Print_metavar ((Const_name `printables`), [(Var_child `printable1`);(Var_children `printable2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Inc 3),(Nat 0)), (PO_subcall ((`printable1`,(I)),[]))); (((Nat 1),(Inc 3),(Nat 0)),(PO_subcall ((`printable2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `printable`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `faultitem`),[(Var_child `printitem`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`printitem`,(I)),[])))]))) ] : print_rule list;; let ella_series_rules_fun = % : (print_rule_function) % print_rule_fun ella_series_rules;; let ella_sequences_rules = % : (print_rule list) % [ ((``,(Print_metavar ((Const_name `sequence`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `sequence_BEGINEND`), [(Var_child `unit`);(Var_children `sequencestep`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)),(PO_constant `BEGIN SEQ`)); (((Abs 3),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`sequencestep`,(I)),[]))); ((Nat 0),(PO_constant `;`))]))); (((Abs 3),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_constant `OUTPUT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall ((`unit`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_constant `END`))]))); ((``, (Print_metavar ((Const_name `sequence_brackets`), [(Var_child `unit`);(Var_children `sequencestep`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0),(PO_constant `SEQ`)); ((Nat 1), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`sequencestep`,(I)),[]))); ((Nat 0),(PO_constant `;`))]))); (((Abs 0),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_constant `OUTPUT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall ((`unit`,(I)),[])))]))))])))); ((Nat 0),(PO_constant `)`))]))); ((``, (Print_metavar ((Const_name `sequencestep`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `sequencestep_VAR`), [(Var_children `varitem1`);(Var_child `varitem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `VAR`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`varitem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`varitem2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `sequencestep_STATEVAR`), [(Var_children `statevaritem1`);(Var_child `statevaritem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `STATE VAR`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`statevaritem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`statevaritem2`,(I)),[])))]))))]))); ((``,(Print_metavar ((Const_name `sequencestep_PVAR`), [(Var_child `statevaritem1`);(Var_children `statevaritem2`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `PVAR`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`statevaritem1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)), (PO_subcall ((`statevaritem2`,(I)),[])))]))))]))); ((``, (Print_metavar ((Const_name `varitem`),[(Var_child `name`);(Var_child `unit`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `:=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `statevaritem`),[(Var_child `statevaritem_init`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_subcall ((`statevaritem_init`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `statevaritem`), [(Var_child `name`);(Var_child `const1`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `::=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`const1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `statevaritem_INIT`), [(Var_child `name`);(Var_child `const1`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `INIT`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`const1`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `statement`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `statements`), [(Var_children `statement1`);(Var_child `statement2`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0), (PO_subcall ((`statement1`,(I)),[]))); ((Nat 0),(PO_constant `;`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall ((`statement2`,(I)),[])))])))); ((Nat 0),(PO_constant `)`))]))); ((``,(Print_metavar ((Const_name `statement_assign`), [(Var_child `varname`);(Var_child `unit`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall ((`varname`,(I)),[]))); ((Nat 1),(PO_constant `:=`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`unit`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `statement_INT`),[(Var_child `name`); (Var_child `int1`); (Var_child `int2`); (Var_child `statement`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_constant `INT`)); ((Nat 1),(PO_subcall ((`name`,(I)),[]))); ((Nat 1),(PO_constant `=`)); ((Nat 1),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `]`)); ((Nat 0),(PO_subcall ((`statement`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `statement_cond`), [(Var_child `boolean`);(Var_child `statement`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `IF`)); ((Nat 1),(PO_subcall ((`boolean`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `THEN`)); ((Nat 1),(PO_subcall ((`statement`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_constant `FI`))]))); ((``,(Print_metavar ((Const_name `statement_cond`),[(Var_child `boolean`); (Var_child `statement1`); (Var_child `statement2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `IF`)); ((Nat 1),(PO_subcall ((`boolean`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `THEN`)); ((Nat 1),(PO_subcall ((`statement1`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `ELSE`)); ((Nat 1),(PO_subcall ((`statement2`,(I)),[])))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_constant `FI`))]))); ((``, (Print_metavar ((Const_name `statement_case`),[(Var_child `unit`); (Var_child `seqchoices`); (Var_child `statement_elseof`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `CASE`)); ((Nat 1),(PO_subcall ((`unit`,(I)),[])))])))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `OF`)); ((Nat 1),(PO_subcall ((`seqchoices`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_subcall ((`statement_elseof`,(I)),[]))); (((Abs 0),(Nat 0)),(PO_constant `ESAC`))]))); ((``,(Print_metavar ((Const_name `statement_case`),[(Var_child `unit`); (Var_child `seqchoices`); (Var_child `statement_elseof`); (Var_child `statement`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `CASE`)); ((Nat 1),(PO_subcall ((`unit`,(I)),[])))])))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `OF`)); ((Nat 1),(PO_subcall ((`seqchoices`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_subcall ((`statement_elseof`,(I)),[]))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `ELSE`)); ((Nat 1),(PO_subcall ((`statement`,(I)),[])))])))); (((Abs 0),(Nat 0)),(PO_constant `ESAC`))]))); ((``, (Print_metavar ((Const_name `statement_ELSEOF`),[(Var_children `seqchoices`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 1),(PO_constant `ELSEOF`)); ((Nat 1),(PO_subcall ((`seqchoices`,(I)),[])))])))]))); ((``,(Print_metavar ((Const_name `varname`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `varname_int`), [(Var_child `varname`);(Var_child `int`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`varname`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))); ((``,(Print_metavar ((Const_name `varname_unit`), [(Var_child `varname`);(Var_child `unit`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`varname`,(I)),[]))); ((Nat 0),(PO_constant `[[`)); ((Nat 0),(PO_subcall ((`unit`,(I)),[]))); ((Nat 0),(PO_constant `]]`))]))); ((``, (Print_metavar ((Const_name `varname_int_range`), [(Var_child `varname`);(Var_child `int1`);(Var_child `int2`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`varname`,(I)),[]))); ((Nat 0),(PO_constant `[`)); ((Nat 0),(PO_subcall ((`int1`,(I)),[]))); ((Nat 0),(PO_constant `..`)); ((Nat 0),(PO_subcall ((`int2`,(I)),[]))); ((Nat 0),(PO_constant `]`))]))); ((``,(Print_metavar ((Const_name `seqchoices`), [(Var_children `seqchoice1`);(Var_child `seqchoice2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`seqchoice1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`seqchoice2`,(I)),[])))]))); ((``, (Print_metavar ((Const_name `seqchoice`),[(Var_child `choosers`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`choosers`,(I)),[]))); ((Nat 0),(PO_constant `:`))]))); ((``, (Print_metavar ((Const_name `seqchoice`), [(Var_child `choosers`);(Var_child `statement`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall ((`choosers`,(I)),[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall ((`statement`,(I)),[])))]))) ] : print_rule list;; let ella_sequences_rules_fun = % : (print_rule_function) % print_rule_fun ella_sequences_rules;; let ella_macros_rules = % : (print_rule list) % [ ((``,(Print_metavar ((Const_name `macdec`),[(Var_child `macname`); (Var_child `fnset`); (Var_child `fnbody`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1), (PO_subcall ((`macname`,(I)),[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_subcall ((`fnset`,(I)),[]))); ((Nat 0),(PO_constant `:`))]))))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`fnbody`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `macdec`),[(Var_child `macname`); (Var_child `macspec`); (Var_child `fnarrow`); (Var_child `fnbody`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_subcall ((`macname`,(I)),[]))); ((Nat 0),(PO_constant `{`)); ((Nat 0), (PO_subcall ((`macspec`,(I)),[]))); ((Nat 0),(PO_constant `}`)); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_subcall ((`fnarrow`,(I)),[]))); ((Nat 0),(PO_constant `:`))]))))])))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`fnbody`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `macspec`), [(Var_children `mactypes1`);(Var_child `mactypes2`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall ((`mactypes1`,(I)),[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall ((`mactypes2`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `mactypes`), [(Var_child `mactype`);(Var_child `names`)])), (\x y. true)),(PF (H_box [((Nat 1),(PO_subcall ((`mactype`,(I)),[]))); ((Nat 1),(PO_subcall ((`names`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `mactype`),[(Var_child `child`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall ((`child`,(I)),[])))]))); ((``,(Print_metavar ((Const_name `mactype_INT`),[])),(\x y. true)), (PF (H_box [((Nat 0),(PO_constant `INT`))]))); ((``,(Print_metavar ((Const_name `mactype_TYPE`),[])),(\x y. true)), (PF (H_box [((Nat 0),(PO_constant `TYPE`))]))) ] : print_rule list;; let ella_macros_rules_fun = % : (print_rule_function) % print_rule_fun ella_macros_rules;; let full_ella_rules_fun = ella_basics_rules_fun then_try ella_text_rules_fun then_try ella_declarations_rules_fun then_try ella_types_rules_fun then_try ella_integers_rules_fun then_try ella_constants_rules_fun then_try ella_functions_rules_fun then_try ella_units_rules_fun then_try ella_series_rules_fun then_try ella_sequences_rules_fun then_try ella_macros_rules_fun;; hol88-2.02.19940316/Library/parser/Examples/ella/general.ml0000640000212700021270000001226505034371040021270 0ustar cammcammletref FAIL_LIST = []:(string#string#string) list;; letref FIRST_CHARS = []:string list;; letref CHARS = []:string list;; let pg_failwith symb prdn = FAIL_LIST := append FAIL_LIST [(`*`,prdn,symb)]; fail;; let push item lst = (item . lst);; let pop lst = if null lst then failwith `can't pop null list` else (hd lst,tl lst);; let write_string str file = if file = `nil` then tty_write str else write(file,str);; let read_char file = if file = `nil` then tty_read() else (read file);; let close_file file = if file = `nil` then () else close file;; let open_file direction filename = if filename = `nil` then `nil` else if mem direction [`in` ; `input` ; `i`] then openi filename else if mem direction [`out`; `output`; `o`] then openw filename else failwith (concat `can't open ` (concat filename (concat ` in direction ` direction)));; letrec e_w_s file chr whitespace = if mem chr whitespace then e_w_s file (read_char file) whitespace else if chr = `nil` then failwith `unexpected eof` else chr;; letrec e_w_s_ok file chr whitespace = if mem chr whitespace then e_w_s_ok file (read_char file) whitespace else if chr = `nil` then `nil` else chr;; let determine_lst ch follow white = if follow = white then mem ch white else not (mem ch follow);; letrec get_word2 ch lst file white seps = if ch = `nil` then (lst,`nil`) else if can (assoc ch) seps then (lst,ch) else if mem ch white then (lst,e_w_s_ok file (read_char file) white) else get_word2 (read_char file) (append lst [ch]) file white seps;; letrec get_word1 ch lst file follow white = if ch = `nil` then (lst,`nil`) else if not (mem ch follow) then (lst,e_w_s_ok file ch white) else get_word1 (read_char file) (append lst [ch]) file follow white;; let complete_separator thing file white seps = if can (assoc thing) seps then let follow = snd (assoc thing seps) in if null follow then (thing,e_w_s_ok file (read_char file) white) else let (wrd,sep) = get_word1 (read_char file) [thing] file follow white in (implode wrd,sep) else let (wrd,sep) = get_word2 (read_char file) [thing] file white seps in (implode wrd,sep);; let get_word file white last seps sep = if mem last white then failwith `Generated Parser Error, please report it.` else if not (mem sep white) then (last,sep) else if last = `nil` then (`nil`,`nil`) else complete_separator last file white seps;; letrec read_input file lst white seps prev = let (WORD,sep) = get_word file white prev seps (hd white) in let lst = append lst [WORD] in if WORD = `nil` then (close_file file; lst) else read_input file lst white seps sep;; let gnt lst white WORD = if WORD = `nil` then if null lst then (`nil`,[]) else failwith `Unexpected end of term.` else if WORD = white then (hd lst,tl lst) else (WORD,lst);; let eat_terminal token WORD lst prdn = if WORD = token then if WORD = `nil` then if null lst then (`nil`,[]) else failwith `Unexpected end of term.` else (hd lst,tl lst) else pg_failwith WORD prdn (concat `expected "` (concat token `".`));; letrec chop_off ctr pop_list result_list = if ctr = 0 then (result_list,pop_list) else chop_off (ctr-1) ((hd result_list) . pop_list) (tl result_list);; let do_return_1 res_list white prdn thing lst expect = if thing = white then (FAIL_LIST := append FAIL_LIST [(`<`,prdn,``)]; (hd res_list, tl res_list, (hd lst), (tl lst))) else if thing = expect then (FAIL_LIST := append FAIL_LIST [(`<`,prdn,``)]; (hd res_list, tl res_list, thing, lst)) else (FAIL_LIST := append FAIL_LIST [(`*`,prdn,thing)]; fail);; let do_return res_list white prdn prev lst expect = if expect = `nil` then (FAIL_LIST := append FAIL_LIST [(`<`,prdn,``)]; (hd res_list, tl res_list, prev, lst)) else do_return_1 res_list white prdn prev lst expect;; letrec write_tabs tab = if tab = 0 then () else (write_string ` ` `nil`;write_tabs (tab-1));; letrec backtrace lst tab = if null lst then write_string `\L` `nil` else let (dir,prdn,symb) = hd lst in if dir = `>` then (write_tabs (tab+2); write_string (`>> `^prdn^`: "`^symb^`"\L`) `nil`; backtrace (tl lst) (tab+2)) else if dir = `<` then (write_tabs tab; write_string (`<< `^prdn^`\L`) `nil`; backtrace (tl lst) (tab-2)) else (write_tabs tab; write_string (`** `^prdn^`: "`^symb^`" (FAIL)\L`) `nil`; backtrace (tl lst) (tab-2));; let evaluation_failed lst = write_string `\L\LERROR: unrecognisable input.\L` `nil`; write_string ` -- TRACE: \L` `nil`; backtrace lst 3; FAIL_LIST := []; fail;; hol88-2.02.19940316/Library/parser/Examples/ella/loader.ml0000640000212700021270000000222304577677503021142 0ustar cammcamm% Generated parser load file First load some basic definitions: % loadf `/usr/groups/hol/hol_12/Library/parser/general`;; loadf `PP_printer`;; loadf `full-ella`;; loadf `PP_command`;; % Insert any other files you want loaded here: % loadf `v1_help`;; % Now load the declarations: % loadf `A1_1_decls`;; loadf `A1_2_decls`;; loadf `A1_3_decls`;; loadf `A1_4_decls`;; loadf `A1_5_decls`;; loadf `A1_6_decls`;; loadf `A1_7_decls`;; loadf `A1_8_decls`;; loadf `A1_9_decls`;; loadf `A1_10_decls`;; loadf `A1_11_decls`;; % Finally load in the function definitions: % loadf `A1_1`;; loadf `A1_2`;; loadf `A1_3`;; loadf `A1_4`;; loadf `A1_5`;; loadf `A1_6`;; loadf `A1_7`;; loadf `A1_8`;; loadf `A1_9`;; loadf `A1_10`;; loadf `A1_11`;; let SEPS = [(`;`,[]);(`|`,[]);(`:`,[`=`]);(`,`,[]);(`(`,[]);(`)`,[]); (`}`,[]);(`{`,[]);(`+`,[]);(`-`,[`>`]);(`*`,[]);(`#`,[]);(`%`,[]); (`=`,[]);(`/`,[`/`;`=`]);(`>`,[`=`]);(`<`,[`=`]);(`.`,[`.`]); (`[`,[]);(`]`,[]);(`&`,[])];; let ELLA_text thing = hd (PARSE_text(thing,[],SEPS)) and ELLA_file thing = hd (PARSE_file(thing,[],SEPS));; new_syntax_block(`BEGIN_ELLA`,`END_ELLA`,`ELLA_text`);; hol88-2.02.19940316/Library/parser/Examples/ella/v1_help.ml0000640000212700021270000000654004577674741021241 0ustar cammcammlet lower thing flag = if thing = `_` then true else if ascii_code thing > 96 then if ascii_code thing < 123 then true else false else if not flag then if mem thing (words `1 2 3 4 5 6 7 8 9 0`) then true else false else false;; let upper thing flag = if thing = `_` then true else if ascii_code thing > 64 then if ascii_code thing < 91 then true else false else if not flag then if mem thing (words `1 2 3 4 5 6 7 8 9 0`) then true else false else false;; letrec is_lower lst flag = if null lst then true else if lower (hd lst) flag then is_lower (tl lst) false else false;; letrec is_upper lst flag = if null lst then true else if upper (hd lst) flag then is_upper (tl lst) false else false;; let reserved thing = mem thing [`ARITH`;`BEGIN`;`BIOP`;`CASE`;`COM`;`CONC`;`CONST`;`DELAY`; `ELSE`;`ELSEOF`;`END`;`ESAC`;`FAULT`;`FI`;`FINISH`;`FN`; `FNSET`;`FOR`;`IDELAY`;`IF`;`IMPORT`;`IMPORTS`;`INIT`; `INT`;`IO`;`JOIN`;`LET`;`MAC`;`MAKE`;`MOC`;`MODULE`; `NEW`;`OF`;`OUTPUT`;`PRINT`;`PVAR`;`RAM`;`REFORM`;`RENAMED`; `SEQ`;`STATE`;`STRING`;`THEN`;`TYPE`;`VAR`];; let add_to_list (lst,thing) = (append lst thing):ella list;; let MK_zero node = [Print_node (node,[])];; let MK_one (node,a) = [Print_node (node,a)];; let MK_two (node,a,b) = [Print_node (node,(hd a).b)];; let MK_three (node,a,b,c) = [Print_node (node,(hd a).(hd b).c)];; let MK_four (node,a,b,c,d) = [Print_node (node,(hd a).(hd b).(hd c).d)];; let MK_five (node,a,b,c,d,e) = [Print_node (node,(hd a).(hd b).(hd c).(hd d).e)];; let MK_string thing = MK_one(`string`,(MK_zero thing));; let MK_fnname thing = if is_upper (explode thing) true then if not (reserved thing) then MK_one(`fnname`,(MK_one (`uppercasename`, MK_zero thing))) else failwith `FNNAME` else failwith `FNNAME`;; let MK_typename thing = if is_lower (explode thing) true then MK_one(`name`,MK_zero thing) else failwith `TYPENAME`;; let MK_digit thing = if can int_of_string thing then MK_one(`integervalue`,MK_zero thing) else failwith `DIGIT`;; let MK_char thing = if length (explode thing) = 1 then MK_one(`name`,MK_zero thing) else failwith `CHAR`;; let MK_name thing = if is_lower (explode thing) true then MK_one(`name`,MK_zero thing) else failwith `NAME`;; let MK_text thing = [Print_node (`text`,thing)];; % A1.5 Integers % let MK_op thing = Print_node (`operator`,(MK_zero thing));; let MK_unary(expr,op) = MK_one (`formula1`, (MK_op op) . expr);; let MK_binary(lhs,rhs,op) = MK_one (`formula`,(hd lhs).(MK_op op).rhs);; hol88-2.02.19940316/Library/parser/Examples/ella/version0_PP.ml0000640000212700021270000003550204577673411022040 0ustar cammcamm let ella_rules = % : (print_rule list) % [ ((`ella`,(Print_metavar ((Const_name `name`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(\s.s))))]))); ((`ella`,(Print_metavar ((Const_name `fnname`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(\s.s))))]))); ((`ella`,(Print_metavar ((Const_name `type`), [(Patt_child (Print_metavar ((Var_name `string`),[])))])), (\x y. true)),(PF (H_box [((Nat 0),(PO_leaf (`string`,(\s.s))))]))); ((`ella`, (Print_metavar ((Const_name `text`),[(Var_children `decls`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 1)), (PO_expand (H_box [((Nat 0),(PO_subcall (`decls`,[]))); ((Nat 0),(PO_constant `.`))])))]))); ((`ella`,(Print_metavar ((Const_name `typedec`),[(Var_child `name`); (Var_child `firstname`); (Var_children `othernames`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `TYPE`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_subcall (`name`,[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `NEW(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1), (Abs (-2)),(Nat 0)), (PO_subcall (`firstname`,[]))); (((Nat 1),(Abs (-2)), (Nat 0)), (PO_expand (H_box [((Nat 1), (PO_constant `|`)); ((Nat 1), (PO_subcall (`othernames`, [])))])))])))); ((Nat 0),(PO_constant `)`))]))))]))))]))); ((`ella`, (Print_metavar ((Const_name `inputitem`),[(Var_child `type`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall (`type`,[])))]))); ((`ella`,(Print_metavar ((Const_name `inputitem`), [(Var_child `type`);(Var_children `names`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall (`type`,[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_subcall (`names`,[])))]))))]))); ((`ella`,(Print_metavar ((Const_name `inputitem_list`), [(Var_children `items`);(Var_child `item`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`items`,[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall (`item`,[])))])))); ((Nat 0),(PO_constant `)`))]))); ((`ella`,(Print_metavar ((Const_name `fndec`),[(Var_child `fnname`); (Var_child `items`); (Var_child `type`); (Var_child `fnbody`)])), (\x y. true)), (PF (V_box [(((Abs 1),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `FN`)); ((Nat 1), (PO_subcall (`fnname`,[]))); ((Nat 1),(PO_constant `=`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_format (PF (HV_box [(((Nat 1),(Abs 3), (Nat 0)), (PO_subcall (`items`,[]))); (((Nat 1),(Abs 3), (Nat 0)), (PO_format (PF (H_box [((Nat 1), (PO_constant `->`)); ((Nat 1), (PO_subcall (`type`, [])))]))))])))); ((Nat 0),(PO_constant `:`))]))))])))); (((Abs 1),(Nat 0)),(PO_subcall (`fnbody`,[])))]))); ((`ella`, (Print_metavar ((Const_name `fnbody`),[(Var_child `fnbody`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall (`fnbody`,[])))]))); ((`ella`, (Print_metavar ((Const_name `delay`),[(Var_child `name`);(Var_child `int`)])), (\x y. true)), (PF (HV_box [(((Nat 0),(Abs 3),(Nat 0)),(PO_constant `DELAY`)); (((Nat 0),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0), (PO_subcall (`name`,[]))); ((Nat 0), (PO_constant `,`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall (`int`,[])))])))); ((Nat 0),(PO_constant `)`))]))))]))); ((`ella`,(Print_metavar ((Const_name `unit`),[(Var_child `unit`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall (`unit`,[])))]))); ((`ella`,(Print_metavar ((Const_name `tuple`), [(Var_children `units`);(Var_child `unit`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`units`,[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall (`unit`,[])))])))); ((Nat 0),(PO_constant `)`))]))); ((`ella`, (Print_metavar ((Const_name `choosers`),[(Var_child `name`)])), (\x y. true)),(PF (H_box [((Nat 0),(PO_subcall (`name`,[])))]))); ((`ella`,(Print_metavar ((Const_name `choosers`), [(Var_children `names`);(Var_child `name`)])), (\x y. true)), (PF (H_box [((Nat 0),(PO_constant `(`)); ((Nat 0), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`names`,[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)), (PO_subcall (`name`,[])))])))); ((Nat 0),(PO_constant `)`))]))); ((`ella`,(Print_metavar ((Const_name `choices`), [(Var_child `choosers`);(Var_child `unit`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall (`choosers`,[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall (`unit`,[])))]))); ((`ella`, (Print_metavar ((Const_name `choices_list`), [(Var_children `choices`);(Var_child `choice`)])), (\x y. true)), (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`choices`,[]))); ((Nat 0),(PO_constant `,`))]))); (((Nat 1),(Abs 0),(Nat 0)),(PO_subcall (`choice`,[])))]))); ((`ella`,(Print_metavar ((Const_name `else_clause`),[])),(\x y. true)), PF_empty); ((`ella`, (Print_metavar ((Const_name `else_clause`),[(Var_child `unit`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `ELSE`)); (((Nat 1),(Abs 3),(Nat 0)),(PO_subcall (`unit`,[])))]))); ((`ella`,(Print_metavar ((Const_name `caseclause`),[(Var_child `unit`); (Var_child `choices_list`); (Var_child `else_clause`)])), (\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `CASE`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall (`unit`,[])))])))); (((Abs 0),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `OF`)); ((Nat 1),(PO_subcall (`choices_list`,[])))])))); (((Abs 0),(Nat 0)),(PO_subcall (`else_clause`,[]))); (((Abs 0),(Nat 0)),(PO_constant `ESAC`))]))); ((`ella`,(Print_metavar ((Const_name `series`), [(Patt_child (Print_metavar ((Const_name `step_list`),[(Var_children `steps`)]))); (Var_child `unit`)])),(\x y. true)), (PF (V_box [(((Abs 0),(Nat 0)),(PO_constant `BEGIN`)); (((Abs 3),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`steps`,[]))); ((Nat 0),(PO_constant `.`))]))); (((Abs 3),(Nat 0)), (PO_format (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_constant `OUTPUT`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_subcall (`unit`,[])))])))); (((Abs 0),(Nat 0)),(PO_constant `END`))]))); ((`ella`, (Print_metavar ((Const_name `makeitem`), [(Var_child `fnname`); (Patt_child (Print_metavar ((Const_name `name_list`),[(Var_children `names`)])))])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 0),(PO_subcall (`fnname`,[]))); ((Nat 0),(PO_constant `:`))])))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (HoV_box [(((Nat 1),(Abs 0),(Nat 0)), (PO_subcall (`names`,[])))]))))]))); ((`ella`,(Print_metavar ((Const_name `make`), [(Var_children `makeitems`);(Var_child `makeitem`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `MAKE`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`makeitems`,[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)),(PO_subcall (`makeitem`,[])))]))))]))); ((`ella`, (Print_metavar ((Const_name `joinitem`),[(Var_child `unit`);(Var_child `name`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_subcall (`unit`,[]))); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (H_box [((Nat 1),(PO_constant `->`)); ((Nat 1),(PO_subcall (`name`,[])))]))))]))); ((`ella`,(Print_metavar ((Const_name `join`), [(Var_children `joinitems`);(Var_child `joinitem`)])), (\x y. true)), (PF (HV_box [(((Nat 1),(Abs 3),(Nat 0)),(PO_constant `JOIN`)); (((Nat 1),(Abs 3),(Nat 0)), (PO_format (PF (V_box [(((Abs 0),(Nat 0)), (PO_expand (H_box [((Nat 0),(PO_subcall (`joinitems`,[]))); ((Nat 0),(PO_constant `,`))]))); (((Abs 0),(Nat 0)),(PO_subcall (`joinitem`,[])))]))))]))) ] : print_rule list;; let ella_rules_fun = % : (print_rule_function) % print_rule_fun ella_rules;; hol88-2.02.19940316/Library/parser/Examples/ella/Makefile0000640000212700021270000003445004577673542021010 0ustar cammcamm# Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol_12/hol # General definitions for all generated parsers: GENERAL=/usr/groups/hol/hol_12/Library/parser/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. PP_printer_ml.o: PP_printer.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `PP_printer`;;'\ 'quit();;' | $(HOL) full-ella_ml.o: full-ella.ml PP_printer_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'compilet `full-ella`;;'\ 'quit();;' | $(HOL) PP_command_ml.o: PP_command.ml full-ella_ml.o PP_printer_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'compilet `PP_command`;;'\ 'quit();;' | $(HOL) PP_v0: PP_printer_ml.o full-ella_ml.o PP_command_ml.o v1_help_ml.o: v1_help.ml PP_printer_ml.o full-ella_ml.o PP_command_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'compilet `v1_help`;;'\ 'quit();;' | $(HOL) # Now compile the declarations: A1_1_decls_ml.o: A1_1_decls.ml v1_help_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'compilet `A1_1_decls`;;'\ 'quit();;' | $(HOL) A1_2_decls_ml.o: A1_2_decls.ml A1_1_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'compilet `A1_2_decls`;;'\ 'quit();;' | $(HOL) A1_3_decls_ml.o: A1_3_decls.ml A1_2_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'compilet `A1_3_decls`;;'\ 'quit();;' | $(HOL) A1_4_decls_ml.o: A1_4_decls.ml A1_3_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'compilet `A1_4_decls`;;'\ 'quit();;' | $(HOL) A1_5_decls_ml.o: A1_5_decls.ml A1_4_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'compilet `A1_5_decls`;;'\ 'quit();;' | $(HOL) A1_6_decls_ml.o: A1_6_decls.ml A1_5_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'compilet `A1_6_decls`;;'\ 'quit();;' | $(HOL) A1_7_decls_ml.o: A1_7_decls.ml A1_6_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'compilet `A1_7_decls`;;'\ 'quit();;' | $(HOL) A1_8_decls_ml.o: A1_8_decls.ml A1_7_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'compilet `A1_8_decls`;;'\ 'quit();;' | $(HOL) A1_9_decls_ml.o: A1_9_decls.ml A1_8_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'compilet `A1_9_decls`;;'\ 'quit();;' | $(HOL) A1_10_decls_ml.o: A1_10_decls.ml A1_9_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'compilet `A1_10_decls`;;'\ 'quit();;' | $(HOL) A1_11_decls_ml.o: A1_11_decls.ml A1_10_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'compilet `A1_11_decls`;;'\ 'quit();;' | $(HOL) decls: A1_1_decls_ml.o A1_2_decls_ml.o A1_3_decls_ml.o A1_4_decls_ml.o \ A1_5_decls_ml.o A1_6_decls_ml.o A1_7_decls_ml.o A1_8_decls_ml.o \ A1_9_decls_ml.o A1_10_decls_ml.o A1_11_decls_ml.o # Finally do the actual functions A1_1_ml.o: A1_1.ml A1_11_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'compilet `A1_1`;;'\ 'quit();;' | $(HOL) A1_2_ml.o: A1_2.ml A1_1_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'compilet `A1_2`;;'\ 'quit();;' | $(HOL) A1_3_ml.o: A1_3.ml A1_2_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'compilet `A1_3`;;'\ 'quit();;' | $(HOL) A1_4_ml.o: A1_4.ml A1_3_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'compilet `A1_4`;;'\ 'quit();;' | $(HOL) A1_5_ml.o: A1_5.ml A1_4_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'compilet `A1_5`;;'\ 'quit();;' | $(HOL) A1_6_ml.o: A1_6.ml A1_5_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'loadf `A1_5`;;'\ 'compilet `A1_6`;;'\ 'quit();;' | $(HOL) A1_7_ml.o: A1_7.ml A1_6_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'loadf `A1_5`;;'\ 'loadf `A1_6`;;'\ 'compilet `A1_7`;;'\ 'quit();;' | $(HOL) A1_8_ml.o: A1_8.ml A1_7_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'loadf `A1_5`;;'\ 'loadf `A1_6`;;'\ 'loadf `A1_7`;;'\ 'compilet `A1_8`;;'\ 'quit();;' | $(HOL) A1_9_ml.o: A1_9.ml A1_8_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'loadf `A1_5`;;'\ 'loadf `A1_6`;;'\ 'loadf `A1_7`;;'\ 'loadf `A1_8`;;'\ 'compilet `A1_9`;;'\ 'quit();;' | $(HOL) A1_10_ml.o: A1_10.ml A1_9_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'loadf `A1_5`;;'\ 'loadf `A1_6`;;'\ 'loadf `A1_7`;;'\ 'loadf `A1_8`;;'\ 'loadf `A1_9`;;'\ 'compilet `A1_10`;;'\ 'quit();;' | $(HOL) A1_11_ml.o: A1_11.ml A1_10_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `PP_printer`;;'\ 'loadf `full-ella`;;'\ 'loadf `PP_command`;;'\ 'loadf `v1_help`;;'\ 'loadf `A1_1_decls`;;'\ 'loadf `A1_2_decls`;;'\ 'loadf `A1_3_decls`;;'\ 'loadf `A1_4_decls`;;'\ 'loadf `A1_5_decls`;;'\ 'loadf `A1_6_decls`;;'\ 'loadf `A1_7_decls`;;'\ 'loadf `A1_8_decls`;;'\ 'loadf `A1_9_decls`;;'\ 'loadf `A1_10_decls`;;'\ 'loadf `A1_11_decls`;;'\ 'loadf `A1_1`;;'\ 'loadf `A1_2`;;'\ 'loadf `A1_3`;;'\ 'loadf `A1_4`;;'\ 'loadf `A1_5`;;'\ 'loadf `A1_6`;;'\ 'loadf `A1_7`;;'\ 'loadf `A1_8`;;'\ 'loadf `A1_9`;;'\ 'loadf `A1_10`;;'\ 'compilet `A1_11`;;'\ 'quit();;' | $(HOL) parser: A1_1_ml.o A1_2_ml.o A1_3_ml.o A1_4_ml.o A1_5_ml.o A1_6_ml.o \ A1_7_ml.o A1_8_ml.o A1_9_ml.o A1_10_ml.o A1_11_ml.o all: decls parser @echo '===> Parser "ella" built'. hol88-2.02.19940316/Library/parser/Examples/ella/A1_9.ml0000640000212700021270000011151505034371111020341 0ustar cammcamm % A1.9 SERIES % series:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`series`,expected,WORD); if WORD = `BEGIN` then (let (BEGIN_steps_0 , result_list , prev, lst) = BEGIN_steps lst whitespace whitespace result_list FIRST_CHARS CHARS `END` in let result_list = push BEGIN_steps_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `END` WORD lst `series` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`series`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `series` WORD lst expected) else fail ? if WORD = `(` then (let (bracket_steps_0 , result_list , prev, lst) = bracket_steps lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push bracket_steps_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `series` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`series`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `series` WORD lst expected) else fail ? fail;; BEGIN_steps:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`BEGIN_steps`,expected,WORD); if WORD = `OUTPUT` then (let (unit_0 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`series_BEGINEND`,unit_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `BEGIN_steps` prev lst `nil`) else fail ? (let (step_0 , result_list , prev, lst) = step lst whitespace WORD result_list FIRST_CHARS CHARS `.` in let result_list = push step_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `.` WORD lst `BEGIN_steps` in let TOKENS = explode WORD in let (more_B_steps_1 , result_list , prev, lst) = more_B_steps lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_B_steps_1 result_list in do_return result_list whitespace `BEGIN_steps` prev lst `nil`);; more_B_steps:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_B_steps`,expected,WORD); if WORD = `OUTPUT` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_0 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`series_BEGINEND`,unit_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_B_steps` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (step_1 , result_list , prev, lst) = step lst whitespace WORD result_list FIRST_CHARS CHARS `.` in let tmp_2 = add_to_list(POP_0,step_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `.` WORD lst `more_B_steps` in let TOKENS = explode WORD in let (more_B_steps_2 , result_list , prev, lst) = more_B_steps lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_B_steps_2 result_list in do_return result_list whitespace `more_B_steps` prev lst `nil`);; bracket_steps:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`bracket_steps`,expected,WORD); if WORD = `OUTPUT` then (let (unit_0 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`series_brackets`,unit_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `bracket_steps` prev lst `nil`) else fail ? (let (step_0 , result_list , prev, lst) = step lst whitespace WORD result_list FIRST_CHARS CHARS `.` in let result_list = push step_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `.` WORD lst `bracket_steps` in let TOKENS = explode WORD in let (more_br_steps_1 , result_list , prev, lst) = more_br_steps lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_br_steps_1 result_list in do_return result_list whitespace `bracket_steps` prev lst `nil`);; more_br_steps:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_br_steps`,expected,WORD); if WORD = `OUTPUT` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_0 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`series_brackets`,unit_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_br_steps` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (step_1 , result_list , prev, lst) = step lst whitespace WORD result_list FIRST_CHARS CHARS `.` in let tmp_2 = add_to_list(POP_0,step_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `.` WORD lst `more_br_steps` in let TOKENS = explode WORD in let (more_br_steps_2 , result_list , prev, lst) = more_br_steps lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_br_steps_2 result_list in do_return result_list whitespace `more_br_steps` prev lst `nil`);; step:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`step`,expected,WORD); if WORD = `MAKE` then (let (makeitem_0 , result_list , prev, lst) = makeitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push makeitem_0 result_list in let (more_makeitems_1 , result_list , prev, lst) = more_makeitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_makeitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_MAKE`,POP_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`step`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `step` prev lst `nil`) else fail ? if WORD = `LET` then (let (letitem_0 , result_list , prev, lst) = letitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push letitem_0 result_list in let (more_letitems_1 , result_list , prev, lst) = more_letitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_letitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_LET`,POP_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`step`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `step` prev lst `nil`) else fail ? if WORD = `FOR` then (let (multiplier_0 , result_list , prev, lst) = multiplier lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`multiplier`,multiplier_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (joinstep_2 , result_list , prev, lst) = joinstep lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`step`,POP_1,joinstep_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `step` prev lst `nil`) else fail ? (let (joinstep_0 , result_list , prev, lst) = joinstep lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`step`,joinstep_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `step` prev lst `nil`) ? if WORD = `PRINT` then (let (printitem_0 , result_list , prev, lst) = printitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push printitem_0 result_list in let (more_printitems_1 , result_list , prev, lst) = more_printitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_printitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_PRINT`,POP_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`step`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `step` prev lst `nil`) else fail ? if WORD = `FAULT` then (let (faultitem_0 , result_list , prev, lst) = faultitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push faultitem_0 result_list in let (more_faultitems_1 , result_list , prev, lst) = more_faultitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_faultitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_FAULT`,POP_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`step`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `step` prev lst `nil`) else fail ? (let (declaration_0 , result_list , prev, lst) = declaration lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push declaration_0 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`step`,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `step` prev lst `nil`);; makeitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`makeitem`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `makeitem` in let TOKENS = explode WORD in let (makeitem_body_1 , result_list , prev, lst) = makeitem_body lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push makeitem_body_1 result_list in let (unit_names_2 , result_list , prev, lst) = unit_names lst whitespace prev result_list FIRST_CHARS CHARS `:` in let result_list = push unit_names_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `makeitem` in let TOKENS = explode WORD in let (name_3 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_3 result_list in let (more_item_names_4 , result_list , prev, lst) = more_item_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_item_names_4 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = MK_one(`names`,POP_5) in let result_list = push tmp_6 result_list in let (result_list,pop_list) = chop_off 4 [] result_list in let (POP_6 , pop_list ) = (pop pop_list) in let (POP_7 , pop_list ) = (pop pop_list) in let (POP_8 , pop_list ) = (pop pop_list) in let (POP_9 , pop_list ) = (pop pop_list) in let tmp_10 = MK_four(`makeitem`,POP_6,POP_7,POP_8,POP_9) in let result_list = push tmp_10 result_list in do_return result_list whitespace `makeitem` prev lst `nil`) else fail ? (let (makeitem_body_0 , result_list , prev, lst) = makeitem_body lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push makeitem_body_0 result_list in let (unit_names_1 , result_list , prev, lst) = unit_names lst whitespace prev result_list FIRST_CHARS CHARS `:` in let result_list = push unit_names_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `makeitem` in let TOKENS = explode WORD in let (name_2 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_2 result_list in let (more_item_names_3 , result_list , prev, lst) = more_item_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_item_names_3 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = MK_one(`names`,POP_4) in let result_list = push tmp_5 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_5 , pop_list ) = (pop pop_list) in let (POP_6 , pop_list ) = (pop pop_list) in let (POP_7 , pop_list ) = (pop pop_list) in let tmp_8 = MK_three(`makeitem`,POP_5,POP_6,POP_7) in let result_list = push tmp_8 result_list in do_return result_list whitespace `makeitem` prev lst `nil`);; makeitem_body:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`makeitem_body`,expected,WORD); (let (fnname_0 , result_list , prev, lst) = fnname lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`makeitem_body`,fnname_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `makeitem_body` prev lst `nil`) ? (let (macname_0 , result_list , prev, lst) = macname lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push macname_0 result_list in let (make_mac_1 , result_list , prev, lst) = make_mac lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push make_mac_1 result_list in do_return result_list whitespace `makeitem_body` prev lst `nil`);; make_mac:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`make_mac`,expected,WORD); if WORD = `{` then (let (macparams_0 , result_list , prev, lst) = macparams lst whitespace whitespace result_list FIRST_CHARS CHARS `\}` in let result_list = push macparams_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `make_mac` in let TOKENS = explode WORD in let (snd_macparams_1 , result_list , prev, lst) = snd_macparams lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push snd_macparams_1 result_list in do_return result_list whitespace `make_mac` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`makeitem_body`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `make_mac` WORD lst expected);; snd_macparams:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`snd_macparams`,expected,WORD); if WORD = `{` then (let (macparams_0 , result_list , prev, lst) = macparams lst whitespace whitespace result_list FIRST_CHARS CHARS `\}` in let result_list = push macparams_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `snd_macparams` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_three(`makeitem_body`,POP_1,POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `snd_macparams` WORD lst expected) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`makeitem_body`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `snd_macparams` WORD lst expected);; more_makeitems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_makeitems`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (makeitem_1 , result_list , prev, lst) = makeitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,makeitem_1) in let result_list = push tmp_2 result_list in let (more_makeitems_2 , result_list , prev, lst) = more_makeitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_makeitems_2 result_list in do_return result_list whitespace `more_makeitems` prev lst `nil`) else fail ? (do_return result_list whitespace `more_makeitems` WORD lst expected);; more_item_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_item_names`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_1 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,name_1) in let result_list = push tmp_2 result_list in let (more_item_names_2 , result_list , prev, lst) = more_item_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_item_names_2 result_list in do_return result_list whitespace `more_item_names` prev lst `nil`) ? (do_return result_list whitespace `more_item_names` WORD lst expected);; letitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`letitem`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `letitem` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_2 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`letitem`,POP_1,unit_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `letitem` prev lst `nil`);; more_letitems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_letitems`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (letitem_1 , result_list , prev, lst) = letitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,letitem_1) in let result_list = push tmp_2 result_list in let (more_letitems_2 , result_list , prev, lst) = more_letitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_letitems_2 result_list in do_return result_list whitespace `more_letitems` prev lst `nil`) else fail ? (do_return result_list whitespace `more_letitems` WORD lst expected);; joinstep:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`joinstep`,expected,WORD); if WORD = `JOIN` then (let (joinitem_0 , result_list , prev, lst) = joinitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push joinitem_0 result_list in let (more_joinitems_1 , result_list , prev, lst) = more_joinitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_joinitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_JOIN`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `joinstep` prev lst `nil`) else fail ? fail;; multiplier:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`multiplier`,expected,WORD); if WORD = `INT` then (let (name_0 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `multiplier` in let TOKENS = explode WORD in let (int_1 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `..` in let result_list = push int_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `multiplier` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (int_4 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_5 = MK_three(`multiplier_INT`,POP_2,POP_3,int_4) in let result_list = push tmp_5 result_list in let (more_multipliers_5 , result_list , prev, lst) = more_multipliers lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_multipliers_5 result_list in do_return result_list whitespace `multiplier` prev lst `nil`) else fail ? fail;; more_multipliers:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_multipliers`,expected,WORD); if WORD = `INT` then (let (name_0 , result_list , prev, lst) = name lst whitespace whitespace result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `more_multipliers` in let TOKENS = explode WORD in let (int_1 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `..` in let result_list = push int_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `more_multipliers` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (int_4 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_5 = MK_three(`multiplier_INT`,POP_2,POP_3,int_4) in let result_list = push tmp_5 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_5 , pop_list ) = (pop pop_list) in let (POP_6 , pop_list ) = (pop pop_list) in let tmp_7 = add_to_list(POP_5,POP_6) in let result_list = push tmp_7 result_list in let (more_multipliers_7 , result_list , prev, lst) = more_multipliers lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_multipliers_7 result_list in do_return result_list whitespace `more_multipliers` prev lst `nil`) else fail ? (do_return result_list whitespace `more_multipliers` WORD lst expected);; joinitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`joinitem`,expected,WORD); (let (unit_0 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS `->` in let result_list = push unit_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `joinitem` in let TOKENS = explode WORD in let (name_1 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_1 result_list in let (rest_of_joinitem_2 , result_list , prev, lst) = rest_of_joinitem lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_joinitem_2 result_list in do_return result_list whitespace `joinitem` prev lst `nil`);; rest_of_joinitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_joinitem`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `rest_of_joinitem` in let TOKENS = explode WORD in let (second_join_int_1 , result_list , prev, lst) = second_join_int lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push second_join_int_1 result_list in do_return result_list whitespace `rest_of_joinitem` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`joinitem`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_joinitem` WORD lst expected);; second_join_int:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`second_join_int`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `second_join_int` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 4 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = MK_four(`joinitem`,POP_1,POP_2,POP_3,POP_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `second_join_int` WORD lst expected) else fail ? (let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_three(`joinitem`,POP_0,POP_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `second_join_int` WORD lst expected);; more_joinitems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_joinitems`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (joinitem_1 , result_list , prev, lst) = joinitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,joinitem_1) in let result_list = push tmp_2 result_list in let (more_joinitems_2 , result_list , prev, lst) = more_joinitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_joinitems_2 result_list in do_return result_list whitespace `more_joinitems` prev lst `nil`) else fail ? (do_return result_list whitespace `more_joinitems` WORD lst expected);; printitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`printitem`,expected,WORD); if WORD = `IF` then (let (boolean_0 , result_list , prev, lst) = boolean lst whitespace whitespace result_list FIRST_CHARS CHARS `THEN` in let result_list = push boolean_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `THEN` WORD lst `printitem` in let TOKENS = explode WORD in let (printable_1 , result_list , prev, lst) = printable lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push printable_1 result_list in let (more_printables_2 , result_list , prev, lst) = more_printables lst whitespace prev result_list FIRST_CHARS CHARS `FI` in let result_list = push more_printables_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `FI` WORD lst `printitem` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = MK_two(`printitem`,POP_3,POP_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `printitem` WORD lst expected) else fail ? (let (printable_0 , result_list , prev, lst) = printable lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push printable_0 result_list in let (more_printables_1 , result_list , prev, lst) = more_printables lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_printables_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`printitem`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `printitem` prev lst `nil`);; more_printables:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_printables`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (printable_1 , result_list , prev, lst) = printable lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,printable_1) in let result_list = push tmp_2 result_list in let (more_printables_2 , result_list , prev, lst) = more_printables lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_printables_2 result_list in do_return result_list whitespace `more_printables` prev lst `nil`) ? (do_return result_list whitespace `more_printables` WORD lst expected);; more_printitems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_printitems`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (printitem_1 , result_list , prev, lst) = printitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,printitem_1) in let result_list = push tmp_2 result_list in let (more_printitems_2 , result_list , prev, lst) = more_printitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_printitems_2 result_list in do_return result_list whitespace `more_printitems` prev lst `nil`) else fail ? (do_return result_list whitespace `more_printitems` WORD lst expected);; faultitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`faultitem`,expected,WORD); (let (printitem_0 , result_list , prev, lst) = printitem lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`faultitem`,printitem_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `faultitem` prev lst `nil`);; more_faultitems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_faultitems`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (faultitem_1 , result_list , prev, lst) = faultitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,faultitem_1) in let result_list = push tmp_2 result_list in let (more_faultitems_2 , result_list , prev, lst) = more_faultitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_faultitems_2 result_list in do_return result_list whitespace `more_faultitems` prev lst `nil`) else fail ? (do_return result_list whitespace `more_faultitems` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_9_decls.ml0000640000212700021270000001441204577677230021537 0ustar cammcammletref series (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref BEGIN_steps (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_B_steps (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref bracket_steps (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_br_steps (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref step (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref makeitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref makeitem_body (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref make_mac (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref snd_macparams (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_makeitems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_item_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref letitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_letitems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref joinstep (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref multiplier (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_multipliers (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref joinitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref rest_of_joinitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref second_join_int (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_joinitems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref printitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_printables (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_printitems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref faultitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_faultitems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_10.ml0000640000212700021270000010530205034371304020412 0ustar cammcamm % A1.10 SEQUENCES % sequence:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`sequence`,expected,WORD); if WORD = `BEGIN` then (let (sequence_BE_0 , result_list , prev, lst) = sequence_BE lst whitespace whitespace result_list FIRST_CHARS CHARS `END` in let result_list = push sequence_BE_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `END` WORD lst `sequence` in let TOKENS = explode WORD in do_return result_list whitespace `sequence` WORD lst expected) else fail ? if WORD = `(` then (let (sequence_br_0 , result_list , prev, lst) = sequence_br lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push sequence_br_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `sequence` in let TOKENS = explode WORD in do_return result_list whitespace `sequence` WORD lst expected) else fail ? fail;; sequence_BE:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`sequence_BE`,expected,WORD); if WORD = `SEQ` then (let (poss_seq_step_0 , result_list , prev, lst) = poss_seq_step lst whitespace whitespace result_list FIRST_CHARS CHARS `OUTPUT` in let result_list = push poss_seq_step_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `OUTPUT` WORD lst `sequence_BE` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (unit_1 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`sequence_BEGINEND`,unit_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequence_BE` prev lst `nil`) else fail ? fail;; sequence_br:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`sequence_br`,expected,WORD); if WORD = `SEQ` then (let (poss_seq_step_0 , result_list , prev, lst) = poss_seq_step lst whitespace whitespace result_list FIRST_CHARS CHARS `OUTPUT` in let result_list = push poss_seq_step_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `OUTPUT` WORD lst `sequence_br` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (unit_1 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`sequence_brackets`,unit_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequence_br` prev lst `nil`) else fail ? fail;; poss_seq_step:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_seq_step`,expected,WORD); (let (sequencestep_0 , result_list , prev, lst) = sequencestep lst whitespace WORD result_list FIRST_CHARS CHARS `;` in let tmp_1 = MK_one(`sequencestep`,sequencestep_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `;` WORD lst `poss_seq_step` in let TOKENS = explode WORD in let (more_seq_steps_1 , result_list , prev, lst) = more_seq_steps lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_seq_steps_1 result_list in do_return result_list whitespace `poss_seq_step` prev lst `nil`) ? (let tmp_0 = MK_zero(`sequencestep`) in let result_list = push tmp_0 result_list in do_return result_list whitespace `poss_seq_step` WORD lst expected);; more_seq_steps:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_seq_steps`,expected,WORD); (let (sequencestep_0 , result_list , prev, lst) = sequencestep lst whitespace WORD result_list FIRST_CHARS CHARS `;` in let tmp_1 = MK_one(`sequencestep`,sequencestep_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = add_to_list(POP_1,POP_2) in let result_list = push tmp_3 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `;` WORD lst `more_seq_steps` in let TOKENS = explode WORD in let (more_seq_steps_3 , result_list , prev, lst) = more_seq_steps lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push more_seq_steps_3 result_list in do_return result_list whitespace `more_seq_steps` prev lst `nil`) ? (do_return result_list whitespace `more_seq_steps` WORD lst expected);; sequencestep:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`sequencestep`,expected,WORD); if WORD = `LET` then (let (letitem_0 , result_list , prev, lst) = letitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push letitem_0 result_list in let (more_letitems_1 , result_list , prev, lst) = more_letitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_letitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_LET`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) else fail ? if WORD = `VAR` then (let (varitem_0 , result_list , prev, lst) = varitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push varitem_0 result_list in let (more_varitems_1 , result_list , prev, lst) = more_varitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_varitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`sequencestep_VAR`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) else fail ? if WORD = `STATE` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `VAR` WORD lst `sequencestep` in let TOKENS = explode WORD in let (statevaritem_0 , result_list , prev, lst) = statevaritem lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push statevaritem_0 result_list in let (more_statevaritems_1 , result_list , prev, lst) = more_statevaritems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_statevaritems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`sequencestep_STATEVAR`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) else fail ? if WORD = `PVAR` then (let (statevaritem_0 , result_list , prev, lst) = statevaritem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push statevaritem_0 result_list in let (more_statevaritems_1 , result_list , prev, lst) = more_statevaritems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_statevaritems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`sequencestep_PVAR`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) else fail ? if WORD = `PRINT` then (let (printitem_0 , result_list , prev, lst) = printitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push printitem_0 result_list in let (more_printitems_1 , result_list , prev, lst) = more_printitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_printitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_PRINT`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) else fail ? if WORD = `FAULT` then (let (faultitem_0 , result_list , prev, lst) = faultitem lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push faultitem_0 result_list in let (more_faultitems_1 , result_list , prev, lst) = more_faultitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_faultitems_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`step_FAULT`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) else fail ? (let (declaration_0 , result_list , prev, lst) = declaration lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push declaration_0 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`) ? (let (statement_0 , result_list , prev, lst) = statement lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push statement_0 result_list in do_return result_list whitespace `sequencestep` prev lst `nil`);; varitem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`varitem`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `:=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:=` WORD lst `varitem` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_2 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`varitem`,POP_1,unit_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `varitem` prev lst `nil`);; more_varitems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_varitems`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (varitem_1 , result_list , prev, lst) = varitem lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,varitem_1) in let result_list = push tmp_2 result_list in let (more_varitems_2 , result_list , prev, lst) = more_varitems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_varitems_2 result_list in do_return result_list whitespace `more_varitems` prev lst `nil`) ? (do_return result_list whitespace `more_varitems` WORD lst expected);; statevaritem:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`statevaritem`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (init_or_other_1 , result_list , prev, lst) = init_or_other lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push init_or_other_1 result_list in do_return result_list whitespace `statevaritem` prev lst `nil`);; init_or_other:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`init_or_other`,expected,WORD); if WORD = `INIT` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (const1_1 , result_list , prev, lst) = const1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`statevaritem_INIT`,POP_0,const1_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`statevaritem`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `init_or_other` prev lst `nil`) else fail ? if WORD = `::=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (const1_1 , result_list , prev, lst) = const1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`statevaritem`,POP_0,const1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `init_or_other` prev lst `nil`) else fail ? fail;; more_statevaritems:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_statevaritems`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (statevaritem_1 , result_list , prev, lst) = statevaritem lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,statevaritem_1) in let result_list = push tmp_2 result_list in let (more_statevaritems_2 , result_list , prev, lst) = more_statevaritems lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_statevaritems_2 result_list in do_return result_list whitespace `more_statevaritems` prev lst `nil`) ? (do_return result_list whitespace `more_statevaritems` WORD lst expected);; statement:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`statement`,expected,WORD); if WORD = `IF` then (let (boolean_0 , result_list , prev, lst) = boolean lst whitespace whitespace result_list FIRST_CHARS CHARS `THEN` in let result_list = push boolean_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `THEN` WORD lst `statement` in let TOKENS = explode WORD in let (statement_1 , result_list , prev, lst) = statement lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push statement_1 result_list in let (poss_ifseq_else_2 , result_list , prev, lst) = poss_ifseq_else lst whitespace prev result_list FIRST_CHARS CHARS `FI` in let result_list = push poss_ifseq_else_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `FI` WORD lst `statement` in let TOKENS = explode WORD in do_return result_list whitespace `statement` WORD lst expected) else fail ? if WORD = `CASE` then (let (unit_0 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS `OF` in let result_list = push unit_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `OF` WORD lst `statement` in let TOKENS = explode WORD in let (seqchoices_1 , result_list , prev, lst) = seqchoices lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push seqchoices_1 result_list in let (poss_caseseq_else_2 , result_list , prev, lst) = poss_caseseq_else lst whitespace prev result_list FIRST_CHARS CHARS `ESAC` in let result_list = push poss_caseseq_else_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `ESAC` WORD lst `statement` in let TOKENS = explode WORD in do_return result_list whitespace `statement` WORD lst expected) else fail ? if WORD = `[` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `INT` WORD lst `statement` in let TOKENS = explode WORD in let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `=` in let result_list = push name_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `=` WORD lst `statement` in let TOKENS = explode WORD in let (int_1 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `..` in let result_list = push int_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `..` WORD lst `statement` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (int_4 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let (statement_5 , result_list , prev, lst) = statement lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_6 = MK_four(`statement_INT`,POP_2,POP_3,int_4,statement_5) in let result_list = push tmp_6 result_list in do_return result_list whitespace `statement` prev lst `nil`) else fail ? if WORD = `(` then (let (statement_0 , result_list , prev, lst) = statement lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push statement_0 result_list in let (more_statements_1 , result_list , prev, lst) = more_statements lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_statements_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `statement` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`statements`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `statement` WORD lst expected) else fail ? (let (varname_0 , result_list , prev, lst) = varname lst whitespace WORD result_list FIRST_CHARS CHARS `:=` in let tmp_1 = MK_one(`varname`,varname_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:=` WORD lst `statement` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (unit_2 , result_list , prev, lst) = unit lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_two(`statement_assign`,POP_1,unit_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `statement` prev lst `nil`);; poss_ifseq_else:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_ifseq_else`,expected,WORD); if WORD = `ELSE` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (statement_2 , result_list , prev, lst) = statement lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_three(`statement_cond`,POP_0,POP_1,statement_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `poss_ifseq_else` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`statement_cond`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_ifseq_else` WORD lst expected);; poss_caseseq_else:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_caseseq_else`,expected,WORD); if WORD = `ELSE` then (let tmp_0 = MK_zero(`statement_ELSEOF`) in let result_list = push tmp_0 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (statement_3 , result_list , prev, lst) = statement lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_4 = MK_four(`statement_case`,POP_0,POP_1,POP_2,statement_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `poss_caseseq_else` prev lst `nil`) else fail ? if WORD = `ELSEOF` then (let (seqchoices_0 , result_list , prev, lst) = seqchoices lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push seqchoices_0 result_list in let (more_seq_elseofs_1 , result_list , prev, lst) = more_seq_elseofs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_seq_elseofs_1 result_list in do_return result_list whitespace `poss_caseseq_else` prev lst `nil`) else fail ? (let tmp_0 = MK_zero(`statement_ELSEOF`) in let result_list = push tmp_0 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_three(`statement_case`,POP_0,POP_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `poss_caseseq_else` WORD lst expected);; more_seq_elseofs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_seq_elseofs`,expected,WORD); if WORD = `ELSEOF` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (seqchoices_1 , result_list , prev, lst) = seqchoices lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,seqchoices_1) in let result_list = push tmp_2 result_list in let (more_seq_elseofs_2 , result_list , prev, lst) = more_seq_elseofs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_seq_elseofs_2 result_list in do_return result_list whitespace `more_seq_elseofs` prev lst `nil`) else fail ? if WORD = `ELSE` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`statement_ELSEOF`,POP_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (statement_4 , result_list , prev, lst) = statement lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_5 = MK_four(`statement_case`,POP_1,POP_2,POP_3,statement_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `more_seq_elseofs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`statement_ELSEOF`,POP_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_three(`statement_case`,POP_1,POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_seq_elseofs` WORD lst expected);; more_statements:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_statements`,expected,WORD); if WORD = `;` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (statement_1 , result_list , prev, lst) = statement lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,statement_1) in let result_list = push tmp_2 result_list in let (more_statements_2 , result_list , prev, lst) = more_statements lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_statements_2 result_list in do_return result_list whitespace `more_statements` prev lst `nil`) else fail ? (do_return result_list whitespace `more_statements` WORD lst expected);; seqchoices:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`seqchoices`,expected,WORD); (let (seqchoice_0 , result_list , prev, lst) = seqchoice lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push seqchoice_0 result_list in let (more_seqchoices_1 , result_list , prev, lst) = more_seqchoices lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_seqchoices_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_one(`seqchoices`,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `seqchoices` prev lst `nil`);; seqchoice:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`seqchoice`,expected,WORD); (let (choosers_0 , result_list , prev, lst) = choosers lst whitespace WORD result_list FIRST_CHARS CHARS `:` in let result_list = push choosers_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `seqchoice` in let TOKENS = explode WORD in let (poss_statement_1 , result_list , prev, lst) = poss_statement lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push poss_statement_1 result_list in do_return result_list whitespace `seqchoice` prev lst `nil`);; poss_statement:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_statement`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (statement_1 , result_list , prev, lst) = statement lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_two(`seqchoice`,POP_0,statement_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `poss_statement` prev lst `nil`) ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`seqchoice`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `poss_statement` WORD lst expected);; more_seqchoices:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_seqchoices`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (seqchoice_1 , result_list , prev, lst) = seqchoice lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,seqchoice_1) in let result_list = push tmp_2 result_list in let (more_seqchoices_2 , result_list , prev, lst) = more_seqchoices lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_seqchoices_2 result_list in do_return result_list whitespace `more_seqchoices` prev lst `nil`) else fail ? (do_return result_list whitespace `more_seqchoices` WORD lst expected);; varname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`varname`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (rest_of_varname_1 , result_list , prev, lst) = rest_of_varname lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_varname_1 result_list in do_return result_list whitespace `varname` prev lst `nil`);; rest_of_varname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_varname`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_1 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = MK_two(`varname`,POP_0,name_1) in let result_list = push tmp_2 result_list in let (rest_of_varname_2 , result_list , prev, lst) = rest_of_varname lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_varname_2 result_list in do_return result_list whitespace `rest_of_varname` prev lst `nil`) ? if WORD = `[` then (let (var_brackets_0 , result_list , prev, lst) = var_brackets lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push var_brackets_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `rest_of_varname` in let TOKENS = explode WORD in do_return result_list whitespace `rest_of_varname` WORD lst expected) else fail ? (do_return result_list whitespace `rest_of_varname` WORD lst expected);; var_brackets:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`var_brackets`,expected,WORD); if WORD = `[` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (unit_1 , result_list , prev, lst) = unit lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let tmp_2 = MK_two(`varname_unit`,POP_0,unit_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `var_brackets` in let TOKENS = explode WORD in do_return result_list whitespace `var_brackets` WORD lst expected) else fail ? (let (int_0 , result_list , prev, lst) = int lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push int_0 result_list in let (var_int_stuff_1 , result_list , prev, lst) = var_int_stuff lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push var_int_stuff_1 result_list in do_return result_list whitespace `var_brackets` prev lst `nil`);; var_int_stuff:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`var_int_stuff`,expected,WORD); if WORD = `..` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let (int_2 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_3 = MK_three(`varname_int_range`,POP_0,POP_1,int_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `var_int_stuff` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_two(`varname_int`,POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `var_int_stuff` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_10_decls.ml0000640000212700021270000001346304577677271021621 0ustar cammcammletref sequence (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref sequence_BE (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref sequence_br (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_seq_step (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_seq_steps (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref sequencestep (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref varitem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_varitems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref statevaritem (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref init_or_other (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_statevaritems (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref statement (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_ifseq_else (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_caseseq_else (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_seq_elseofs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_statements (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref seqchoices (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref seqchoice (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref poss_statement (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_seqchoices (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref varname (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref rest_of_varname (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref var_brackets (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref var_int_stuff (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_11.ml0000640000212700021270000004244705034371271020430 0ustar cammcamm % A1.11 MACROS % macdec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macdec`,expected,WORD); (let (macname_0 , result_list , prev, lst) = macname lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push macname_0 result_list in let (macdec_type_1 , result_list , prev, lst) = macdec_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push macdec_type_1 result_list in do_return result_list whitespace `macdec` prev lst `nil`);; macdec_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macdec_type`,expected,WORD); if WORD = `=` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `FNSET` WORD lst `macdec_type` in let TOKENS = explode WORD in let (mac_FNSET_0 , result_list , prev, lst) = mac_FNSET lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push mac_FNSET_0 result_list in do_return result_list whitespace `macdec_type` prev lst `nil`) else fail ? if WORD = `{` then (let (macspec_0 , result_list , prev, lst) = macspec lst whitespace whitespace result_list FIRST_CHARS CHARS `\}` in let result_list = push macspec_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `macdec_type` in let TOKENS = explode WORD in let (WORD,lst) = eat_terminal `=` WORD lst `macdec_type` in let TOKENS = explode WORD in let (input_1 , result_list , prev, lst) = input lst whitespace WORD result_list FIRST_CHARS CHARS `->` in let result_list = push input_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `macdec_type` in let TOKENS = explode WORD in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `:` in let result_list = push typ_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `macdec_type` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 4 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let (POP_6 , pop_list ) = (pop pop_list) in let (fnbody_7 , result_list , prev, lst) = fnbody lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_8 = MK_five(`macdec`,POP_3,POP_4,POP_5,POP_6,fnbody_7) in let result_list = push tmp_8 result_list in do_return result_list whitespace `macdec_type` prev lst `nil`) else fail ? if WORD = `=` then (let (input_0 , result_list , prev, lst) = input lst whitespace whitespace result_list FIRST_CHARS CHARS `->` in let result_list = push input_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `macdec_type` in let TOKENS = explode WORD in let (typ_1 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `:` in let result_list = push typ_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `:` WORD lst `macdec_type` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let (fnbody_5 , result_list , prev, lst) = fnbody lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_6 = MK_four(`macdec`,POP_2,POP_3,POP_4,fnbody_5) in let result_list = push tmp_6 result_list in do_return result_list whitespace `macdec_type` prev lst `nil`) else fail ? fail;; mac_FNSET:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`mac_FNSET`,expected,WORD); if WORD = `[` then (let (int_0 , result_list , prev, lst) = int lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let result_list = push int_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (WORD,lst) = eat_terminal `(` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (input_1 , result_list , prev, lst) = input lst whitespace WORD result_list FIRST_CHARS CHARS `->` in let result_list = push input_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (typ_3 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `)` in let tmp_4 = MK_two(`fnarrow`,POP_2,typ_3) in let result_list = push tmp_4 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = MK_two(`fnset`,POP_4,POP_5) in let result_list = push tmp_6 result_list in let (WORD,lst) = eat_terminal `:` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (fnbody_6 , result_list , prev, lst) = fnbody lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_7 = MK_one(`fnbody`,fnbody_6) in let result_list = push tmp_7 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_7 , pop_list ) = (pop pop_list) in let (POP_8 , pop_list ) = (pop pop_list) in let (POP_9 , pop_list ) = (pop pop_list) in let tmp_10 = MK_three(`macdec`,POP_7,POP_8,POP_9) in let result_list = push tmp_10 result_list in do_return result_list whitespace `mac_FNSET` prev lst `nil`) else fail ? if WORD = `(` then (let (input_0 , result_list , prev, lst) = input lst whitespace whitespace result_list FIRST_CHARS CHARS `->` in let result_list = push input_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_3 = MK_two(`fnarrow`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (more_mac_inputs_3 , result_list , prev, lst) = more_mac_inputs lst whitespace prev result_list FIRST_CHARS CHARS `)` in let result_list = push more_mac_inputs_3 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = MK_one(`fnarrows`,POP_4) in let result_list = push tmp_5 result_list in let (WORD,lst) = eat_terminal `:` WORD lst `mac_FNSET` in let TOKENS = explode WORD in let (fnbody_5 , result_list , prev, lst) = fnbody lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_6 = MK_one(`fnbody`,fnbody_5) in let result_list = push tmp_6 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_6 , pop_list ) = (pop pop_list) in let (POP_7 , pop_list ) = (pop pop_list) in let (POP_8 , pop_list ) = (pop pop_list) in let tmp_9 = MK_three(`macdec`,POP_6,POP_7,POP_8) in let result_list = push tmp_9 result_list in do_return result_list whitespace `mac_FNSET` prev lst `nil`) else fail ? fail;; more_mac_inputs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_mac_inputs`,expected,WORD); if WORD = `,` then (let (input_0 , result_list , prev, lst) = input lst whitespace whitespace result_list FIRST_CHARS CHARS `->` in let result_list = push input_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `->` WORD lst `more_mac_inputs` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (typ_2 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_3 = MK_two(`fnarrow`,POP_1,typ_2) in let result_list = push tmp_3 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = add_to_list(POP_3,POP_4) in let result_list = push tmp_5 result_list in let (more_mac_inputs_5 , result_list , prev, lst) = more_mac_inputs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_mac_inputs_5 result_list in do_return result_list whitespace `more_mac_inputs` prev lst `nil`) else fail ? (do_return result_list whitespace `more_mac_inputs` WORD lst expected);; macspec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macspec`,expected,WORD); if WORD = `INT` then (let (macspec_body_0 , result_list , prev, lst) = macspec_body lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`mactype_INT`,macspec_body_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`mactype`,POP_1) in let result_list = push tmp_2 result_list in let (more_macspecs_2 , result_list , prev, lst) = more_macspecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macspecs_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`macpsec`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `macspec` prev lst `nil`) else fail ? if WORD = `TYPE` then (let (macspec_body_0 , result_list , prev, lst) = macspec_body lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`mactype_TYPE`,macspec_body_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`mactype`,POP_1) in let result_list = push tmp_2 result_list in let (more_macspecs_2 , result_list , prev, lst) = more_macspecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macspecs_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = MK_one(`macpsec`,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `macspec` prev lst `nil`) else fail ? fail;; macspec_body:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`macspec_body`,expected,WORD); (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push name_0 result_list in let (more_mac_names_1 , result_list , prev, lst) = more_mac_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_mac_names_1 result_list in do_return result_list whitespace `macspec_body` prev lst `nil`);; more_mac_names:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_mac_names`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (name_1 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,name_1) in let result_list = push tmp_2 result_list in let (more_mac_names_2 , result_list , prev, lst) = more_mac_names lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_mac_names_2 result_list in do_return result_list whitespace `more_mac_names` prev lst `nil`) ? (do_return result_list whitespace `more_mac_names` WORD lst expected);; more_macspecs:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_macspecs`,expected,WORD); if WORD = `INT` then (let (macspec_body_0 , result_list , prev, lst) = macspec_body lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`mactype_INT`,macspec_body_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`mactype`,POP_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = add_to_list(POP_2,POP_3) in let result_list = push tmp_4 result_list in let (more_macspecs_4 , result_list , prev, lst) = more_macspecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macspecs_4 result_list in do_return result_list whitespace `more_macspecs` prev lst `nil`) else fail ? if WORD = `TYPE` then (let (macspec_body_0 , result_list , prev, lst) = macspec_body lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = MK_one(`mactype_TYPE`,macspec_body_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = MK_one(`mactype`,POP_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = add_to_list(POP_2,POP_3) in let result_list = push tmp_4 result_list in let (more_macspecs_4 , result_list , prev, lst) = more_macspecs lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_macspecs_4 result_list in do_return result_list whitespace `more_macspecs` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_one(`mactypes`,POP_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_macspecs` WORD lst expected);; printable:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`printable`,expected,WORD); (let (string_0 , result_list , prev, lst) = string lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`printable`,string_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `printable` prev lst `nil`) ? (let (name_0 , result_list , prev, lst) = name lst whitespace WORD result_list FIRST_CHARS CHARS expected in let tmp_1 = MK_one(`printable`,name_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `printable` prev lst `nil`);; hol88-2.02.19940316/Library/parser/Examples/ella/A1_11_decls.ml0000640000212700021270000000424304577677310021610 0ustar cammcammletref macdec (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref macdec_type (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref mac_FNSET (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_mac_inputs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref macspec (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref macspec_body (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_mac_names (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref more_macspecs (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; letref printable (lst:string list) (whitespace:string)(prev:string) (result_list:ella list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:ella list,fail:ella list list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/tiny/0000750000212700021270000000000005227256573017401 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/tiny/Makefile0000640000212700021270000000201204577706462021041 0ustar cammcamm# Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol_12/hol # General definitions for all generated parsers: GENERAL=/usr/groups/hol/hol_12/Library/parser/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. tiny_help_ml.o: tiny_help.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `tiny_help`;;'\ 'quit();;' | $(HOL) # Now compile the declarations: tiny_decls_ml.o: tiny_decls.ml tiny_help_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `tiny_help`;;'\ 'compilet `tiny_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions tiny_ml.o: tiny.ml tiny_decls_ml.o tiny_help_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `tiny_help`;;'\ 'loadf `tiny_decls`;;'\ 'compilet `tiny`;;'\ 'quit();;' | $(HOL) all: tiny_ml.o @echo '===> Parser "tiny" built. hol88-2.02.19940316/Library/parser/Examples/tiny/READ-ME0000640000212700021270000000123504577706120020333 0ustar cammcammThis directory contains a grammar describing a parser for the programming language of the library "prog_logic88". The file tiny.grm contains the grammar for the parser. tiny_help.ml holds the definitions of the action symbols. Heavy use of antiquotation is made. The file examples.ml is a rewrite of the examples file from the programming logics library. It makes use of the newly constructed parser rather than the lisp hacks previously used. To remake the parser, edit the Makefile to reflect the appropriate pathnames. To remake from scratch, run the generator over the file tiny.grm. To load into HOL, edit the file loader.ml, and perform a loadf on it. hol88-2.02.19940316/Library/parser/Examples/tiny/examples.ml0000640000212700021270000003513404577706120021553 0ustar cammcamm %============================================================================% % This file contains examples to illustrate the HOL tools to support % % programming logics provided in the library prog_logic88. % % The principles underlying these tools are described in the paper: % % % % "Mechanizing Programming Logics in Higher Order Logic", % % by M.J.C. Gordon, in "Current Trends in Hardware Verification and % % Automated Theorem Proving" edited by P.A. Subrahmanyam and % % Graham Birtwistle, Springer-Verlag, 1989. % % % % It is hoped that if the ML phrases in this file are evaluated in the % % order given, the results will illustrate the contents of the library. % % % %============================================================================% %----------------------------------------------------------------------------% % The naming convention used below is that ML variables th1, th2, etc % % are pure logic theorems, hth1, hth2, etc name theorems of Hoare Logic and % % tth1, tth2, etc name theorems in the Hoare Logic of total correctness % % (however, theorems of Hoare Logic (for both partial and total correctness) % % are really only specially printed theorems of pure logic). % %----------------------------------------------------------------------------% %----------------------------------------------------------------------------% % Examples to illustrate the special parsing and printing. This is % % currently done in Lisp, but it is hoped eventually to provide ML-level % % facilities to support user programmable syntax. Work on this will be % % part of an Esprit Basic Research Action joint with Philips and IMEC. % %----------------------------------------------------------------------------% %----------------------------------------------------------------------------% % Examples to illustrate forward proof using Hoare Logic (hoare_logic.ml). % %----------------------------------------------------------------------------% %----------------------------------------------------------------------------% % Load in the generated parser for the language. % %----------------------------------------------------------------------------% loadf `loader`;; %----------------------------------------------------------------------------% % The Assignment Axiom % %----------------------------------------------------------------------------% let hth1 = ASSIGN_AX (MK_NICE `"{(R=x) /\\ (Y=y)}"`) (MK_NICE `"R := X"`);; let hth2 = ASSIGN_AX (MK_NICE `"{(R=x) /\\ (X=y)}"`) (MK_NICE `"X := Y"`);; pretty_off();; hth1;; MK_SPEC;; pretty_on();; %----------------------------------------------------------------------------% % The Sequencing Rule % %----------------------------------------------------------------------------% let hth1 = ASSIGN_AX (MK_NICE `"{(R=x) /\\ (Y=y)}"`) (MK_NICE `"R:=X"`);; let hth2 = ASSIGN_AX (MK_NICE `"{(R=x) /\\ (X=y)}"`) (MK_NICE `"X:=Y"`);; let hth3 = ASSIGN_AX (MK_NICE `"{(Y=x) /\\ (X=y)}"`) (MK_NICE `"Y:=R"`);; SEQ_THM;; let hth4 = SEQ_RULE (hth1,hth2);; let hth5 = SEQ_RULE (hth4,hth3);; let hth6 = SEQL_RULE[hth1;hth2;hth3];; %----------------------------------------------------------------------------% % Precondition Strengthening % %----------------------------------------------------------------------------% let th1 = DISCH_ALL(CONTR "((X:num=x) /\ (Y:num=y))" (ASSUME (MK_NICE `"F"`)));; let hth7 = PRE_STRENGTH_RULE(th1,hth5);; %----------------------------------------------------------------------------% % Postcondition Weakening % %----------------------------------------------------------------------------% let th2 = prove("((Y:num=x) /\ (X:num=y)) ==> T", REWRITE_TAC[]);; let hth8 = POST_WEAK_RULE(hth5,th2);; %----------------------------------------------------------------------------% % On-armed Conditional Rule % %----------------------------------------------------------------------------% new_theory`MAX` ? extend_theory `MAX` ? ();; let MAX = new_definition (`MAX`, "MAX(m,n) = ((m>n) => m | n)") ? definition `MAX` `MAX` ;; let hth9 = ASSIGN_AX "{X = MAX(x,y)}" (MK_NICE `"X := Y"`);; let MAX_LEMMA1 = theorem `MAX` `MAX_LEMMA1` ? prove_thm (`MAX_LEMMA1`, "((X=x) /\ (Y=y)) /\ (Y>X) ==> (Y=MAX(x,y))", REWRITE_TAC[MAX;GREATER] THEN REPEAT STRIP_TAC THEN ASSUM_LIST(\thl. ONCE_REWRITE_TAC(mapfilter SYM thl)) THEN ASM_CASES_TAC (MK_NICE `"YX) ==> (X=MAX(x,y))", REWRITE_TAC[MAX;GREATER;NOT_LESS;LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN ASSUM_LIST(\thl. ONCE_REWRITE_TAC(mapfilter SYM thl)) THEN ASM_CASES_TAC (MK_NICE `"Y (X = (R - Y) + (Y * (Q + 1)))"`), REPEAT STRIP_TAC THEN REWRITE_TAC[LEFT_ADD_DISTRIB;MULT_CLAUSES] THEN ONCE_REWRITE_TAC[SPEC (MK_NICE `"Y*Q"`) ADD_SYM] THEN ONCE_REWRITE_TAC[ADD_ASSOC] THEN IMP_RES_TAC SUB_ADD THEN ASM_REWRITE_TAC[]);; let hth20 = PRE_STRENGTH_RULE(th2,hth19);; let hth21 = WHILE_RULE hth20;; pretty_off();; WHILE_THM;; %----------------------------------------------------------------------------% % The pretty printer needs more work ... % %----------------------------------------------------------------------------% pretty_on();; WHILE_THM;; % "{p s /\ b s}" should print as "{p /\ s}" % let hth22 = SEQL_RULE [ASSIGN_AX (MK_NICE `"{X = R + (Y * 0)}"`) (MK_NICE `"R := X"`); ASSIGN_AX (MK_NICE `"{X = R + (Y * Q)}"`) (MK_NICE `"Q := 0"`); hth21];; let th3 = prove ((MK_NICE `"(~(Y <= R)) = (R < Y)"`), ONCE_REWRITE_TAC[SYM(SPEC (MK_NICE `"R !n. 0 < n ==> (n - m) < n", INDUCT_TAC THEN REWRITE_TAC[LESS_REFL;LESS_0] THEN INDUCT_TAC THEN REWRITE_TAC[LESS_REFL;LESS_0;SUB;LESS_MONO_EQ] THEN ASM_CASES_TAC "n < SUC m" THEN ASM_REWRITE_TAC[LESS_0;LESS_MONO_EQ] THEN ASM_CASES_TAC "0 < n" THEN RES_TAC THEN POP_ASSUM_LIST (\[th1;th2;th3;th4]. STRIP_ASSUME_TAC(REWRITE_RULE[NOT_LESS](CONJ th1 th2))) THEN IMP_RES_TAC LESS_EQ_TRANS THEN IMP_RES_TAC OR_LESS THEN IMP_RES_TAC NOT_LESS_0);; let th5 = prove ("!m n p. m < n /\ n <= p ==> m < p", REWRITE_TAC[LESS_OR_EQ] THEN REPEAT STRIP_TAC THEN IMP_RES_TAC LESS_TRANS THEN ASSUM_LIST(\[th1;th2;th3]. REWRITE_TAC[SYM th2]) THEN ASM_REWRITE_TAC[]);; let th6 = prove ((MK_NICE `"((0 < Y /\\ (X = R + (Y * Q))) /\\ (Y<=R) /\\ (R = r)) ==> (0 < Y /\\ (X = (R - Y) + (Y * (Q + 1)))) /\\ (R - Y) < r"`), REPEAT STRIP_TAC THEN REWRITE_TAC[LEFT_ADD_DISTRIB;MULT_CLAUSES] THEN ONCE_REWRITE_TAC[SPEC "Y*Q" ADD_SYM] THEN ONCE_REWRITE_TAC[ADD_ASSOC] THEN IMP_RES_TAC SUB_ADD THEN ASM_REWRITE_TAC[] THEN IMP_RES_TAC th5 THEN ASSUM_LIST(\thl. REWRITE_TAC[SYM(el 4 thl)]) THEN IMP_RES_TAC th4);; let tth4 = PRE_STRENGTH_T_RULE(th6,tth3);; let tth5 = WHILE_T_RULE tth4;; let tth6 = SEQL_T_RULE [ASSIGN_T_AX (MK_NICE `"{(0 < Y) /\\ (X = R + (Y * 0))}"`) (MK_NICE `"R := X"`); ASSIGN_T_AX (MK_NICE `"{(0 < Y) /\\ (X = R + (Y * Q))}"`) (MK_NICE `"Q := 0"`); tth5];; let th7 = prove ((MK_NICE `"(~(Y <= R)) = (R < Y)"`), ONCE_REWRITE_TAC[SYM(SPEC "R q s2) |- !p c q. MK_SPEC(p,c,q) = (!s1 s2. p s1 /\ c(s1,s2) ==> q s2) # #pretty_on();; false : bool # #%----------------------------------------------------------------------------% #% The Sequencing Rule % #%----------------------------------------------------------------------------% # #let hth1 = ASSIGN_AX (MK_NICE `"{(R=x) /\\ (Y=y)}"`) (MK_NICE `"R:=X"`);; hth1 = |- {(X = x) /\ (Y = y)}R := X{(R = x) /\ (Y = y)} #let hth2 = ASSIGN_AX (MK_NICE `"{(R=x) /\\ (X=y)}"`) (MK_NICE `"X:=Y"`);; hth2 = |- {(R = x) /\ (Y = y)}X := Y{(R = x) /\ (X = y)} #let hth3 = ASSIGN_AX (MK_NICE `"{(Y=x) /\\ (X=y)}"`) (MK_NICE `"Y:=R"`);; hth3 = |- {(R = x) /\ (X = y)}Y := R{(Y = x) /\ (X = y)} # #SEQ_THM;; |- !p q r c1 c2. {p}c1{q} /\ {q}c2{r} ==> {p}c1; c2{r} # #let hth4 = SEQ_RULE (hth1,hth2);; hth4 = |- {(X = x) /\ (Y = y)}R := X; X := Y{(R = x) /\ (X = y)} #let hth5 = SEQ_RULE (hth4,hth3);; hth5 = |- {(X = x) /\ (Y = y)}R := X; X := Y; Y := R{(Y = x) /\ (X = y)} # #let hth6 = SEQL_RULE[hth1;hth2;hth3];; hth6 = |- {(X = x) /\ (Y = y)}R := X; X := Y; Y := R{(Y = x) /\ (X = y)} # #%----------------------------------------------------------------------------% #% Precondition Strengthening % #%----------------------------------------------------------------------------% # #let th1 = DISCH_ALL(CONTR "((X:num=x) /\ (Y:num=y))" (ASSUME (MK_NICE `"F"`)));; th1 = |- F ==> (X = x) /\ (Y = y) # #let hth7 = PRE_STRENGTH_RULE(th1,hth5);; hth7 = |- {F}R := X; X := Y; Y := R{(Y = x) /\ (X = y)} # #%----------------------------------------------------------------------------% #% Postcondition Weakening % #%----------------------------------------------------------------------------% # #let th2 = prove("((Y:num=x) /\ (X:num=y)) ==> T", REWRITE_TAC[]);; th2 = |- (Y = x) /\ (X = y) ==> T # #let hth8 = POST_WEAK_RULE(hth5,th2);; hth8 = |- {(X = x) /\ (Y = y)}R := X; X := Y; Y := R{T} # #%----------------------------------------------------------------------------% #% On-armed Conditional Rule % #%----------------------------------------------------------------------------% # #new_theory`MAX` ? extend_theory `MAX` ? ();; () : void # #let MAX = # new_definition # (`MAX`, "MAX(m,n) = ((m>n) => m | n)") ? definition `MAX` `MAX` ;; MAX = |- !m n. MAX(m,n) = (m > n => m | n) # #let hth9 = ASSIGN_AX "{X = MAX(x,y)}" (MK_NICE `"X := Y"`);; hth9 = |- {Y = MAX(x,y)}X := Y{X = MAX(x,y)} # #let MAX_LEMMA1 = # theorem `MAX` `MAX_LEMMA1` # ? # prove_thm # (`MAX_LEMMA1`, # "((X=x) /\ (Y=y)) /\ (Y>X) ==> (Y=MAX(x,y))", # REWRITE_TAC[MAX;GREATER] # THEN REPEAT STRIP_TAC # THEN ASSUM_LIST(\thl. ONCE_REWRITE_TAC(mapfilter SYM thl)) # THEN ASM_CASES_TAC (MK_NICE `"Y n = n < m MAX_LEMMA1 = |- ((X = x) /\ (Y = y)) /\ Y > X ==> (Y = MAX(x,y)) # #let hth10 = PRE_STRENGTH_RULE(MAX_LEMMA1,hth9);; hth10 = |- {((X = x) /\ (Y = y)) /\ Y > X}X := Y{X = MAX(x,y)} # #let MAX_LEMMA2 = # theorem `MAX` `MAX_LEMMA2` # ? # prove_thm # (`MAX_LEMMA2`, # "((X=x) /\ (Y=y)) /\ ~(Y>X) ==> (X=MAX(x,y))", # REWRITE_TAC[MAX;GREATER;NOT_LESS;LESS_OR_EQ] # THEN REPEAT STRIP_TAC # THEN ASSUM_LIST(\thl. ONCE_REWRITE_TAC(mapfilter SYM thl)) # THEN ASM_CASES_TAC "Y X ==> (X = MAX(x,y)) # #let hth11 = IF1_RULE(hth10,MAX_LEMMA2);; hth11 = |- {(X = x) /\ (Y = y)}if Y > X then X := Y{X = MAX(x,y)} # #%----------------------------------------------------------------------------% #% Two-armed Conditional Rule % #%----------------------------------------------------------------------------% # #let hth12 = ASSIGN_AX "{R = MAX(x,y)}" (MK_NICE `"R := Y"`);; hth12 = |- {Y = MAX(x,y)}R := Y{R = MAX(x,y)} # #let hth13 = PRE_STRENGTH_RULE(MAX_LEMMA1,hth12);; hth13 = |- {((X = x) /\ (Y = y)) /\ Y > X}R := Y{R = MAX(x,y)} # #let hth14 = ASSIGN_AX "{R = MAX(x,y)}" (MK_NICE `"R := X"`);; hth14 = |- {X = MAX(x,y)}R := X{R = MAX(x,y)} # #let hth15 = PRE_STRENGTH_RULE(MAX_LEMMA2,hth14);; hth15 = |- {((X = x) /\ (Y = y)) /\ ~Y > X}R := X{R = MAX(x,y)} # #let hth16 = IF2_RULE(hth13,hth15);; hth16 = |- {(X = x) /\ (Y = y)}if Y > X then R := Y else R := X{R = MAX(x,y)} # #%----------------------------------------------------------------------------% #% The WHILE-Rule % #%----------------------------------------------------------------------------% # #let hth17 = ASSIGN_AX (MK_NICE `"{X = R + (Y * Q)}"`) # (MK_NICE `"Q := (Q + 1)"`);; hth17 = |- {X = R + (Y * (Q + 1))}Q := Q + 1{X = R + (Y * Q)} # #let hth18 = ASSIGN_AX (MK_NICE `"{X = R + (Y * (Q + 1))}"`) # (MK_NICE `"R := (R-Y)"`);; hth18 = |- {X = (R - Y) + (Y * (Q + 1))}R := R - Y{X = R + (Y * (Q + 1))} # #let hth19 = SEQ_RULE(hth18,hth17);; hth19 = |- {X = (R - Y) + (Y * (Q + 1))}R := R - Y; Q := Q + 1{X = R + (Y * Q)} # #let th2 = # prove # ((MK_NICE `"((X = R + (Y * Q)) /\\ (Y<=R)) ==> # (X = (R - Y) + (Y * (Q + 1)))"`), # REPEAT STRIP_TAC # THEN REWRITE_TAC[LEFT_ADD_DISTRIB;MULT_CLAUSES] # THEN ONCE_REWRITE_TAC[SPEC (MK_NICE `"Y*Q"`) ADD_SYM] # THEN ONCE_REWRITE_TAC[ADD_ASSOC] # THEN IMP_RES_TAC SUB_ADD # THEN ASM_REWRITE_TAC[]);; Theorem SUB_ADD autoloaded from theory `arithmetic`. SUB_ADD = |- !m n. n <= m ==> ((m - n) + n = m) Theorem ADD_ASSOC autoloaded from theory `arithmetic`. ADD_ASSOC = |- !m n p. m + (n + p) = (m + n) + p Theorem ADD_SYM autoloaded from theory `arithmetic`. ADD_SYM = |- !m n. m + n = n + m Theorem MULT_CLAUSES autoloaded from theory `arithmetic`. MULT_CLAUSES = |- !m n. (0 * m = 0) /\ (m * 0 = 0) /\ (1 * m = m) /\ (m * 1 = m) /\ ((SUC m) * n = (m * n) + n) /\ (m * (SUC n) = m + (m * n)) Theorem LEFT_ADD_DISTRIB autoloaded from theory `arithmetic`. LEFT_ADD_DISTRIB = |- !m n p. p * (m + n) = (p * m) + (p * n) th2 = |- (X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1))) # #let hth20 = PRE_STRENGTH_RULE(th2,hth19);; hth20 = |- {(X = R + (Y * Q)) /\ Y <= R}R := R - Y; Q := Q + 1{X = R + (Y * Q)} # #let hth21 = WHILE_RULE hth20;; hth21 = |- {X = R + (Y * Q)} while Y <= R do R := R - Y; Q := Q + 1 {(X = R + (Y * Q)) /\ ~Y <= R} # #pretty_off();; true : bool # #WHILE_THM;; |- !p c b. MK_SPEC((\s. p s /\ b s),c,p) ==> MK_SPEC(p,MK_WHILE(b,c),(\s. p s /\ ~b s)) # #%----------------------------------------------------------------------------% #% The pretty printer needs more work ... % #%----------------------------------------------------------------------------% # #pretty_on();; false : bool # #WHILE_THM;; % "{p s /\ b s}" should print as "{p /\ s}" % |- !p c b. {p s /\ b s}c{p} ==> {p}while b do c{p s /\ ~b s} # #let hth22 = # SEQL_RULE # [ASSIGN_AX (MK_NICE `"{X = R + (Y * 0)}"`) (MK_NICE `"R := X"`); # ASSIGN_AX (MK_NICE `"{X = R + (Y * Q)}"`) (MK_NICE `"Q := 0"`); # hth21];; hth22 = |- {X = X + (Y * 0)} R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 {(X = R + (Y * Q)) /\ ~Y <= R} # #let th3 = # prove # ((MK_NICE `"(~(Y <= R)) = (R < Y)"`), # ONCE_REWRITE_TAC[SYM(SPEC (MK_NICE `"R void) apply = - : (tactic -> void) # #goal (MK_NICE # `"{T} # (R:=X; # Q:=0; # assert{(R = X) /\\ (Q = 0)}; # while Y<=R # do (invariant{X = (R + (Y * Q))}; # R := R-Y; Q := Q+1)) # {(R < Y) /\\ (X = (R + (Y * Q)))}"`);; "{T} R := X; Q := 0; assert{(R = X) /\ (Q = 0)}; while Y <= R do invariant{X = R + (Y * Q)}; R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))}" () : void # #apply(SEQ_TAC);; OK.. 2 subgoals "{(R = X) /\ (Q = 0)} while Y <= R do invariant{X = R + (Y * Q)}; R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))}" "{T}R := X; Q := 0{(R = X) /\ (Q = 0)}" () : void # #apply(SEQ_TAC);; OK.. "{T}R := X{(R = X) /\ (0 = 0)}" () : void #apply(ASSIGN_TAC);; OK.. "T ==> (X = X) /\ (0 = 0)" () : void #apply(REWRITE_TAC[]);; OK.. goal proved |- T ==> (X = X) /\ (0 = 0) |- {T}R := X{(R = X) /\ (0 = 0)} |- {T}R := X; Q := 0{(R = X) /\ (Q = 0)} Previous subproof: "{(R = X) /\ (Q = 0)} while Y <= R do invariant{X = R + (Y * Q)}; R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))}" () : void # #apply(WHILE_TAC);; OK.. 3 subgoals "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" "{(X = R + (Y * Q)) /\ Y <= R}R := R - Y; Q := Q + 1{X = R + (Y * Q)}" "(R = X) /\ (Q = 0) ==> (X = R + (Y * Q))" () : void # #apply(STRIP_TAC);; OK.. "X = R + (Y * Q)" [ "R = X" ] [ "Q = 0" ] () : void #apply(ASM_REWRITE_TAC[ADD_CLAUSES;MULT_CLAUSES]);; OK.. goal proved .. |- X = R + (Y * Q) |- (R = X) /\ (Q = 0) ==> (X = R + (Y * Q)) Previous subproof: 2 subgoals "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" "{(X = R + (Y * Q)) /\ Y <= R}R := R - Y; Q := Q + 1{X = R + (Y * Q)}" () : void # #apply(SEQ_TAC);; OK.. "{(X = R + (Y * Q)) /\ Y <= R}R := R - Y{X = R + (Y * (Q + 1))}" () : void #apply(ASSIGN_TAC);; OK.. "(X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1)))" () : void #apply(ACCEPT_TAC th2);; OK.. goal proved |- (X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1))) |- {(X = R + (Y * Q)) /\ Y <= R}R := R - Y{X = R + (Y * (Q + 1))} |- {(X = R + (Y * Q)) /\ Y <= R}R := R - Y; Q := Q + 1{X = R + (Y * Q)} Previous subproof: "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" () : void # #apply(REWRITE_TAC[SYM(SPEC_ALL NOT_LESS)]);; OK.. "(X = R + (Y * Q)) /\ R < Y ==> R < Y /\ (X = R + (Y * Q))" () : void #apply(DISCH_TAC);; OK.. "R < Y /\ (X = R + (Y * Q))" [ "(X = R + (Y * Q)) /\ R < Y" ] () : void #apply(ASM_REWRITE_TAC[]);; OK.. goal proved . |- R < Y /\ (X = R + (Y * Q)) |- (X = R + (Y * Q)) /\ R < Y ==> R < Y /\ (X = R + (Y * Q)) |- (X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q)) |- {(R = X) /\ (Q = 0)} while Y <= R do R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))} |- {T} R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))} Previous subproof: goal proved () : void # #let VC_TAC = # REPEAT(ASSIGN_TAC # ORELSE SEQ_TAC # ORELSE IF1_TAC # ORELSE IF2_TAC # ORELSE WHILE_TAC);; VC_TAC = - : tactic # #goal (MK_NICE # `"{T} # (R:=X; # Q:=0; # assert{(R = X) /\\ (Q = 0)}; # while Y<=R # do (invariant{X = (R + (Y * Q))}; # R := R-Y; Q := Q+1)) # {(R < Y) /\\ (X = (R + (Y * Q)))}"`);; "{T} R := X; Q := 0; assert{(R = X) /\ (Q = 0)}; while Y <= R do invariant{X = R + (Y * Q)}; R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))}" () : void # #apply(VC_TAC);; OK.. 4 subgoals "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" "(X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1)))" "(R = X) /\ (Q = 0) ==> (X = R + (Y * Q))" "T ==> (X = X) /\ (0 = 0)" () : void # #apply(REWRITE_TAC[]);; OK.. goal proved |- T ==> (X = X) /\ (0 = 0) Previous subproof: 3 subgoals "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" "(X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1)))" "(R = X) /\ (Q = 0) ==> (X = R + (Y * Q))" () : void # #apply(STRIP_TAC);; OK.. "X = R + (Y * Q)" [ "R = X" ] [ "Q = 0" ] () : void #apply(ASM_REWRITE_TAC[ADD_CLAUSES;MULT_CLAUSES]);; OK.. goal proved .. |- X = R + (Y * Q) |- (R = X) /\ (Q = 0) ==> (X = R + (Y * Q)) Previous subproof: 2 subgoals "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" "(X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1)))" () : void # #apply(ACCEPT_TAC th2);; OK.. goal proved |- (X = R + (Y * Q)) /\ Y <= R ==> (X = (R - Y) + (Y * (Q + 1))) Previous subproof: "(X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q))" () : void # #apply(REWRITE_TAC[SYM(SPEC_ALL NOT_LESS)]);; OK.. "(X = R + (Y * Q)) /\ R < Y ==> R < Y /\ (X = R + (Y * Q))" () : void #apply(DISCH_TAC);; OK.. "R < Y /\ (X = R + (Y * Q))" [ "(X = R + (Y * Q)) /\ R < Y" ] () : void #apply(ASM_REWRITE_TAC[]);; OK.. goal proved . |- R < Y /\ (X = R + (Y * Q)) |- (X = R + (Y * Q)) /\ R < Y ==> R < Y /\ (X = R + (Y * Q)) |- (X = R + (Y * Q)) /\ ~Y <= R ==> R < Y /\ (X = R + (Y * Q)) |- {T} R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))} Previous subproof: goal proved () : void # #prove # ((MK_NICE # `"{T} # (R:=X; # Q:=0; # assert{(R = X) /\\ (Q = 0)}; # while Y<=R # do (invariant{X = (R + (Y * Q))}; # R:=R-Y; Q:=Q+1)) # {(R < Y) /\\ (X = (R + (Y * Q)))}"`), # VC_TAC # THENL # [REWRITE_TAC[]; # STRIP_TAC # THEN ASM_REWRITE_TAC[ADD_CLAUSES;MULT_CLAUSES]; # ACCEPT_TAC th2; # REWRITE_TAC[SYM(SPEC_ALL NOT_LESS)] # THEN DISCH_TAC # THEN ASM_REWRITE_TAC[] # ]);; |- {T} R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 {R < Y /\ (X = R + (Y * Q))} # # #%----------------------------------------------------------------------------% #% The Hoare Logic of total correctness in HOL (halts_logic.ml) % #%----------------------------------------------------------------------------% # #let tth1 = # ASSIGN_T_AX (MK_NICE `"{(0 < Y /\\ (X = R + (Y * Q))) /\\ R < r}"`) # (MK_NICE `"Q := (Q + 1)"`);; tth1 = |- [(0 < Y /\ (X = R + (Y * (Q + 1)))) /\ R < r] Q := Q + 1 [(0 < Y /\ (X = R + (Y * Q))) /\ R < r] # #pretty_off();; true : bool # #tth1;; |- T_SPEC ((\s. (0 < (s `Y`) /\ (s `X` = (s `R`) + ((s `Y`) * ((s `Q`) + 1)))) /\ (s `R`) < r),MK_ASSIGN(`Q`,(\s. (s `Q`) + 1)), (\s. (0 < (s `Y`) /\ (s `X` = (s `R`) + ((s `Y`) * (s `Q`)))) /\ (s `R`) < r)) # #T_SPEC;; Definition T_SPEC autoloaded from theory `halts_thms`. T_SPEC = |- !p c q. T_SPEC(p,c,q) = MK_SPEC(p,c,q) /\ HALTS p c |- !p c q. T_SPEC(p,c,q) = MK_SPEC(p,c,q) /\ HALTS p c # #HALTS;; Definition HALTS autoloaded from theory `halts`. HALTS = |- !p c. HALTS p c = (!s. p s ==> (?s'. c(s,s'))) |- !p c. HALTS p c = (!s. p s ==> (?s'. c(s,s'))) # #pretty_on();; false : bool # #let tth2 = # ASSIGN_T_AX (MK_NICE `"{(0 < Y /\\ (X = R + (Y * (Q + 1)))) /\\ R < r}"`) # (MK_NICE `"R := (R-Y)"`);; tth2 = |- [(0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r] R := R - Y [(0 < Y /\ (X = R + (Y * (Q + 1)))) /\ R < r] # #let tth3 = SEQ_T_RULE(tth2,tth1);; tth3 = |- [(0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r] R := R - Y; Q := Q + 1 [(0 < Y /\ (X = R + (Y * Q))) /\ R < r] # #let th4 = # prove # ("!m. 0 < m ==> !n. 0 < n ==> (n - m) < n", # INDUCT_TAC # THEN REWRITE_TAC[LESS_REFL;LESS_0] # THEN INDUCT_TAC # THEN REWRITE_TAC[LESS_REFL;LESS_0;SUB;LESS_MONO_EQ] # THEN ASM_CASES_TAC "n < SUC m" # THEN ASM_REWRITE_TAC[LESS_0;LESS_MONO_EQ] # THEN ASM_CASES_TAC "0 < n" # THEN RES_TAC # THEN POP_ASSUM_LIST # (\[th1;th2;th3;th4]. # STRIP_ASSUME_TAC(REWRITE_RULE[NOT_LESS](CONJ th1 th2))) # THEN IMP_RES_TAC LESS_EQ_TRANS # THEN IMP_RES_TAC OR_LESS # THEN IMP_RES_TAC NOT_LESS_0);; Theorem NOT_LESS_0 autoloaded from theory `prim_rec`. NOT_LESS_0 = |- !n. ~n < 0 Theorem OR_LESS autoloaded from theory `arithmetic`. OR_LESS = |- !m n. (SUC m) <= n ==> m < n Theorem LESS_EQ_TRANS autoloaded from theory `arithmetic`. LESS_EQ_TRANS = |- !m n p. m <= n /\ n <= p ==> m <= p Theorem LESS_MONO_EQ autoloaded from theory `arithmetic`. LESS_MONO_EQ = |- !m n. (SUC m) < (SUC n) = m < n Definition SUB autoloaded from theory `arithmetic`. SUB = |- (!m. 0 - m = 0) /\ (!m n. (SUC m) - n = (m < n => 0 | SUC(m - n))) Theorem LESS_0 autoloaded from theory `prim_rec`. LESS_0 = |- !n. 0 < (SUC n) Theorem LESS_REFL autoloaded from theory `prim_rec`. LESS_REFL = |- !n. ~n < n th4 = |- !m. 0 < m ==> (!n. 0 < n ==> (n - m) < n) # #let th5 = # prove # ("!m n p. m < n /\ n <= p ==> m < p", # REWRITE_TAC[LESS_OR_EQ] # THEN REPEAT STRIP_TAC # THEN IMP_RES_TAC LESS_TRANS # THEN ASSUM_LIST(\[th1;th2;th3]. REWRITE_TAC[SYM th2]) # THEN ASM_REWRITE_TAC[]);; Theorem LESS_TRANS autoloaded from theory `arithmetic`. LESS_TRANS = |- !m n p. m < n /\ n < p ==> m < p th5 = |- !m n p. m < n /\ n <= p ==> m < p # #let th6 = # prove # ((MK_NICE `"((0 < Y /\\ (X = R + (Y * Q))) /\\ (Y<=R) /\\ (R = r)) # ==> (0 < Y /\\ (X = (R - Y) + (Y * (Q + 1)))) /\\ (R - Y) < r"`), # REPEAT STRIP_TAC # THEN REWRITE_TAC[LEFT_ADD_DISTRIB;MULT_CLAUSES] # THEN ONCE_REWRITE_TAC[SPEC "Y*Q" ADD_SYM] # THEN ONCE_REWRITE_TAC[ADD_ASSOC] # THEN IMP_RES_TAC SUB_ADD # THEN ASM_REWRITE_TAC[] # THEN IMP_RES_TAC th5 # THEN ASSUM_LIST(\thl. REWRITE_TAC[SYM(el 4 thl)]) # THEN IMP_RES_TAC th4);; th6 = |- (0 < Y /\ (X = R + (Y * Q))) /\ Y <= R /\ (R = r) ==> (0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r # #let tth4 = PRE_STRENGTH_T_RULE(th6,tth3);; tth4 = |- [(0 < Y /\ (X = R + (Y * Q))) /\ Y <= R /\ (R = r)] R := R - Y; Q := Q + 1 [(0 < Y /\ (X = R + (Y * Q))) /\ R < r] # #let tth5 = WHILE_T_RULE tth4;; tth5 = |- [0 < Y /\ (X = R + (Y * Q))] while Y <= R do R := R - Y; Q := Q + 1 [(0 < Y /\ (X = R + (Y * Q))) /\ ~Y <= R] # #let tth6 = # SEQL_T_RULE # [ASSIGN_T_AX (MK_NICE `"{(0 < Y) /\\ (X = R + (Y * 0))}"`) # (MK_NICE `"R := X"`); # ASSIGN_T_AX (MK_NICE `"{(0 < Y) /\\ (X = R + (Y * Q))}"`) # (MK_NICE `"Q := 0"`); # tth5];; tth6 = |- [0 < Y /\ (X = X + (Y * 0))] R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 [(0 < Y /\ (X = R + (Y * Q))) /\ ~Y <= R] # #let th7 = # prove # ((MK_NICE `"(~(Y <= R)) = (R < Y)"`), # ONCE_REWRITE_TAC[SYM(SPEC "R (X = R + (Y * Q)) /\ R < Y" "(0 < Y /\ (X = R + (Y * Q))) /\ Y <= R /\ (R = r) ==> (0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r" "0 < Y /\ (R = X) /\ (Q = 0) ==> 0 < Y /\ (X = R + (Y * Q))" "0 < Y ==> 0 < Y /\ (X = X) /\ (0 = 0)" () : void # #apply(REWRITE_TAC[]);; OK.. goal proved |- 0 < Y ==> 0 < Y /\ (X = X) /\ (0 = 0) Previous subproof: 3 subgoals "(0 < Y /\ (X = R + (Y * Q))) /\ ~Y <= R ==> (X = R + (Y * Q)) /\ R < Y" "(0 < Y /\ (X = R + (Y * Q))) /\ Y <= R /\ (R = r) ==> (0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r" "0 < Y /\ (R = X) /\ (Q = 0) ==> 0 < Y /\ (X = R + (Y * Q))" () : void # #apply(STRIP_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES;MULT_CLAUSES]);; OK.. goal proved |- 0 < Y /\ (R = X) /\ (Q = 0) ==> 0 < Y /\ (X = R + (Y * Q)) Previous subproof: 2 subgoals "(0 < Y /\ (X = R + (Y * Q))) /\ ~Y <= R ==> (X = R + (Y * Q)) /\ R < Y" "(0 < Y /\ (X = R + (Y * Q))) /\ Y <= R /\ (R = r) ==> (0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r" () : void # #apply(ACCEPT_TAC th6);; OK.. goal proved |- (0 < Y /\ (X = R + (Y * Q))) /\ Y <= R /\ (R = r) ==> (0 < Y /\ (X = (R - Y) + (Y * (Q + 1)))) /\ (R - Y) < r Previous subproof: "(0 < Y /\ (X = R + (Y * Q))) /\ ~Y <= R ==> (X = R + (Y * Q)) /\ R < Y" () : void # #apply(REWRITE_TAC[SYM(SPEC_ALL NOT_LESS)]);; OK.. "(0 < Y /\ (X = R + (Y * Q))) /\ R < Y ==> (X = R + (Y * Q)) /\ R < Y" () : void #apply(DISCH_TAC);; OK.. "(X = R + (Y * Q)) /\ R < Y" [ "(0 < Y /\ (X = R + (Y * Q))) /\ R < Y" ] () : void #apply(ASM_REWRITE_TAC[]);; OK.. goal proved . |- (X = R + (Y * Q)) /\ R < Y |- (0 < Y /\ (X = R + (Y * Q))) /\ R < Y ==> (X = R + (Y * Q)) /\ R < Y |- (0 < Y /\ (X = R + (Y * Q))) /\ ~Y <= R ==> (X = R + (Y * Q)) /\ R < Y |- [0 < Y] R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 [(X = R + (Y * Q)) /\ R < Y] Previous subproof: goal proved () : void # #let DIV_CORRECT = # prove # ((MK_NICE `"[0 < Y] # (R:=X; # Q:=0; # assert{(0 < Y) /\\ (R = X) /\\ (Q = 0)}; # while Y<=R # do (invariant{(0 < Y) /\\ (X = (R + (Y * Q)))}; # variant{R}; # R:=R-Y; Q:=Q+1)) # [(R < Y) /\\ (X = (R + (Y * Q)))]"`), # VC_T_TAC # THENL # [REWRITE_TAC[]; # STRIP_TAC # THEN ASM_REWRITE_TAC[ADD_CLAUSES;MULT_CLAUSES]; # ACCEPT_TAC th6; # REWRITE_TAC[SYM(SPEC_ALL NOT_LESS)] # THEN DISCH_TAC # THEN ASM_REWRITE_TAC[] # ]);; DIV_CORRECT = |- [0 < Y] R := X; Q := 0; while Y <= R do R := R - Y; Q := Q + 1 [R < Y /\ (X = R + (Y * Q))] # #pretty_off();; true : bool # #DIV_CORRECT;; |- T_SPEC ((\s. 0 < (s `Y`)), MK_SEQ (MK_SEQ(MK_ASSIGN(`R`,(\s. s `X`)),MK_ASSIGN(`Q`,(\s. 0))), MK_WHILE ((\s. (s `Y`) <= (s `R`)), MK_SEQ (MK_ASSIGN(`R`,(\s. (s `R`) - (s `Y`))), MK_ASSIGN(`Q`,(\s. (s `Q`) + 1))))), (\s. (s `R`) < (s `Y`) /\ (s `X` = (s `R`) + ((s `Y`) * (s `Q`))))) # #pretty_on();; false : bool # #%----------------------------------------------------------------------------% #% To see how weakest preconditions and dynamic logic can be represented in % #% HOL, browse the files mk_dijkstra.ml and mk_dynamic_logic.ml, respectively.% #%----------------------------------------------------------------------------% # [Return to top level] -> ÿhol88-2.02.19940316/Library/parser/Examples/tiny/loader.ml0000640000212700021270000000106404577715430021202 0ustar cammcamm% Generated parser load file First load some basic definitions: % loadf `/usr/groups/hol/hol_12/Library/parser/general`;; % Insert any other files you want loaded here: % loadf `tiny_help`;; % Now load the declarations: % loadf `tiny_decls`;; % Finally load in the function definitions: % loadf `tiny`;; let SEPS = [(`(`,[]);(`)`,[]);(`]`,[]);(`[`,[]);(`{`,[]);(`}`,[]);(`+`,[]);(`-`,[]); (`*`,[]);(`;`,[]);(`:`,[`=`]);(`=`,[`=`;`>`]);(`<`,[`=`;`>`]);(`>`,[`=`]); (`~`,[]);(`/`,[`\\`]);(`\\`,[`/`])];; let MK_NICE thing = PARSE_text(thing,[],SEPS);; hol88-2.02.19940316/Library/parser/Examples/tiny/tiny.grm0000640000212700021270000000665204577706121021101 0ustar cammcamm% Tokens % FIRST_CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0`. CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 _`. % Logical expressions (for use with assert and invariant) % logical_1 --> [/\\] {mk_conj(POP,logical_expr)} | [\\/] {mk_disj(POP,logical_expr)} | [==>] {mk_imp(POP,logical_expr)} | []. logical_expr --> [(] logical_expr [)] logical_1 | bool_expr logical_1. % Expressions: % possible_paren --> [(] expression [)] | {mk_variable(TOKEN)}. rest_of_expression --> [+] {mk_plus(POP,possible_paren)} rest_of_expression | [-] {mk_minus(POP,possible_paren)} rest_of_expression | [*] {mk_mult(POP,possible_paren)} rest_of_expression | []. expression --> [(] expression [)] rest_of_expression | {mk_variable(TOKEN)} rest_of_expression. rest_of_bool --> [=] {mk_eq(POP,bool_1)} | [>] {mk_gt(POP,bool_1)} | [<] {mk_lt(POP,bool_1)} | [<=] {mk_lte(POP,bool_1)} | [>=] {mk_gte(POP,bool_1)} | [<>] {mk_neq(POP,bool_1)}. bool_1 --> [~] {mk_neg(bool_1)} | [(] bool_1 [)] poss_rest_of_bool | [T] {mk_const(`T`,":bool")} | [F] {mk_const(`F`,":bool")} | expression poss_rest_of_bool. poss_rest_of_bool --> rest_of_bool | []. bool_expr --> [~] {mk_neg(bool_expr)} | [(] bool_expr [)] poss_rest_of_bool | [T] {mk_const(`T`,":bool")} | [F] {mk_const(`F`,":bool")} | expression rest_of_bool. % Assignment Statement: % assignment_stmnt --> [:=] {mk_semantic(expression)} {mk_assign(POP,POP)}. % If Statement: % more_if_stmnts --> [else] a_stmnt more_stmnts {mk_if2(POP,POP,POP)} | {mk_if1(POP,POP)}. rest_of_if --> [then] many_stmnts more_if_stmnts. % While Statement: % rest_of_while --> [do] {mk_while(POP,many_stmnts)}. % General Statements: % MAIN_LOOP --> [\{] {mk_semantic(logical_expr)} [\}] is_spec | [\[] {mk_semantic(logical_expr)} [\]] many_stmnts [\[] {mk_semantic(logical_expr)} [\]] {mk_t_spec(POP,POP,POP)} [EOF] | [(] many_expr_logical [)][EOF] | many_expr_logical. is_spec --> [EOF] | many_stmnts [\{] {mk_semantic(logical_expr)} [\}] {mk_spec(POP,POP,POP)} [EOF]. many_expr_logical --> many_stmnts | expression | bool_expr | logical_expr. more_stmnts --> [;] a_stmnt more_stmnts {mk_seq(POP,POP)} | []. many_stmnts --> a_stmnt more_stmnts. meta_logical_stmnt --> [assert][\{] {mk_semantic(logical_expr)} [\}] {mk_assert(POP)} | [invariant] [\{] {mk_semantic(logical_expr)} [\}] {mk_invariant(POP)} | [variant] [\{] {mk_variable(TOKEN)} [\}] {mk_semantic(POP)} {mk_variant(POP)}. a_stmnt --> [(] many_stmnts [)] | [if] {mk_semantic(bool_expr)} rest_of_if | [while] {mk_semantic(bool_expr)} rest_of_while | meta_logical_stmnt | {mk_variable_name(TOKEN)} assignment_stmnt. hol88-2.02.19940316/Library/parser/Examples/tiny/tiny.ml0000640000212700021270000010207105034371437020711 0ustar cammcamm % Tokens % % Logical expressions (for use with assert and invariant) % logical_1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`logical_1`,expected,WORD); if WORD = `/\\` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (logical_expr_1 , result_list , prev, lst) = logical_expr lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_conj(POP_0,logical_expr_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `logical_1` prev lst `nil`) else fail ? if WORD = `\\/` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (logical_expr_1 , result_list , prev, lst) = logical_expr lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_disj(POP_0,logical_expr_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `logical_1` prev lst `nil`) else fail ? if WORD = `==>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (logical_expr_1 , result_list , prev, lst) = logical_expr lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_imp(POP_0,logical_expr_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `logical_1` prev lst `nil`) else fail ? (do_return result_list whitespace `logical_1` WORD lst expected);; logical_expr:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`logical_expr`,expected,WORD); if WORD = `(` then (let (logical_expr_0 , result_list , prev, lst) = logical_expr lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push logical_expr_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `logical_expr` in let TOKENS = explode WORD in let (logical_1_1 , result_list , prev, lst) = logical_1 lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push logical_1_1 result_list in do_return result_list whitespace `logical_expr` prev lst `nil`) else fail ? (let (bool_expr_0 , result_list , prev, lst) = bool_expr lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push bool_expr_0 result_list in let (logical_1_1 , result_list , prev, lst) = logical_1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push logical_1_1 result_list in do_return result_list whitespace `logical_expr` prev lst `nil`);; % Expressions: % possible_paren:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`possible_paren`,expected,WORD); if WORD = `(` then (let (expression_0 , result_list , prev, lst) = expression lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push expression_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `possible_paren` in let TOKENS = explode WORD in do_return result_list whitespace `possible_paren` WORD lst expected) else fail ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = mk_variable(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `possible_paren` whitespace lst `nil`);; rest_of_expression:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_expression`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (possible_paren_1 , result_list , prev, lst) = possible_paren lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_plus(POP_0,possible_paren_1) in let result_list = push tmp_2 result_list in let (rest_of_expression_2 , result_list , prev, lst) = rest_of_expression lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_expression_2 result_list in do_return result_list whitespace `rest_of_expression` prev lst `nil`) else fail ? if WORD = `-` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (possible_paren_1 , result_list , prev, lst) = possible_paren lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_minus(POP_0,possible_paren_1) in let result_list = push tmp_2 result_list in let (rest_of_expression_2 , result_list , prev, lst) = rest_of_expression lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_expression_2 result_list in do_return result_list whitespace `rest_of_expression` prev lst `nil`) else fail ? if WORD = `*` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (possible_paren_1 , result_list , prev, lst) = possible_paren lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_mult(POP_0,possible_paren_1) in let result_list = push tmp_2 result_list in let (rest_of_expression_2 , result_list , prev, lst) = rest_of_expression lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_expression_2 result_list in do_return result_list whitespace `rest_of_expression` prev lst `nil`) else fail ? (do_return result_list whitespace `rest_of_expression` WORD lst expected);; expression:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`expression`,expected,WORD); if WORD = `(` then (let (expression_0 , result_list , prev, lst) = expression lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push expression_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `expression` in let TOKENS = explode WORD in let (rest_of_expression_1 , result_list , prev, lst) = rest_of_expression lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_expression_1 result_list in do_return result_list whitespace `expression` prev lst `nil`) else fail ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_1 = mk_variable(TOKEN_0) in let result_list = push tmp_1 result_list in let (rest_of_expression_1 , result_list , prev, lst) = rest_of_expression lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_expression_1 result_list in do_return result_list whitespace `expression` prev lst `nil`);; rest_of_bool:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_bool`,expected,WORD); if WORD = `=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (bool_1_1 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_eq(POP_0,bool_1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_bool` prev lst `nil`) else fail ? if WORD = `>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (bool_1_1 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_gt(POP_0,bool_1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_bool` prev lst `nil`) else fail ? if WORD = `<` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (bool_1_1 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_lt(POP_0,bool_1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_bool` prev lst `nil`) else fail ? if WORD = `<=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (bool_1_1 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_lte(POP_0,bool_1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_bool` prev lst `nil`) else fail ? if WORD = `>=` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (bool_1_1 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_gte(POP_0,bool_1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_bool` prev lst `nil`) else fail ? if WORD = `<>` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (bool_1_1 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_neq(POP_0,bool_1_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_bool` prev lst `nil`) else fail ? fail;; bool_1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`bool_1`,expected,WORD); if WORD = `~` then (let (bool_1_0 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = mk_neg(bool_1_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `bool_1` prev lst `nil`) else fail ? if WORD = `(` then (let (bool_1_0 , result_list , prev, lst) = bool_1 lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push bool_1_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `bool_1` in let TOKENS = explode WORD in let (poss_rest_of_bool_1 , result_list , prev, lst) = poss_rest_of_bool lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push poss_rest_of_bool_1 result_list in do_return result_list whitespace `bool_1` prev lst `nil`) else fail ? if WORD = `T` then (let tmp_0 = mk_const(`T`,":bool") in let result_list = push tmp_0 result_list in do_return result_list whitespace `bool_1` whitespace lst expected) else fail ? if WORD = `F` then (let tmp_0 = mk_const(`F`,":bool") in let result_list = push tmp_0 result_list in do_return result_list whitespace `bool_1` whitespace lst expected) else fail ? (let (expression_0 , result_list , prev, lst) = expression lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push expression_0 result_list in let (poss_rest_of_bool_1 , result_list , prev, lst) = poss_rest_of_bool lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_rest_of_bool_1 result_list in do_return result_list whitespace `bool_1` prev lst `nil`);; poss_rest_of_bool:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_rest_of_bool`,expected,WORD); (let (rest_of_bool_0 , result_list , prev, lst) = rest_of_bool lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_bool_0 result_list in do_return result_list whitespace `poss_rest_of_bool` prev lst `nil`) ? (do_return result_list whitespace `poss_rest_of_bool` WORD lst expected);; bool_expr:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`bool_expr`,expected,WORD); if WORD = `~` then (let (bool_expr_0 , result_list , prev, lst) = bool_expr lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = mk_neg(bool_expr_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `bool_expr` prev lst `nil`) else fail ? if WORD = `(` then (let (bool_expr_0 , result_list , prev, lst) = bool_expr lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push bool_expr_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `bool_expr` in let TOKENS = explode WORD in let (poss_rest_of_bool_1 , result_list , prev, lst) = poss_rest_of_bool lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push poss_rest_of_bool_1 result_list in do_return result_list whitespace `bool_expr` prev lst `nil`) else fail ? if WORD = `T` then (let tmp_0 = mk_const(`T`,":bool") in let result_list = push tmp_0 result_list in do_return result_list whitespace `bool_expr` whitespace lst expected) else fail ? if WORD = `F` then (let tmp_0 = mk_const(`F`,":bool") in let result_list = push tmp_0 result_list in do_return result_list whitespace `bool_expr` whitespace lst expected) else fail ? (let (expression_0 , result_list , prev, lst) = expression lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push expression_0 result_list in let (rest_of_bool_1 , result_list , prev, lst) = rest_of_bool lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_bool_1 result_list in do_return result_list whitespace `bool_expr` prev lst `nil`);; % Assignment Statement: % assignment_stmnt:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`assignment_stmnt`,expected,WORD); if WORD = `:=` then (let (expression_0 , result_list , prev, lst) = expression lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = mk_semantic(expression_0) in let result_list = push tmp_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = mk_assign(POP_1,POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `assignment_stmnt` prev lst `nil`) else fail ? fail;; % If Statement: % more_if_stmnts:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_if_stmnts`,expected,WORD); if WORD = `else` then (let (a_stmnt_0 , result_list , prev, lst) = a_stmnt lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push a_stmnt_0 result_list in let (more_stmnts_1 , result_list , prev, lst) = more_stmnts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_stmnts_1 result_list in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = mk_if2(POP_2,POP_3,POP_4) in let result_list = push tmp_5 result_list in do_return result_list whitespace `more_if_stmnts` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = mk_if1(POP_0,POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_if_stmnts` WORD lst expected);; rest_of_if:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_if`,expected,WORD); if WORD = `then` then (let (many_stmnts_0 , result_list , prev, lst) = many_stmnts lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push many_stmnts_0 result_list in let (more_if_stmnts_1 , result_list , prev, lst) = more_if_stmnts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_if_stmnts_1 result_list in do_return result_list whitespace `rest_of_if` prev lst `nil`) else fail ? fail;; % While Statement: % rest_of_while:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_while`,expected,WORD); if WORD = `do` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (many_stmnts_1 , result_list , prev, lst) = many_stmnts lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_while(POP_0,many_stmnts_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `rest_of_while` prev lst `nil`) else fail ? fail;; % General Statements: % MAIN_LOOP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MAIN_LOOP`,expected,WORD); if WORD = `{` then (let (logical_expr_0 , result_list , prev, lst) = logical_expr lst whitespace whitespace result_list FIRST_CHARS CHARS `\}` in let tmp_1 = mk_semantic(logical_expr_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in let (is_spec_1 , result_list , prev, lst) = is_spec lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push is_spec_1 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`) else fail ? if WORD = `[` then (let (logical_expr_0 , result_list , prev, lst) = logical_expr lst whitespace whitespace result_list FIRST_CHARS CHARS `\]` in let tmp_1 = mk_semantic(logical_expr_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in let (many_stmnts_1 , result_list , prev, lst) = many_stmnts lst whitespace WORD result_list FIRST_CHARS CHARS `\[` in let result_list = push many_stmnts_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\[` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in let (logical_expr_2 , result_list , prev, lst) = logical_expr lst whitespace WORD result_list FIRST_CHARS CHARS `\]` in let tmp_3 = mk_semantic(logical_expr_2) in let result_list = push tmp_3 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\]` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let (POP_5 , pop_list ) = (pop pop_list) in let tmp_6 = mk_t_spec(POP_3,POP_4,POP_5) in let result_list = push tmp_6 result_list in let (WORD,lst) = eat_terminal `nil` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in do_return result_list whitespace `MAIN_LOOP` WORD lst expected) else fail ? if WORD = `(` then (let (many_expr_logical_0 , result_list , prev, lst) = many_expr_logical lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push many_expr_logical_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in let (WORD,lst) = eat_terminal `nil` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in do_return result_list whitespace `MAIN_LOOP` WORD lst expected) else fail ? (let (many_expr_logical_0 , result_list , prev, lst) = many_expr_logical lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push many_expr_logical_0 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`);; let PARSE_file (in_file,whitespace,separators) = let white = if null whitespace then [` `;`\T`;`\L`] else whitespace and inf = open_file `in` in_file in let WORD = e_w_s inf (hd white) white in let lst = read_input inf [] white separators WORD IGNORE USEFUL in let (WORD,lst) = (hd lst,tl lst) in let result = fst (MAIN_LOOP lst (hd white) WORD [] FIRST_CHARS CHARS `nil`) in result ? fail;; let PARSE_text (text,whitespace,separators) = let outf = open_file `out` `/tmp/.000HOL` in write_string text outf; close_file outf; let result = PARSE_file (`/tmp/.000HOL`,whitespace,separators) in unlink `/tmp/.000HOL`; result;; is_spec:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`is_spec`,expected,WORD); if WORD = `nil` then (do_return result_list whitespace `is_spec` `nil` lst expected) else fail ? (let (many_stmnts_0 , result_list , prev, lst) = many_stmnts lst whitespace WORD result_list FIRST_CHARS CHARS `\{` in let result_list = push many_stmnts_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\{` WORD lst `is_spec` in let TOKENS = explode WORD in let (logical_expr_1 , result_list , prev, lst) = logical_expr lst whitespace WORD result_list FIRST_CHARS CHARS `\}` in let tmp_2 = mk_semantic(logical_expr_1) in let result_list = push tmp_2 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `is_spec` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 3 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let (POP_4 , pop_list ) = (pop pop_list) in let tmp_5 = mk_spec(POP_2,POP_3,POP_4) in let result_list = push tmp_5 result_list in let (WORD,lst) = eat_terminal `nil` WORD lst `is_spec` in let TOKENS = explode WORD in do_return result_list whitespace `is_spec` WORD lst expected);; many_expr_logical:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`many_expr_logical`,expected,WORD); (let (many_stmnts_0 , result_list , prev, lst) = many_stmnts lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push many_stmnts_0 result_list in do_return result_list whitespace `many_expr_logical` prev lst `nil`) ? (let (expression_0 , result_list , prev, lst) = expression lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push expression_0 result_list in do_return result_list whitespace `many_expr_logical` prev lst `nil`) ? (let (bool_expr_0 , result_list , prev, lst) = bool_expr lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push bool_expr_0 result_list in do_return result_list whitespace `many_expr_logical` prev lst `nil`) ? (let (logical_expr_0 , result_list , prev, lst) = logical_expr lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push logical_expr_0 result_list in do_return result_list whitespace `many_expr_logical` prev lst `nil`);; more_stmnts:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_stmnts`,expected,WORD); if WORD = `;` then (let (a_stmnt_0 , result_list , prev, lst) = a_stmnt lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push a_stmnt_0 result_list in let (more_stmnts_1 , result_list , prev, lst) = more_stmnts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_stmnts_1 result_list in let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let (POP_3 , pop_list ) = (pop pop_list) in let tmp_4 = mk_seq(POP_2,POP_3) in let result_list = push tmp_4 result_list in do_return result_list whitespace `more_stmnts` prev lst `nil`) else fail ? (do_return result_list whitespace `more_stmnts` WORD lst expected);; many_stmnts:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`many_stmnts`,expected,WORD); (let (a_stmnt_0 , result_list , prev, lst) = a_stmnt lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push a_stmnt_0 result_list in let (more_stmnts_1 , result_list , prev, lst) = more_stmnts lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_stmnts_1 result_list in do_return result_list whitespace `many_stmnts` prev lst `nil`);; meta_logical_stmnt:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`meta_logical_stmnt`,expected,WORD); if WORD = `assert` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\{` WORD lst `meta_logical_stmnt` in let TOKENS = explode WORD in let (logical_expr_0 , result_list , prev, lst) = logical_expr lst whitespace WORD result_list FIRST_CHARS CHARS `\}` in let tmp_1 = mk_semantic(logical_expr_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `meta_logical_stmnt` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = mk_assert(POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `meta_logical_stmnt` WORD lst expected) else fail ? if WORD = `invariant` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\{` WORD lst `meta_logical_stmnt` in let TOKENS = explode WORD in let (logical_expr_0 , result_list , prev, lst) = logical_expr lst whitespace WORD result_list FIRST_CHARS CHARS `\}` in let tmp_1 = mk_semantic(logical_expr_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `\}` WORD lst `meta_logical_stmnt` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = mk_invariant(POP_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `meta_logical_stmnt` WORD lst expected) else fail ? if WORD = `variant` then (let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\{` WORD lst `meta_logical_stmnt` in let TOKENS = explode WORD in let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `\}` in let tmp_1 = mk_variable(TOKEN_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `\}` WORD lst `meta_logical_stmnt` in let TOKENS = explode WORD in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = mk_semantic(POP_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = mk_variant(POP_2) in let result_list = push tmp_3 result_list in do_return result_list whitespace `meta_logical_stmnt` WORD lst expected) else fail ? fail;; a_stmnt:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`a_stmnt`,expected,WORD); if WORD = `(` then (let (many_stmnts_0 , result_list , prev, lst) = many_stmnts lst whitespace whitespace result_list FIRST_CHARS CHARS `)` in let result_list = push many_stmnts_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `)` WORD lst `a_stmnt` in let TOKENS = explode WORD in do_return result_list whitespace `a_stmnt` WORD lst expected) else fail ? if WORD = `if` then (let (bool_expr_0 , result_list , prev, lst) = bool_expr lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = mk_semantic(bool_expr_0) in let result_list = push tmp_1 result_list in let (rest_of_if_1 , result_list , prev, lst) = rest_of_if lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_if_1 result_list in do_return result_list whitespace `a_stmnt` prev lst `nil`) else fail ? if WORD = `while` then (let (bool_expr_0 , result_list , prev, lst) = bool_expr lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = mk_semantic(bool_expr_0) in let result_list = push tmp_1 result_list in let (rest_of_while_1 , result_list , prev, lst) = rest_of_while lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_while_1 result_list in do_return result_list whitespace `a_stmnt` prev lst `nil`) else fail ? (let (meta_logical_stmnt_0 , result_list , prev, lst) = meta_logical_stmnt lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push meta_logical_stmnt_0 result_list in do_return result_list whitespace `a_stmnt` prev lst `nil`) ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_1 = mk_variable_name(TOKEN_0) in let result_list = push tmp_1 result_list in let (assignment_stmnt_1 , result_list , prev, lst) = assignment_stmnt lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push assignment_stmnt_1 result_list in do_return result_list whitespace `a_stmnt` prev lst `nil`);; hol88-2.02.19940316/Library/parser/Examples/tiny/tiny_help.ml0000640000212700021270000000350104577721516021727 0ustar cammcamm% load in the prog_logic library. % load_library `prog_logic88`;; % Define the action symbols in terms of antiquotation. % let mk_plus (lhs,rhs) = "^lhs + ^rhs";; let mk_minus (lhs,rhs) = "^lhs - ^rhs";; let mk_mult (lhs,rhs) = "^lhs * ^rhs";; let mk_neq (lhs,rhs) = "~(^lhs = ^rhs)";; let mk_gt (lhs,rhs) = "^lhs > ^rhs";; let mk_gte (lhs,rhs) = "^lhs >= ^rhs";; let mk_lt (lhs,rhs) = "^lhs < ^rhs";; let mk_lte (lhs,rhs) = "^lhs <= ^rhs";; let mk_seq (lhs,rhs) = "MK_SEQ(^lhs,^rhs)";; let mk_assign (lhs,rhs) = "MK_ASSIGN(^lhs,^rhs)";; let mk_while (cond,com) = "MK_WHILE(^cond,^com)";; let mk_if1 (cond,com) = "MK_IF1(^cond,^com)";; let mk_if2 (cond,com1,com2) = "MK_IF2(^cond,^com1,^com2)";; let mk_assert (thing) = "MK_ASSERT (^thing)";; let mk_variant (thing) = "MK_VARIANT (^thing)";; let mk_invariant (thing) = "MK_INVARIANT (^thing)";; let mk_spec (P,C,Q) = "MK_SPEC(^P,^C,^Q)";; let mk_t_spec (P,C,Q) = "T_SPEC(^P,^C,^Q)";; % Take a HOL expression (term), and convert to its semantic representation. % let mk_semantic (expr) = trans_term "s:string->num" expr;; % Make the various primitive parts of the terms in question. % let mk_variable_name (var) = if mem (hd (explode var)) (words `1 2 3 4 5 6 7 8 9 0`) then failwith `ERROR: integers not allowed as variable names.` else mk_const((concatl [`\``;var;`\``]),":string");; let is_int (thing) = if can int_of_string thing then mk_const (thing,":num") else failwith (concat `ERROR: ` (concat thing ` is not a :num.`));; let mk_variable (var) = if mem var [`T`;`F`] then failwith (concat `ERROR: ` (concat var ` cannot be a variable of type ":num".`)) else if mem (hd (explode var)) (words `1 2 3 4 5 6 7 8 9 0`) then is_int (var) else mk_var(var,":num");; hol88-2.02.19940316/Library/parser/Examples/tiny/tiny_decls.ml0000640000212700021270000001250504577715701022074 0ustar cammcammFIRST_CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0`;; CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 _`;; letref logical_1 (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref logical_expr (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref possible_paren (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref rest_of_expression (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref expression (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref rest_of_bool (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref bool_1 (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref poss_rest_of_bool (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref bool_expr (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref assignment_stmnt (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref more_if_stmnts (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref rest_of_if (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref rest_of_while (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref MAIN_LOOP (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref is_spec (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref many_expr_logical (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref more_stmnts (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref many_stmnts (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref meta_logical_stmnt (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref a_stmnt (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letrec TOKEN_1 TOKENS CHARS = if null TOKENS then () else if mem (hd TOKENS) CHARS then TOKEN_1 (tl TOKENS) CHARS else fail;; let TOKEN TOKENS FIRST_CHARS CHARS next expected = if mem (hd TOKENS) FIRST_CHARS then (TOKEN_1 (tl TOKENS) CHARS; let wrd = implode TOKENS in if expected = `nil` then wrd else if expected = next then wrd else fail) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/user_guide/0000750000212700021270000000000005227256712020544 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/user_guide/blocks/0000750000212700021270000000000005227256772022027 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/user_guide/blocks/blocks.ml0000640000212700021270000000433404577523105023635 0ustar cammcammMAIN_LOOP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MAIN_LOOP`,expected,WORD); (let (foo_0 , result_list , prev, lst) = foo lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push foo_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `nil` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in do_return result_list whitespace `MAIN_LOOP` WORD lst expected);; let PARSE_file (in_file,whitespace,separators) = let white = if null whitespace then [` `;`\T`;`\L`] else whitespace and inf = open_file `in` in_file in let WORD = e_w_s inf (hd white) white in let lst = read_input inf [] white separators WORD IGNORE USEFUL in let (WORD,lst) = (hd lst,tl lst) in let result = fst (MAIN_LOOP lst (hd white) WORD [] FIRST_CHARS CHARS `nil`) in result ? fail;; let PARSE_text (text,whitespace,separators) = let outf = open_file `out` `/tmp/.000HOL` in write_string text outf; close_file outf; let result = PARSE_file (`/tmp/.000HOL`,whitespace,separators) in unlink `/tmp/.000HOL`; result;; foo:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`foo`,expected,WORD); if WORD = `'` then (let (WORD,lst) = gnt lst whitespace whitespace in let TOKENS = explode WORD in let WORD_0 = WORD in let tmp_1 = print_string(WORD_0) in let result_list = push tmp_1 result_list in let (WORD,lst) = gnt lst whitespace whitespace in let (WORD,lst) = eat_terminal `'` WORD lst `foo` in let TOKENS = explode WORD in let (foo_1 , result_list , prev, lst) = foo lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push foo_1 result_list in do_return result_list whitespace `foo` prev lst `nil`) else fail ? (do_return result_list whitespace `foo` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/user_guide/blocks/blocks.grm0000640000212700021270000000016304577520176024013 0ustar cammcammUSEFUL [(`'`,`'`)]. IGNORE [(`"`,`"`)]. MAIN_LOOP --> foo [EOF]. foo --> ['] {print_string(WORD)} ['] foo | []. hol88-2.02.19940316/Library/parser/Examples/user_guide/blocks/loader.ml0000640000212700021270000000044404577523073023630 0ustar cammcamm% Generated parser load file First load some basic definitions: % loadf `/usr/users/jvt/HOL/CHEOPS/Parser/ml/general`;; % Insert any other files you want loaded here: % % Now load the declarations: % loadf `blocks_decls`;; % Finally load in the function definitions: % loadf `blocks`;; hol88-2.02.19940316/Library/parser/Examples/user_guide/blocks/blocks_decls.ml0000640000212700021270000000076604577523105025014 0ustar cammcammUSEFUL := [(`'`,`'`)];; IGNORE := [(`"`,`"`)];; letref MAIN_LOOP (lst:string list) (whitespace:string)(prev:string) (result_list:void list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:void,fail:void list,fail:string,fail:string list);; letref foo (lst:string list) (whitespace:string)(prev:string) (result_list:void list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:void,fail:void list,fail:string,fail:string list);; hol88-2.02.19940316/Library/parser/Examples/user_guide/blocks/Makefile0000640000212700021270000000144404577523101023461 0ustar cammcamm# Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol_12/hol # General definitions for all generated parsers: GENERAL=/usr/users/jvt/HOL/CHEOPS/Parser/ml/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. # Now compile the declarations: blocks_decls_ml.o: blocks_decls.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `blocks_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions blocks_ml.o: blocks.ml blocks_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `blocks_decls`;;'\ 'compilet `blocks`;;'\ 'quit();;' | $(HOL) all: blocks_ml.o @echo '===> Parser "blocks" built.' hol88-2.02.19940316/Library/parser/Examples/user_guide/bool/0000750000212700021270000000000005227257076021503 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/user_guide/bool/bool.grm0000640000212700021270000000072304602452716023142 0ustar cammcammFIRST_CHARS `a b`. CHARS `a b c d`. term --> [CONJ] {mk_conj(term,term)} | [DISJ] {mk_disj(term,term)} | [NEG] {mk_neg(term)} | [IMP] {mk_imp(term,term)} | {mk_var(TOKEN,":bool")}. eof --> [EOF]. conj --> [CONJ] {mk_conj(term,term)} eof. disj --> [DISJ] {mk_disj(term,term)} eof. neg --> [NEG] {mk_neg(term)} eof. imp --> [IMP] {mk_imp(term,term)} eof. MAIN_LOOP --> conj | disj | neg | imp. hol88-2.02.19940316/Library/parser/Examples/user_guide/bool/loader.ml0000640000212700021270000000044004577413614023301 0ustar cammcamm% Generated parser load file First load some basic definitions: % loadf `/usr/users/jvt/HOL/CHEOPS/Parser/ml/general`;; % Insert any other files you want loaded here: % % Now load the declarations: % loadf `bool_decls`;; % Finally load in the function definitions: % loadf `bool`;; hol88-2.02.19940316/Library/parser/Examples/user_guide/bool/bool.ml0000640000212700021270000001660204577413622022774 0ustar cammcammterm:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`term`,expected,WORD); if WORD = `CONJ` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (term_1 , result_list , prev, lst) = term lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_conj(term_0,term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `term` prev lst `nil`) else fail ? if WORD = `DISJ` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (term_1 , result_list , prev, lst) = term lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_disj(term_0,term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `term` prev lst `nil`) else fail ? if WORD = `NOT` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_1 = mk_neg(term_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `term` prev lst `nil`) else fail ? if WORD = `IMP` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (term_1 , result_list , prev, lst) = term lst whitespace prev result_list FIRST_CHARS CHARS expected in let tmp_2 = mk_imp(term_0,term_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `term` prev lst `nil`) else fail ? (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = mk_var(TOKEN_0,":bool") in let result_list = push tmp_1 result_list in do_return result_list whitespace `term` whitespace lst `nil`);; eof:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`eof`,expected,WORD); if WORD = `nil` then (do_return result_list whitespace `eof` `nil` lst expected) else fail ? fail;; conj:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`conj`,expected,WORD); if WORD = `CONJ` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (term_1 , result_list , prev, lst) = term lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_conj(term_0,term_1) in let result_list = push tmp_2 result_list in let (eof_2 , result_list , prev, lst) = eof lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push eof_2 result_list in do_return result_list whitespace `conj` prev lst `nil`) else fail ? fail;; disj:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`disj`,expected,WORD); if WORD = `DISJ` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (term_1 , result_list , prev, lst) = term lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_disj(term_0,term_1) in let result_list = push tmp_2 result_list in let (eof_2 , result_list , prev, lst) = eof lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push eof_2 result_list in do_return result_list whitespace `disj` prev lst `nil`) else fail ? fail;; neg:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`neg`,expected,WORD); if WORD = `NEG` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_1 = mk_neg(term_0) in let result_list = push tmp_1 result_list in let (eof_1 , result_list , prev, lst) = eof lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push eof_1 result_list in do_return result_list whitespace `neg` prev lst `nil`) else fail ? fail;; imp:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`imp`,expected,WORD); if WORD = `IMP` then (let (term_0 , result_list , prev, lst) = term lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let (term_1 , result_list , prev, lst) = term lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let tmp_2 = mk_imp(term_0,term_1) in let result_list = push tmp_2 result_list in let (eof_2 , result_list , prev, lst) = eof lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push eof_2 result_list in do_return result_list whitespace `imp` prev lst `nil`) else fail ? fail;; MAIN_LOOP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MAIN_LOOP`,expected,WORD); (let (conj_0 , result_list , prev, lst) = conj lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push conj_0 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`) ? (let (disj_0 , result_list , prev, lst) = disj lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push disj_0 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`) ? (let (neg_0 , result_list , prev, lst) = neg lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push neg_0 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`) ? (let (imp_0 , result_list , prev, lst) = imp lst whitespace WORD result_list FIRST_CHARS CHARS expected in let result_list = push imp_0 result_list in do_return result_list whitespace `MAIN_LOOP` prev lst `nil`);; let PARSE_file (in_file,whitespace,separators) = let white = if null whitespace then [` `;`\T`;`\L`] else whitespace and inf = open_file `in` in_file in let WORD = e_w_s inf (hd white) white in let lst = read_input inf [] white separators WORD IGNORE USEFUL in let (WORD,lst) = (hd lst,tl lst) in let result = fst (MAIN_LOOP lst (hd white) WORD [] FIRST_CHARS CHARS `nil`) in result ? fail;; let PARSE_text (text,whitespace,separators) = let outf = open_file `out` `/tmp/.000HOL` in write_string text outf; close_file outf; let result = PARSE_file (`/tmp/.000HOL`,whitespace,separators) in unlink `/tmp/.000HOL`; result;; hol88-2.02.19940316/Library/parser/Examples/user_guide/bool/bool_decls.ml0000640000212700021270000000405504577413622024145 0ustar cammcammFIRST_CHARS := words `a b`;; CHARS := words `a b c d`;; letref term (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref eof (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref conj (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref disj (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref neg (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref imp (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letref MAIN_LOOP (lst:string list) (whitespace:string)(prev:string) (result_list:term list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:term,fail:term list,fail:string,fail:string list);; letrec TOKEN_1 TOKENS CHARS = if null TOKENS then () else if mem (hd TOKENS) CHARS then TOKEN_1 (tl TOKENS) CHARS else fail;; let TOKEN TOKENS FIRST_CHARS CHARS next expected = if mem (hd TOKENS) FIRST_CHARS then (TOKEN_1 (tl TOKENS) CHARS; let wrd = implode TOKENS in if expected = `nil` then wrd else if expected = next then wrd else fail) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/user_guide/bool/Makefile0000640000212700021270000000142004577413614023140 0ustar cammcamm# Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol_12/hol # General definitions for all generated parsers: GENERAL=/usr/users/jvt/HOL/CHEOPS/Parser/ml/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. # Now compile the declarations: bool_decls_ml.o: bool_decls.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `bool_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions bool_ml.o: bool.ml bool_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `bool_decls`;;'\ 'compilet `bool`;;'\ 'quit();;' | $(HOL) all: bool_ml.o @echo '===> Parser "bool" built.' hol88-2.02.19940316/Library/parser/Examples/user_guide/types/0000750000212700021270000000000005227257162021710 5ustar cammcammhol88-2.02.19940316/Library/parser/Examples/user_guide/types/Makefile0000640000212700021270000000201204577424641023351 0ustar cammcamm# Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol_12/hol # General definitions for all generated parsers: GENERAL=/usr/users/jvt/HOL/CHEOPS/Parser/ml/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. types_help_ml.o: types_help.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `types_help`;;'\ 'quit();;' | $(HOL) # Now compile the declarations: types_decls_ml.o: types_decls.ml types_help_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `types_help`;;'\ 'compilet `types_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions types_ml.o: types.ml types_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `types_help`;;'\ 'loadf `types_decls`;;'\ 'compilet `types`;;'\ 'quit();;' | $(HOL) all: types_ml.o @echo '===> Parser "types" built.' hol88-2.02.19940316/Library/parser/Examples/user_guide/types/loader.ml0000640000212700021270000000073304573732234023515 0ustar cammcamm% Generated parser load file First load some basic definitions: % loadf `/usr/users/jvt/HOL/CHEOPS/Parser/ml/general`;; % Insert any other files you want loaded here: % loadf `types_help`;; % Now load the declarations: % loadf `types_decls`;; % Finally load in the function definitions: % loadf `types`;; let SEPS = [(`(`,[]);(`)`,[]);(`#`,[]);(`-`,[`>`]);(`+`,[]);(`,`,[])];; let parse thing = hd (PARSE_text(thing,[],SEPS));; new_syntax_block(`<<`,`>>`,`parse`);; hol88-2.02.19940316/Library/parser/Examples/user_guide/types/types.grm0000640000212700021270000000274204577443163023576 0ustar cammcammFIRST_CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *`. CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 *`. tyname --> {mk_type_name(TOKEN)}. tyvar --> {mk_type_var(TOKEN)}. MAIN_LOOP --> typ [EOF]. typ --> type1 more_type. more_type --> [#] {add_to_list(type1,POP)} more_prod_type sum_or_fun_type | [->] {MK_bin_type(`fun`,POP,typ)} | [+] type1 more_sum_type fun_type | []. more_prod_type --> [#] {add_to_list(type1,POP)} more_prod_type | {MK_defd_type(POP,`prod`)}. sum_or_fun_type --> [+] {MK_bin_type(`sum`,POP,typ)} | [->] {MK_bin_type(`fun`,POP,typ)} | []. more_sum_type --> [+] {add_to_list_rev(POP,POP)} type1 more_sum_type | [#] {add_to_list(type1,POP)} more_prod_type more_sum_type | {add_to_list_rev(POP,POP)} {MK_defd_type(POP,`sum`)}. fun_type --> [->] {MK_bin_type(`fun`,POP,typ)} | []. type1 --> [(] typ poss_cmpnd_type | tyname more_type1 | tyvar more_type1. poss_cmpnd_type --> [)] more_type1 | [,] {add_to_list(POP,typ)} rest_of_cmpnd. rest_of_cmpnd --> [,] {add_to_list(POP,typ)} rest_of_cmpnd | [)] {MK_type(POP,TOKEN)} more_type1. more_type1 --> {MK_type(POP,TOKEN)} more_type1 | []. hol88-2.02.19940316/Library/parser/Examples/user_guide/types/types.ml0000640000212700021270000003671005034371576023420 0ustar cammcammtyname:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`tyname`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = mk_type_name(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `tyname` whitespace lst `nil`);; tyvar:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`tyvar`,expected,WORD); (let TOKEN_0 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) expected in let tmp_1 = mk_type_var(TOKEN_0) in let result_list = push tmp_1 result_list in do_return result_list whitespace `tyvar` whitespace lst `nil`);; MAIN_LOOP:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`MAIN_LOOP`,expected,WORD); (let (typ_0 , result_list , prev, lst) = typ lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push typ_0 result_list in let (WORD,lst) = gnt lst whitespace prev in let (WORD,lst) = eat_terminal `nil` WORD lst `MAIN_LOOP` in let TOKENS = explode WORD in do_return result_list whitespace `MAIN_LOOP` WORD lst expected);; let PARSE_file (in_file,whitespace,separators) = let white = if null whitespace then [` `;`\T`;`\L`] else whitespace and inf = open_file `in` in_file in let WORD = e_w_s inf (hd white) white in let lst = read_input inf [] white separators WORD IGNORE USEFUL in let (WORD,lst) = (hd lst,tl lst) in let result = fst (MAIN_LOOP lst (hd white) WORD [] FIRST_CHARS CHARS `nil`) in result ? fail;; let PARSE_text (text,whitespace,separators) = let outf = open_file `out` `/tmp/.000HOL` in write_string text outf; close_file outf; let result = PARSE_file (`/tmp/.000HOL`,whitespace,separators) in unlink `/tmp/.000HOL`; result;; typ:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`typ`,expected,WORD); (let (type1_0 , result_list , prev, lst) = type1 lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push type1_0 result_list in let (more_type_1 , result_list , prev, lst) = more_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_type_1 result_list in do_return result_list whitespace `typ` prev lst `nil`);; more_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_type`,expected,WORD); if WORD = `#` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(type1_0,POP_1) in let result_list = push tmp_2 result_list in let (more_prod_type_2 , result_list , prev, lst) = more_prod_type lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push more_prod_type_2 result_list in let (sum_or_fun_type_3 , result_list , prev, lst) = sum_or_fun_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push sum_or_fun_type_3 result_list in do_return result_list whitespace `more_type` prev lst `nil`) else fail ? if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`fun`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `more_type` prev lst `nil`) else fail ? if WORD = `+` then (let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push type1_0 result_list in let (more_sum_type_1 , result_list , prev, lst) = more_sum_type lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push more_sum_type_1 result_list in let (fun_type_2 , result_list , prev, lst) = fun_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push fun_type_2 result_list in do_return result_list whitespace `more_type` prev lst `nil`) else fail ? (do_return result_list whitespace `more_type` WORD lst expected);; more_prod_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_prod_type`,expected,WORD); if WORD = `#` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(type1_0,POP_1) in let result_list = push tmp_2 result_list in let (more_prod_type_2 , result_list , prev, lst) = more_prod_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_prod_type_2 result_list in do_return result_list whitespace `more_prod_type` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let tmp_1 = MK_defd_type(POP_0,`prod`) in let result_list = push tmp_1 result_list in do_return result_list whitespace `more_prod_type` WORD lst expected);; sum_or_fun_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`sum_or_fun_type`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`sum`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `sum_or_fun_type` prev lst `nil`) else fail ? if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`fun`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `sum_or_fun_type` prev lst `nil`) else fail ? (do_return result_list whitespace `sum_or_fun_type` WORD lst expected);; more_sum_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_sum_type`,expected,WORD); if WORD = `+` then (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = add_to_list_rev(POP_0,POP_1) in let result_list = push tmp_2 result_list in let (type1_2 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push type1_2 result_list in let (more_sum_type_3 , result_list , prev, lst) = more_sum_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_sum_type_3 result_list in do_return result_list whitespace `more_sum_type` prev lst `nil`) else fail ? if WORD = `#` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_1 , pop_list ) = (pop pop_list) in let (type1_0 , result_list , prev, lst) = type1 lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(type1_0,POP_1) in let result_list = push tmp_2 result_list in let (more_prod_type_2 , result_list , prev, lst) = more_prod_type lst whitespace prev result_list FIRST_CHARS CHARS `nil` in let result_list = push more_prod_type_2 result_list in let (more_sum_type_3 , result_list , prev, lst) = more_sum_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_sum_type_3 result_list in do_return result_list whitespace `more_sum_type` prev lst `nil`) else fail ? (let (result_list,pop_list) = chop_off 2 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (POP_1 , pop_list ) = (pop pop_list) in let tmp_2 = add_to_list_rev(POP_0,POP_1) in let result_list = push tmp_2 result_list in let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_2 , pop_list ) = (pop pop_list) in let tmp_3 = MK_defd_type(POP_2,`sum`) in let result_list = push tmp_3 result_list in do_return result_list whitespace `more_sum_type` WORD lst expected);; fun_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`fun_type`,expected,WORD); if WORD = `->` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let tmp_2 = MK_bin_type(`fun`,POP_0,typ_1) in let result_list = push tmp_2 result_list in do_return result_list whitespace `fun_type` prev lst `nil`) else fail ? (do_return result_list whitespace `fun_type` WORD lst expected);; type1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`type1`,expected,WORD); if WORD = `(` then (let (typ_0 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let result_list = push typ_0 result_list in let (poss_cmpnd_type_1 , result_list , prev, lst) = poss_cmpnd_type lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push poss_cmpnd_type_1 result_list in do_return result_list whitespace `type1` prev lst `nil`) else fail ? (let (tyname_0 , result_list , prev, lst) = tyname lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push tyname_0 result_list in let (more_type1_1 , result_list , prev, lst) = more_type1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_1 result_list in do_return result_list whitespace `type1` prev lst `nil`) ? (let (tyvar_0 , result_list , prev, lst) = tyvar lst whitespace WORD result_list FIRST_CHARS CHARS `nil` in let result_list = push tyvar_0 result_list in let (more_type1_1 , result_list , prev, lst) = more_type1 lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_1 result_list in do_return result_list whitespace `type1` prev lst `nil`);; poss_cmpnd_type:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`poss_cmpnd_type`,expected,WORD); if WORD = `)` then (let (more_type1_0 , result_list , prev, lst) = more_type1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_0 result_list in do_return result_list whitespace `poss_cmpnd_type` prev lst `nil`) else fail ? if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,typ_1) in let result_list = push tmp_2 result_list in let (rest_of_cmpnd_2 , result_list , prev, lst) = rest_of_cmpnd lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_cmpnd_2 result_list in do_return result_list whitespace `poss_cmpnd_type` prev lst `nil`) else fail ? fail;; rest_of_cmpnd:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`rest_of_cmpnd`,expected,WORD); if WORD = `,` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (typ_1 , result_list , prev, lst) = typ lst whitespace whitespace result_list FIRST_CHARS CHARS `nil` in let tmp_2 = add_to_list(POP_0,typ_1) in let result_list = push tmp_2 result_list in let (rest_of_cmpnd_2 , result_list , prev, lst) = rest_of_cmpnd lst whitespace prev result_list FIRST_CHARS CHARS expected in let result_list = push rest_of_cmpnd_2 result_list in do_return result_list whitespace `rest_of_cmpnd` prev lst `nil`) else fail ? if WORD = `)` then (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let (WORD,lst) = gnt lst whitespace whitespace in let TOKENS = explode WORD in let TOKEN_1 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_2 = MK_cmpnd_type(POP_0,TOKEN_1) in let result_list = push tmp_2 result_list in let (more_type1_2 , result_list , prev, lst) = more_type1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_2 result_list in do_return result_list whitespace `rest_of_cmpnd` prev lst `nil`) else fail ? fail;; more_type1:= \lst whitespace prev result_list FIRST_CHARS CHARS expected. let (WORD,lst) = gnt lst whitespace prev in let TOKENS = explode WORD in debug_enter(`more_type1`,expected,WORD); (let (result_list,pop_list) = chop_off 1 [] result_list in let (POP_0 , pop_list ) = (pop pop_list) in let TOKEN_1 = TOKEN TOKENS FIRST_CHARS CHARS (hd lst) `nil` in let tmp_2 = MK_type(POP_0,TOKEN_1) in let result_list = push tmp_2 result_list in let (more_type1_2 , result_list , prev, lst) = more_type1 lst whitespace whitespace result_list FIRST_CHARS CHARS expected in let result_list = push more_type1_2 result_list in do_return result_list whitespace `more_type1` prev lst `nil`) ? (do_return result_list whitespace `more_type1` WORD lst expected);; hol88-2.02.19940316/Library/parser/Examples/user_guide/types/types_help.ml0000640000212700021270000000077404577443203024427 0ustar cammcammlet mk_type_name thing = [mk_type(thing,[])] and mk_type_var thing = [mk_vartype thing] and add_to_list (lst,thing) = append lst thing and add_to_list_rev (lst,thing) = append thing lst and MK_type(lst,op) = [mk_type(op,lst)] and MK_bin_type(op,type1,typ) = [mk_type(op,(append type1 typ))];; letrec fix_defd(lst,op,result) = if null lst then result else fix_defd(tl lst,op,mk_type(op,[hd lst;result]));; let MK_defd_type(lst,op) = [fix_defd(tl (tl lst),op,mk_type(op,[hd (tl lst);hd lst]))];; hol88-2.02.19940316/Library/parser/Examples/user_guide/types/types_decls.ml0000640000212700021270000000757704577424052024602 0ustar cammcammFIRST_CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *`;; CHARS := words `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 *`;; letref tyname (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref tyvar (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref MAIN_LOOP (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref typ (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref more_type (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref more_prod_type (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref sum_or_fun_type (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref more_sum_type (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref fun_type (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref type1 (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref poss_cmpnd_type (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref rest_of_cmpnd (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letref more_type1 (lst:string list) (whitespace:string)(prev:string) (result_list:type list list) (FIRST_CHARS:string list) (CHARS:string list) (expected:string) = (fail:type list,fail:type list list,fail:string,fail:string list);; letrec TOKEN_1 TOKENS CHARS = if null TOKENS then () else if mem (hd TOKENS) CHARS then TOKEN_1 (tl TOKENS) CHARS else fail;; let TOKEN TOKENS FIRST_CHARS CHARS next expected = if mem (hd TOKENS) FIRST_CHARS then (TOKEN_1 (tl TOKENS) CHARS; let wrd = implode TOKENS in if expected = `nil` then wrd else if expected = next then wrd else fail) else fail ? fail;; hol88-2.02.19940316/Library/parser/Examples/user_guide/READ-ME0000640000212700021270000000013104577722001021471 0ustar cammcammThe subdirectories below contain the examples used in the parser-generator's user guide. hol88-2.02.19940316/Library/parser/help/0000750000212700021270000000000005227250247015560 5ustar cammcammhol88-2.02.19940316/Library/parser/help/entries/0000750000212700021270000000000005227257310017227 5ustar cammcammhol88-2.02.19940316/Library/parser/help/entries/parse.doc0000640000212700021270000000132204727177146021043 0ustar cammcamm\DOC parse \TYPE {parse : (* -> void)} \SYNOPSIS Top-level function to invoke the parser-generator. \DESCRIBE The function invokes the parser-generator. The generator prompts for various input files and types. \FAILURE Fails if there is an error in the input grammar that specifies the operation of the parser to be generated. A descriptive message is produced to help pinpoint the cause of the failure. \EXAMPLE { #parse();; Input file: foo.grm Output file: foo Opening the file foo.ml (MAIN OUTPUT) Opening the file foo_decls.ml (DECLARATIONS) Load the declarations file before the main output. See the file foo_load.ml for a sample. See the file ./Makefile.foo for a sample Makefile. Output type: * } \ENDDOC hol88-2.02.19940316/Library/parser/Manual/0000750000212700021270000000000005535604567016057 5ustar cammcammhol88-2.02.19940316/Library/parser/Manual/parser.tex0000640000212700021270000000500605104522372020060 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: parser-generator % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{description} % --------------------------------------------------------------------- % Reference manual entries for functions % --------------------------------------------------------------------- \include{entries} % --------------------------------------------------------------------- % Listing of theorems % --------------------------------------------------------------------- \include{theorems} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/parser/Manual/parser.log0000640000212700021270000000655305535604607020063 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:12 **parser.tex (parser.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) \@indexfile=\write3 Writing index file parser.idx (parser.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) (title.tex [1 ] [2]) (parser.toc) \tf@toc=\write4 [3 ] [4 ] (description.tex Chapter 1. [1 ] [2] Underfull \vbox (badness 10000) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 11.16724 .\glue(\topskip) 0.0 .\hbox(102.18983+96.71486)x455.24408, glue set 0.1fil ..\hbox(0.0+0.0)x0.0 ..\glue 0.0 ..\hbox(0.0+0.0)x0.0 ...\glue 0.0 ...\glue 0.0 ...\glue 0.0 ...\glue -5.87494 ...\hbox(0.0+0.0)x0.0 ...etc. ..\penalty 0 ..\hbox(102.18983+96.71486)x455.04408 ...\mathon ...\vbox(102.18983+96.71486)x455.04408 [] ...\mathoff ..etc. .\penalty -51 .\glue 10.0 plus 4.0 minus 6.0 .\glue(\parskip) 0.0 plus 1.0 .etc. [3] [4] [5] [6] [7] [8] [9] [10] [11] Underfull \vbox (badness 1221) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 2.30466 .\glue(\topskip) 3.66669 .\hbox(8.33331+2.33331)x455.24408, glue set 0.08017 ..\hbox(0.0+0.0)x11.38109 ..\twlrm T ..\twlrm h ..\twlrm e ..\glue 3.91663 plus 1.95831 minus 1.30554 ..etc. .\penalty 10000 .\glue(\baselineskip) 3.83337 .\hbox(8.33331+2.33331)x455.24408, glue set - 0.60144 ..\twlrm t ..\twlrm h ..\twlrm e ..\glue 3.91663 plus 1.95831 minus 1.30554 ..\twlrm B ..etc. .etc. [12] [13] Underfull \vbox (badness 10000) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 10.69527 .\glue(\topskip) 0.0 .\hbox(233.30553+227.30551)x455.24408, glue set 0.1fil ..\hbox(0.0+0.0)x0.0 ..\glue 0.0 ..\hbox(0.0+0.0)x0.0 ...\glue 0.0 ...\glue 0.0 ...\glue 0.0 ...\glue -5.87494 ...\hbox(0.0+0.0)x0.0 ...etc. ..\penalty 0 ..\hbox(233.30553+227.30551)x455.04408 ...\mathon ...\vbox(233.30553+227.30551)x455.04408 [] ...\mathoff ..etc. .\penalty -51 .\glue 10.0 plus 4.0 minus 6.0 .\glue -10.0 plus -4.0 minus -6.0 .etc. [14] [15] [16] [17]) [18] (entries.tex Chapter 2. (entries-intro.tex)) [19 ] (theorems.tex [20 ] Chapter 3. ) [21] (references.tex [22 ]) [23] (index.tex [24 ]) (parser.aux (title.aux) (description.aux) (entries.aux) (theorems.aux) (references.aux) (index.aux)) ) Here is how much of TeX's memory you used: 468 strings out of 11977 3878 string characters out of 87025 41270 words of memory out of 262141 2294 multiletter control sequences out of 9500 19472 words of font info for 74 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 18i,15n,17p,188b,602s stack positions out of 300i,100n,60p,3000b,4000s Output written on parser.dvi (28 pages, 58336 bytes). hol88-2.02.19940316/Library/parser/Manual/parser.idx0000640000212700021270000000611505535604607020060 0ustar cammcamm\indexentry{FIRST\_CHARS@{\ptt FIRST\_CHARS}}{2} \indexentry{CHARS@{\ptt CHARS}}{2} \indexentry{MAIN\_LOOP@{\ptt MAIN\_LOOP}}{2} \indexentry{EOF@{\ptt EOF}}{2} \indexentry{parse@{\ptt parse}}{2} \indexentry{MAIN\_LOOP@{\ptt MAIN\_LOOP}}{3} \indexentry{PARSE\_text@{\ptt PARSE\_text}}{3} \indexentry{PARSE\_file@{\ptt PARSE\_file}}{3} \indexentry{PARSE\_text@{\ptt PARSE\_text}}{5} \indexentry{PARSE\_text@{\ptt PARSE\_text}}{5} \indexentry{errors@error\ messages}{5} \indexentry{debugging@debugging}{5} \indexentry{debug\_on@{\ptt debug\_on}}{5} \indexentry{debug\_off@{\ptt debug\_off}}{5} \indexentry{errors@error\ messages}{6} \indexentry{POP@{\ptt POP}}{7} \indexentry{MAIN\_LOOP@{\ptt MAIN\_LOOP}}{7} \indexentry{EOF@{\ptt EOF}}{7} \indexentry{POP@{\ptt POP}}{8} \indexentry{TOKEN@{\ptt TOKEN}}{8} \indexentry{WORD@{\ptt WORD}}{8} \indexentry{FIRST\_CHARS@{\ptt FIRST\_CHARS}}{8} \indexentry{CHARS@{\ptt CHARS}}{8} \indexentry{FIRST\_CHARS@{\ptt FIRST\_CHARS} }{8} \indexentry{CHARS@{\ptt CHARS}}{8} \indexentry{USEFUL@{\ptt USEFUL}}{8} \indexentry{IGNORE@{\ptt IGNORE}}{8} \indexentry{PARSE\_file@{\ptt PARSE\_file}}{8} \indexentry{MAIN\_LOOP@{\ptt MAIN\_LOOP}}{8} \indexentry{PARSE\_text@{\ptt PARSE\_text}}{9} \indexentry{MAIN\_LOOP@{\ptt MAIN\_LOOP}}{9} \indexentry{PARSE\_file@{\ptt PARSE\_file}}{9} \indexentry{TOKEN@{\ptt TOKEN}}{9} \indexentry{TOKEN\_1@{\ptt TOKEN\_1}}{9} \indexentry{chop\_off@{\ptt chop\_off}}{9} \indexentry{close\_file@{\ptt close\_file}}{9} \indexentry{complete\_separator@{\ptt complete\_separator}}{9} \indexentry{debug\_enter@{\ptt debug\_enter}}{9} \indexentry{debug\_off@{\ptt debug\_off}}{9} \indexentry{debug\_on@{\ptt debug\_on}}{9} \indexentry{debug\_return@{\ptt debug\_return}}{9} \indexentry{determine\_lst@{\ptt deterimine\_lst}}{9} \indexentry{do\_return@{\ptt do\_return}}{9} \indexentry{do\_return\_1@{\ptt do\_return\_1}}{9} \indexentry{eat\_terminal@{\ptt eat\_terminal}}{9} \indexentry{e\_w\_w@{\ptt e\_w\_s}}{9} \indexentry{e\_w\_s\_ok@{\ptt e\_w\_s\_ok}}{9} \indexentry{get\_word@{\ptt get\_word}}{9} \indexentry{get\_word1@{\ptt get\_word1}}{9} \indexentry{get\_word2@{\ptt get\_word2}}{9} \indexentry{gnt@{\ptt gnt}}{9} \indexentry{open\_file@{\ptt open\_file}}{9} \indexentry{pop@{\ptt pop}}{9} \indexentry{push@{\ptt push}}{9} \indexentry{read\_char@{\ptt read\_char}}{9} \indexentry{read\_input@{\ptt read\_input}}{9} \indexentry{write\_string@{\ptt write\_string}}{9} \indexentry{action@{action\ symbols}}{9} \indexentry{TOKEN@{\ptt TOKEN}}{9} \indexentry{FIRST\_CHARS@{\ptt FIRST\_CHARS}}{9} \indexentry{CHARS@{\ptt CHARS}}{9} \indexentry{TOKEN@{\ptt TOKEN}}{10} \indexentry{POP@{\ptt POP}}{10} \indexentry{POP@{\ptt POP}}{10} \indexentry{POP@{\ptt POP}}{10} \indexentry{TOKEN@{\ptt TOKEN}}{10} \indexentry{errors@error\ messages}{10} \indexentry{parse@{\ptt parse}}{13} \indexentry{PARSE\_text@{\ptt PARSE\_text}}{13} \indexentry{IGNORE@{\ptt IGNORE}}{15} \indexentry{USEFUL@{\ptt USEFUL}}{15} \indexentry{USEFUL@{\ptt USEFUL}}{16} \indexentry{IGNORE@{\ptt IGNORE}}{16} \indexentry{USEFUL@{\ptt USEFUL}}{16} \indexentry{IGNORE@{\ptt IGNORE}}{16} \indexentry{parse@{\ptt parse}}{19} hol88-2.02.19940316/Library/parser/Manual/parser.aux0000640000212700021270000000021205535604607020061 0ustar cammcamm\relax \@input{title.aux} \@input{description.aux} \@input{entries.aux} \@input{theorems.aux} \@input{references.aux} \@input{index.aux} hol88-2.02.19940316/Library/parser/Manual/title.aux0000640000212700021270000000077305535604575017726 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/parser/Manual/parser.dvi0000640000212700021270000016174005535604607020064 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1012‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘[dyóHò"VáG cmbx10ëHThe– ‰‹HOL“parser“LibraryŽŸI­Û’¼Z³ó7ò"Vff cmbx10âJ.–…P›þž¸.“V˜an“T˜asselŽ „ÃÒ‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’Ùú-July‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’’ðÉž£hó+X«Q cmr12ÖcŽŽŽ’8ó-!",š cmsy10Ø ŽŽŽŽ’ŸwâÖJ.–ê¨P›ÿV.“V˜an“T˜assel“1991ŽŽŽŒ‹Ó ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFLÛ1Ž‘ŸôThe–€parser“Library’>+S1ŽŽ¤‘ŸôÖ1.1Ž‘,¦JIn¬rtroSŽduction‘8É‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ16ŽŽ¡‘Ÿô1.9Ž‘,¦JThe–ê¨P¬rarser-Generating“Language‘*t‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ18ŽŽ¤¿øÛ2Ž‘ŸôML–€F‘þàunctions“in“the“parser“Library’ÔôŽ19ŽŽ¡3Ž‘ŸôPre-pro• v“ed‘€Theorems’(`ª21ŽŽ¡References’z’e23ŽŽ¡Index’˜n|24ŽŽŽŸ$ý’ðÆŸiiiŽŽŒ‹Ž ÌU ýFÓŸú™š‘êñëÛiv’‡¢eCon• ten“tsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹‹ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|ŸGëHThe– ‰‹parser“LibraryŽŸÖx‰Ç>|Ÿ:UT‘_ìó.›»ˆ@ cmti12ÙThat–35which“c›ÿffan“b˜e“c˜onc˜eive˜d“c˜an“b˜e“cr˜e˜ate˜d.‘fiÖ{–ê¨Enzo“F‘ÿVerrariŽ©(Vó<ò"VG® cmbx10ç1.1Ž‘-C„In‘ÿr°tro‘OductionŽŸâ#ÖW‘ÿVe–sAdescribšSŽe“a“generic“parser-generator“to“aid“in“the“em¬rb˜edding“of“languages“in“ó"Kñ`y ó3 cmr10ÍHOLÖ.“TheŽ¤need–E«for“suc¬rh“a“tošSŽol“is“b˜ecoming“readily“apparen¬rt“as“supp˜ort“for“v‘ÿXäarious“languages“in“ÍHOLŽ¡Öhas–#keither“bšSŽeen“implemen¬rted“or“is“in“progress.‘ã)The“parser-generator“describ˜ed“in“thisŽ¡doSŽcumen•¬rt›*öw“as˜written˜to˜ful ll˜the˜needs˜of˜v‘ÿXäarious˜pro‘§jects˜underw“a“y˜in˜the˜ComputerŽ¡LabSŽoratory–ê¨dealing“with“either“hardw¬rare“description“or“programming“languages.Ž¡‘ aThe–ȱinput“to“the“generator“is“a“form“of“moSŽdi ed“ÍBNF‘ȨÖnotation“consisting“of“terminals,Ž¡non-terminals,‘å§and–¤gaction“sym¬rbSŽols.‘Ì Users“familiar“with“the“de nite“clause“grammar“(ÍDCGÖ)Ž¡notation–jÕof“Prolog“will“see“similarities“here.‘¹fThis“input“is“not,›Šàho•¬rw“ev“er,˜a–jÕfull“attributeŽ¡grammar,‘)¨and–ma¬ry“originate“either“from“the“user's“terminal“or“a“ le.‘ÐThe“output“of“theŽ¡generator–”¦is“an“ÍML“Öprogram“that“builds“an“ob‘§ject“of“user-de ned“t¬rypSŽe“from“input“thatŽ¡meets–ê¨the“synš¬rtax“spSŽeci ed“b˜y“the“grammar.Ž¡‘ aThe–I2discussion“of“the“generator“that“folloš¬rws“will“ rst“co˜v˜er“the“syn˜tax“of“the“inputŽ¡language.‘ìlAn›Mo•¬rv“erview˜of˜the˜translation˜pro•SŽcess˜will˜then˜b“e˜deliv¬rered.‘ìlIt˜will˜b“e˜follo•¬rw“edŽ¡bš¬ry–e†a“presen˜tation“of“the“generator's“reserv˜ed“w˜ords,‘€&and“an“expSŽosition“of“the“constructionŽ¡of–Àlaction“sym¬rbSŽols.‘º-W‘ÿVe“will“conclude“with“some“extended“examples“to“demonstrate“theŽ¡use–ê¨of“the“parser-generator.Ž¦ç1.2Ž‘-C„Syn‘ÿr°taxŽŸâ#ÖThe–A}generator“is“meanš¬rt“to“deal“with“non“left-recursiv˜e“con˜text“free“grammars.‘|There“is“noŽ¡c•¬rhec“king–€¿for“left-recursion,‘¦Eand“anš¬ry“input“emplo˜ying“it“will“necessarily“cause“an“in niteŽ¡lošSŽop–’úto“b˜e“generated.‘1×Action“sym¬rb˜ols“are“then“em¬rb˜edded“in“the“grammar“to“constructŽ¡the–è9user's“semanš¬rtics“for“the“syn˜tax.‘8If“these“sym˜bSŽols“are“not“presen˜t,‘è¶a“simple“recogniserŽ¡for–ê¨the“language“in“question“will“bSŽe“created.ŽŽŸ$ý’óŸÛ1ŽŽŒ‹ÿ ÌU ýFÓŸú™š‘êñëÛ2’ÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖAs–*òan“example,‘QIif“wš¬re“wished“to“spSŽecify“a“grammar“for“a“pre x“represen˜tation“of“a“subsetŽ© ™š‘êñëof–ê¨BoSŽolean“logic,“the“folloš¬rwing“ÍBNF“Ödescription“migh˜t“bSŽe“used:ŽŸD< ‘êñëŸÐA(‰ffÇ IŸUï›ÌÍŸ}„ZffŸÕÛ„ŸÝû…‘ ÌÍÍb•MÞo“olŽ‘.V»::=Ž‘HðWterm‘¦fó%ý': ó3 cmti10ÐEOFŽŽ¤ ™™‘ ÌÍÍtermŽ‘.V»::=Ž‘HðWneg–¦fó$!",š ó3 cmsy10Ïj“Íimp“Ïj“Íconj“Ïj“Ídisj“Ïj“ÐvarŽŽ¡‘ ÌÍÍnegŽ‘.V»::=Ž‘HðWÒNEG‘¦fÍtermŽŽ¡‘ ÌÍimpŽ‘.V»::=Ž‘HðWÒIMP–¦fÍterm“termŽŽ¡‘ ÌÍconjŽ‘.V»::=Ž‘HðWÒCONJ–¦fÍterm“termŽŽ¡‘ ÌÍdisjŽ‘.V»::=Ž‘HðWÒDISJ–¦fÍterm“termŽŽŽŽŽŽ’Æq°„ZffŽŽŸzã‰ffÇ IŽŽŽŸC¢5‘êñëÖwhere–›terminal“sym¬rbšSŽols“app˜ear“in“b˜oldface,‘˜Ùvar“Örepresen¬rts“a“Bo˜olean“v‘ÿXäariable,‘˜and“ÙEOFŽ¤€‘êñëÖsho¬rws–ê¨where“the“end“of“the“input“stream“should“oSŽccur.ŽŸ¹Ù‘öSzThe›ê¨abSŽo•¬rv“e˜grammar˜ma“y˜bSŽe˜represen“ted˜as˜input˜to˜the˜parser-generator˜as˜follo“ws:ŽŸtA‘êñ럟ýó‰ffÇ I ¶vÌÍŸ}„ºŠ‚ff ÿP|”‘ÌÍó(ßê“term“[EOF].Ž¡‘ÌÍterm–¿ª-->“neg“|“imp“|“conj“|“disj“|“{mk_var(TOKEN,":bool")}.Ž¡‘ÌÍconj–¿ª-->“[CONJ]“{mk_conj(term,term)}.Ž¡‘ÌÍdisj–¿ª-->“[DISJ]“{mk_disj(term,term)}.Ž¡‘ÌÍneg–¿ª-->“[NEG]“{mk_neg(term)}.Ž¡‘ÌÍimp–¿ª-->“[IMP]“{mk_imp(term,term)}.ŽŽ’Æq°„ºŠ‚ffŽŽŸzã‰ffÇ IŽŽŽŸsåj‘êñëó1߆µT cmtt12ÜFIRST_CHARS–!DÖand›ÚÜCHARS“Öare˜declarations˜whic•¬rh˜de ne˜the˜legal˜ rst˜and˜other˜c“haractersŽ¡‘êñëof–Ž¿the“language's“idenš¬rti ers.‘ %&Within“the“grammar“itself,‘÷Åaction“sym˜bSŽols“are“enclosedŽ¡‘êñëbš¬ry–ÀÌbraces“(Ü{}Ö)“whilst“terminal“sym˜bSŽols“are“delimited“with“square“brac˜k˜ets“(Ü[]Ö),‘6UandŽ¡‘êñëconditional–Þübrancš¬rhes“are“separated“b˜y“v˜ertical“bars“(Ü|Ö).‘ÜThe“non-terminal“ÜMAIN_LOOPŽ¡‘êñëÖis–˜€a“reservš¬red“sym˜bSŽol“de ning“the“start“of“the“parser.‘BiThe“terminal“sym˜bSŽol“ÜEOF‘ 0¨Öis“alsoŽ¡‘êñëreservš¬red,‘30and–$®marks“where“the“end“of“ le“should“oSŽccur.‘æòThe“ÍBNF‘$ŸÖsyn˜tax“for“the“parser-Ž¡‘êñëgenerator's–éÉinput“language“is“proš¬rvided“in“Section“1.9,‘)’and“the“system's“reserv˜ed“w˜ordsŽ¡‘êñë(including–ê¨ÜMAIN_LOOP“Öand“ÜEOFÖ)“are“describSŽed“in“Section“1.6.ŽŸ/Û‘êñëç1.3Ž‘5oGenerating‘Ÿ¼P‘ÿr°arsersŽŸÅÕ‘êñëÖThe–°°parser-generator“ma¬ry“bšSŽe“incorp˜orated“inš¬rto“the“ÍHOL“Ösystem“b˜y“loading“in“the“libraryŽ¦‘êñëÜparserÖ.‘´FOnce–Êloaded,‘the“generator“is“in•¬rv“ok“ed›Êb“y˜the˜function˜Üparse˜Ö.‘´FCon“tin“uing˜withŽ¦‘êñëthe–RÀBoSŽolean“logic“example,‘q"the“folloš¬rwing“session“sho˜ws“ho˜w“a“parser“is“generated“from“theŽ¦‘êñëgrammar–ê¨just“spSŽeci ed.ŽŽŽŒ‹y ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €Generating‘€P arsers’/}i3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý溑ÇaŸš5͉ffÇ I ÂQÌÍŸ}„ÆÎff ÿD<@’°4N„ ׸莒°í6„¸è®dŽ’¹M±Ÿýóp®0J cmsl10È1ŽŽŽŽŸÿ@T‘ÌÍÓ#parse();;Ž¤ ‘ÌÍInput‘¿ªfile:‘ Tbool.grmŽ¡‘ÌÍOutput–¿ªfile:“boolŽ¡‘ÌÍOpening–¿ªthe“file“bool.ml“(MAIN“OUTPUT)Ž¡‘ÌÍOpening–¿ªthe“file“bool_decls.ml“(DECLARATIONS)Ž¡‘ÌÍLoad–¿ªthe“declarations“file“before“the“main“output.Ž¡‘ÌÍSee–¿ªthe“file“bool_load.ml“for“a“sample.Ž¡‘ÌÍSee–¿ªthe“file“./Makefile.bool“for“a“sample“Makefile.Ž¡‘ÌÍOutput–¿ªtype:“termŽ¤‘L!Generating–¿ªPARSE_file“and“PARSE_text“(MAIN_LOOP“used).Ž¡‘ÌÍ()–¿ª:“voidŽ¡‘ÌÍ#quit();;ŽŽ’Æq°„ÆÎffŽŽŸzã‰ffÇ IŽŽŽ «âe‘ÇaÖThe–Ngenerator“prompts“for“an“input“ le“con¬rtaining“the“grammar.‘¦ÑIt“is“assumed“that“theŽ¤€‘ÇaBošSŽolean–ñSlogic“grammar“is“found“in“the“ le“Übool.grmÖ.‘LàThe“second“ le“is“the“b˜eginning“ofŽ¡‘Çathe–ç} le“name“for“the“output“of“the“generator.‘7ÒSince“wš¬re“w˜an˜t“to“create“a“ÍHOL“Öterm“usingŽ¡‘Çathe––6generated“parser,‘Áthe“appropritate“t¬rypSŽe“is“supplied“when“prompted.‘;ŠThe“generatorŽ¡‘Çakš¬reys–é(on“the“use“of“the“non-terminal“ÜMAIN_LOOP‘ÒPÖto“construct“t˜w˜o“functions“to“in˜v˜ok˜e“theŽ¡‘Çagenerated–‹parser.‘ÜPARSE_text‘ Öallo¬rws“target“language“constructs“to“bSŽe“parsed“from“a“ÍMLŽ¡‘ÇaÖstring.‘#ÅÜPARSE_file‘V¬Öproš¬rvides–«Vthe“same“functionalit˜y“for“input“ les“con˜taining“these“sameŽ¡‘Çaob‘§jects.ŽŸg¨‘Çaâ1.3.1Ž‘E`âAuxiliary‘…FilesŽŸ,ôÚ‘ÇaÖThe–9š rst“ le“created“b¬ry“the“generator“(Übool_load.mlÖ)“is“one“that“will“load“the“parts“ofŽ¡‘Çathe–Óunewly-constructed“parser“inš¬rto“the“ÍHOL“Ösystem“in“the“propSŽer“order.‘óHIn“the“curren˜tŽ¡‘Çaexample,‘ûthere–ßare“no“user-spSŽeci ed“actions.‘ßØW‘ÿVe“therefore“ha•¬rv“e–ßno“need“to“include“an¬ry“ lesŽ¡‘Çaother– Âthan“the“ones“output“b¬ry“the“parser-generator.‘–.The“inital“ le“loaded“(Ügeneral.mlÖ)Ž¡‘Çaconš¬rtains–°functions“used“b˜y“all“generated“parsers“to“pro˜vide“basic“opSŽerations.‘§øOnce“theseŽ¡‘Çafunctions›R*ha•¬rv“e˜bSŽeen˜loaded,‘¬ declarations˜for˜eac“h˜pro•SŽduction˜are˜incorp“orated˜via˜theŽ¡‘Ça le–<ÒÜbool‘½°‰ff´}Ž‘r-decls.mlÖ.‘/_They“are“in“turn“follo•¬rw“ed›<Òb“y˜a˜ le˜holding˜the˜functions˜describingŽ¡‘Çaeac¬rh–°ÊprošSŽduction“(Übool.mlÖ).‘‹FThe“rationale“b˜ehind“the“creation“of“these“last“t•¬rw“o–°Ê les“isŽ¡‘Çadiscussed–ê¨in“Section“1.5.ŽŽŽŒ‹*t ÌU ýFÓŸú™š‘êñëÛ4’ÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ýÓ8“‘êñ러ýô‰ffÇ I œvÌÍŸ}„ Š€ff ÿkf/‘ÌÍÓ%–¿ªGenerated“parser“load“fileŽ¤‘L!First–¿ªload“some“basic“definitions:“%Ž© ‘ÌÍloadf‘¿ª`/usr/groups/hol/hol2/Library/parser/general`;;Ž¡‘ÌÍ%–¿ªInsert“any“other“files“you“want“loaded“here:“%Ž¡‘ÌÍ%–¿ªNow“load“the“declarations:“%Ž¦‘ÌÍloadf‘¿ª`bool_decls`;;Ž¡‘ÌÍ%–¿ªFinally“load“in“the“function“definitions:“%Ž¦‘ÌÍloadf‘¿ª`bool`;;ŽŽ’Æq°„ Š€ffŽŽŸzã‰ffÇ IŽŽŽŸ_ᵑöSzÖNo–µiediting“of“the“generated“ÜMakefile“Ö(Ü./Makefile.boolÖ)“is“required“either.‘' It“simplyŽ¤ ™š‘êñëcompiles–Œ£the“generated“ les“in“the“same“order“that“they“should“bSŽe“loaded.‘ÐWhile“com-Ž¡‘êñëpilation–kis“not“essen¬rtial“to“use“the“generated“parser,‘ it“is“recommended.‘‰*The“system“willŽ¡‘êñërun›“…m•¬ruc“h˜faster.‘ÔIn˜order˜to˜mak“e˜a˜compiled˜v“ersion˜of˜the˜parser,‘¤òw“e˜need˜only˜executeŽ¡‘êñëthe–ê¨command“Ümake–,Í-f“Makefile.bool“all–ê¨Öat“the“Unix“prompt.Ž Ã¼t‘êñë ÿF5j‰ffÇ I jÌÍŸ}„n“ff þœëƒ‘ÌÍÓ#–¿ªGenerated“parser“MakefileŽ¤‘ÌÍ#–¿ªVersion“of“HOL“to“be“used:Ž© ‘ÌÍHOL=/usr/groups/hol/hol2/holŽ¡‘ÌÍ#–¿ªGeneral“definitions“for“all“generated“parsers:Ž¦‘ÌÍGENERAL=/usr/groups/hol/hol2/Library/parser/generalŽ¡‘ÌÍ#–¿ªInsert“entries“for“user-defined“stuff“here:Ž¦‘ÌÍ#–¿ªRemember“to“insert“the“appropriate“dependencies“and“"load"'s“below.Ž¡‘ÌÍ#–¿ªNow“compile“the“declarations:Ž¦‘ÌÍbool_decls_ml.o:‘¿ªbool_decls.mlŽ¦‘3Êecho‘¿ª'set_flag(`abort_when_fail`,true);;'\Ž¦‘Pˆo'loadf‘¿ª`$(GENERAL)`;;'\Ž¦‘Pˆo'compilet‘¿ª`bool_decls`;;'\Ž¦‘Pˆo'quit();;'–¿ª|“$(HOL)Ž¡‘ÌÍ#–¿ªFinally“do“the“actual“functionsŽ¦‘ÌÍbool_ml.o:–¿ªbool.ml“bool_decls_ml.oŽ¦‘3Êecho‘¿ª'set_flag(`abort_when_fail`,true);;'\Ž¦‘Pˆo'loadf‘¿ª`$(GENERAL)`;;'\Ž¦‘Pˆo'loadf‘¿ª`bool_decls`;;'\Ž¦‘Pˆo'compilet‘¿ª`bool`;;'\Ž¦‘Pˆo'quit();;'–¿ª|“$(HOL)Ž¡‘ÌÍall:‘¿ªbool_ml.oŽ¦‘3Ê@echo–¿ª'===>“Parser“"bool"“built.ŽŽ’Æq°„n“ffŽŽŸzã‰ffÇ IŽŽŽ ÄBÛ‘êñëÛNB:–[¤ÖBoth“the“load“and“makš¬re“ les“are“created“ev˜ery“time“the“generator“is“run.‘ ‹ÓIt“isŽŸ€‘êñëtherefore–ê¨advisable“to“sa•¬rv“e–ê¨a“copš¬ry“of“eac˜h“once“their“con˜ten˜ts“has“bSŽeen“ xed.ŽŽŽŒ‹4Y ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €Generating‘€P arsers’/}i5Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaâ1.3.2Ž‘E`âRunning–…the“Generated“PŠ=arserŽŸ:{‘ÇaÖW‘ÿVe–Ðíuse“the“generated“load“ le“to“install“the“parser“in“the“ÍHOL“Ösystem.‘ë®Note“that“theŽ¤ ™š‘Çaparser-generator–¥is“no“longer“needed.‘gîIn•¬rv“oking–¥the“function“ÜPARSE_text‘ JÖwill“then“runŽ¡‘Çathe–s parser“on“the“desired“input.‘W‘ÿVe“ha•¬rv“e–s supplied“a“n¬rull“list“as“bSŽoth“the“second“and“thirdŽ¡‘Çaargumen¬rts–òÁto“ÜPARSE_text“Ö.‘Q*The“result“is“that“only“the“default“whitespace“list“(space,Ž¡‘Çatab,‘‘ßand–pnnewline)“is“used“to“separate“tok¬rens.‘Ê2W‘ÿVe“will“fully“describSŽe“the“nature“of“theseŽ¡‘Çaargumen¬rts–ê¨in“Section“1.6,“and“an“example“their“use“appSŽears“in“Section“1.8.2.3.ŽŸ7NB‘ÇaŸÛøy‰ffÇ IŸ>€ùÌÍŸ}„B•vffŸÇÁ˜’°4N„ ׸莒°í6„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#loadf‘¿ª`bool_load`;;Ž¤ ‘ÌÍ................................................()–¿ª:“voidŽŸ‘ÌÍ#PARSE_text(`IMP–¿ªCONJ“a“b“CONJ“b“a`,[],[]);;Ž¡‘ÌÍ"a–¿ª/\“b“==>“b“/\“a"“:“termŽŽ’Æq°„B•vffŽŽŸzã‰ffÇ IŽŽŽŸ6è*‘(ðÖW‘ÿVe–6ƒnoš¬rw“in˜troSŽduce“an“error‘ min“the“input“to“demonstrate“the“use“of“the“debuggingŽ¡‘Çafeatures–×of“the“system.‘þAThe“function“Üdebug_on‘ ®<Öputs“the“parser“in¬rto“debugging“moSŽde,Ž¡‘Çaand–ê¨returns“the“previous“debug“state.‘8àIts“con•¬rv“erse–ê¨is“Üdebug_off“Ö.Ž ¹£˜‘Ça ÿYøy‰ffÇ I B€ùÌÍŸ}„F•vff þÃÁ˜’°4N„ ׸莒°í6„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#PARSE_text(`IMP–¿ªCON“a“b“CONJ“b“a`,[],[]);;Ž¤ ‘ÌÍevaluation‘¿ªfailed‘¾RfailŽ©‘ÌÍ#debug_on();;Ž¡‘ÌÍfalse–¿ª:“boolŽ¦‘ÌÍ#PARSE_text–¿ª(`IMP“CON“a“b“CONJ“b“a`,[],[]);;Ž¡‘ÌÍENTERING–¿ªprdn“"MAIN_LOOP":“Curr.“Token“=“"IMP";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"term":“Curr.“Token“=“"IMP";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"neg":“Curr.“Token“=“"IMP";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"imp":“Curr.“Token“=“"IMP";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"term":“Curr.“Token“=“"CON";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"neg":“Curr.“Token“=“"CON";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"imp":“Curr.“Token“=“"CON";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"conj":“Curr.“Token“=“"CON";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"disj":“Curr.“Token“=“"CON";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"conj":“Curr.“Token“=“"IMP";“Expected“=“"nil".Ž¡‘ÌÍENTERING–¿ªprdn“"disj":“Curr.“Token“=“"IMP";“Expected“=“"nil".Ž¡‘ÌÍevaluation‘¿ªfailed‘¾RfailŽ¦‘ÌÍ#debug_off();;Ž¡‘ÌÍtrue–¿ª:“boolŽ¦‘ÌÍ#PARSE_text(`IMP–¿ªCONJ“a“b“CONJ“b“a`,[],[]);;Ž¡‘ÌÍ"a–¿ª/\“b“==>“b“/\“a"“:“termŽŽ’Æq°„F•vffŽŽŸzã‰ffÇ IŽŽŽ ¸è*‘ÇaÖThe–ìonly“mš¬rysterious“part“of“the“debugger“is“the“ÜExpected“Östatemen˜t.‘<þIt“sho˜ws“the“c˜har-Ž¤€‘Çaacter–XÑor“language“construct“that“should“immediately“folloš¬rw“the“string“curren˜tly“bSŽeingŽ¡‘Çaparsed.‘8àÜnil–ê¨Örepresen¬rts“a“\don't“care"“case.ŽŽŽŒ‹=d ÌU ýFÓŸú™š‘êñëÛ6’ÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.4Ž‘5oError‘Ÿ¼MessagesŽ©ÑêñëÖThe–ÉCparser-generator“is“quite“sensitivš¬re“to“the“con˜text“in“whic˜h“an“error‘’†within“the“inputŽ¤€‘êñëgrammar–krappšSŽears.‘yShould“an“error“b˜e“presenš¬rt,‘„ãa“message“of“the“follo˜wing“form“will“oSŽccur.ŽŸ)·Ì‘êñëŸå#c‰ffÇ IŸ+_žÌÍŸYœ„/¹:ffŸÜ7u‘ÌÍÓERROR:–¿ªsymbol“"Ðsymb‘ÿp¹ol‘ §Ó"“encountered“in“the“wrong“place.Ž¡‘¨…--–¿ªProduction:“Ðpr–ÿp¹o“ductionŽ¡‘¨…Ó--–¿ªDiagnostic:“Ðr–ÿp¹e“asonŽŽ’Æq°„/¹:ffŽŽŸÀ‰ffÇ IŽŽŽŸ)‡ä‘êñëÙsymb›ÿffol–µ©Öis“the“tok¬ren“that“caused“the“error,‘óvÙpr˜o˜duction“Öis“the“prošSŽduction“in“whic¬rh“it“o˜ccurred,Ž¡‘êñëand›ê¨Ùr–ÿffe“ason˜Öis˜the˜reason˜that˜the˜parser-generator˜thinks˜migh•¬rt˜ha“v“e˜caused˜the˜error.ŽŸ)<È‘êñëç1.5Ž‘5oIn‘ÿr°ternalsŽ¦‘êñëÖW‘ÿVe–Ponoš¬rw“presen˜t“a“short“discussion“of“the“in˜ternals“of“the“parser-generator,‘©àas“w˜ell“asŽ¡‘êñëthe–É»design“decisions“that“wš¬rere“made.‘ ÖThe“follo˜wing“w˜ere“the“main“goals“during“theŽ¡‘êñëdev•¬relopmen“t–ê¨of“the“generator.Ž¤oŒ‘üqÚØŽŽŽ‘Q×ÖThe–ê¨order“in“whic¬rh“prošSŽductions“are“sp˜eci ed“should“not“b˜e“imp˜ortan¬rtŽ¡‘üqÚØŽŽŽ‘Q×ÖMutual–ê¨recursion“of“prošSŽductions“should“b˜e“allo•¬rw“ed.Ž¡‘üqÚØŽŽŽ‘Q×ÖNon-determinism–_¸within“a“giv¬ren“prošSŽduction“should“b˜e“p˜ossible“(i.e.‘ not“just“regularŽ©€‘Q×grammars).Ž¡‘üqÚØŽŽŽ‘Q×ÖThe–ê¨output“of“anš¬ry“generated“parser“should“bSŽe“an“ob‘§ject“of“user-de ned“t˜ypSŽe.Ž¡‘üqÚØŽŽŽ‘Q×ÖThe–ê¨generator“ough¬rt“to“opSŽerate“in“one“pass.ŽŸo‘öSzObstacles–Êvwš¬rere“presen˜ted“to“the“ rst“t˜w˜o“of“these“goals“b˜y“the“w˜a˜y“in“whic˜h“ÍML“ÖfunctionsŽ¦‘êñëare–­§declared“and“used.‘$ŠThe“dicultš¬ry“is“based“on“the“fact“that“functions“ma˜y“not“bSŽe“usedŽ¦‘êñëbšSŽefore–Ï_they“are“de ned,‘ÔÔotherwise“t•¬ryp˜ec“hec“king–Ï_b˜ecomes“problematic.‘/ÈAs“an“illustration,Ž¦‘êñëif–ŠúprošSŽduction“ÙA‘ŠÑÖw¬ras“to“reference“pro˜duction“ÙBÖ,“then“the“function“describing“ÙB‘ŠÑÖm¬rust“b˜eŽ¦‘êñëde ned–ÐÄin“the“ÍML“Ösystem“bšSŽefore“the“one“sp˜ecifying“ÙAÖ.“The“result,–JKtherefore,“is‘ÐÄthatŽ¦‘êñëproSŽduction–W½ÙB‘W¡Öwš¬rould“ha˜v˜e“to“appšSŽear“in“the“input“grammar“b˜efore“pro˜duction“ÙAÖ.“Ev¬ren“ifŽ¦‘êñëthe–÷‹restriction“of“con ning“the“user“to“a“particular“ordering“of“proSŽductions“w¬ras“adopted,Ž¦‘êñëit–ú+wš¬rould“still“bSŽe“insucien˜t“to“deal“with“the“case“where“ÙA›ú'Öand“ÙB˜Öare“mš¬rutually“recursiv˜e.Ž¦‘êñëThe–|juse“of“a“giganš¬rtic“ÜletÖ{Üand“Öin“ÍML“Öw˜ould“tak˜e“care“of“the“m˜utual“recursion“problem,Ž¦‘êñëbut–»ådošSŽes“not“allo¬rw“for“the“op˜eration“to“b˜e“spread“accross“m¬rultiple“ les“should“one“decideŽ¦‘êñëto–ê¨structure“one's“grammar“in“that“manner.ŽŸ¯é‘öSzT‘ÿVo›ê¨o•¬rv“ercome˜these˜problems,˜the˜follo“wing˜translation˜sc“heme˜w“as˜dev“elopSŽed:Ž¡‘üqÚØŽŽŽ‘Q×ÖEac¬rh–ž[prošSŽduction“sp˜eci ed“bš¬ry“the“user“generates“t˜w˜o“ob‘§jects,‘­žeac˜h“in“a“separate“ le.Ž¡‘üqÚØŽŽŽ‘Q×ÖOb‘§jects–ˆÀin“the“ rst“ le“are“ÍML“Ületref“Ödeclarations“spSŽecifying“the“input“and“outputŽ¦‘Q×t¬rypšSŽes–ê¨of“the“function“that“will“b˜e“generated.ŽŽŽŒ‹I4 ÌU ýFÓŸú™š‘ÇaÛ1.6.‘ €Reserv ed‘€W‘þàords’@ò¾7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘$GPØŽŽŽ‘0'MÖOb‘§jects–‰win“the“second“ le“are“×Ö-expressions“represen¬rting“the“functions“that“describSŽeŽ©€‘0'Mthe‘ê¨proSŽductions.Ž¤ß‘$GPØŽŽŽ‘0'MÖOb›§jects–ê¨from“the“second“ le“are“bSŽound“to“ob˜jects“in“the“ rst“ le“via“assignmen¬rt.Ž¡‘$GPØŽŽŽ‘0'MÖWhen–a“generated“parser“is“compiled,‘ éthe“ le“con¬rtaining“the“declarations“is“loadedŽ¦‘0'M rst.‘ìThe–Íone“conš¬rtaining“the“×Ö-expressions“and“their“assignmen˜ts“to“an“ob‘§ject“fromŽ¦‘0'Mthe–ê¨ rst“ le“is“loaded“afterw¬rards.ŽŸß‘ÇaThe–ÇEresult“of“the“abšSŽo•¬rv“e–ÇEpro˜cess“is“that“all“functions“are“declared“b˜efore“they“are“used.Ž¦‘ÇaThe–1cprošSŽductions“that“the“user“sp˜eci es“maš¬ry“therefore“reference“eac˜h“other“in“an˜y“order.Ž¦‘ÇaF‘ÿVurthermore,›t‰should–%Âthe“user“wish“to“describSŽe“a“parser“in“man¬ry“ les,˜the“proSŽductionsŽ¦‘Çamaš¬ry–GÛreference“eac˜h“other“across“those“ les.‘PzThe“pro˜viso“is,›_(of“course,˜that“all“generatedŽ¦‘Çadeclarations–ê¨are“loaded“in¬rto“the“system“ rst“when“the“generated“parser“is“run.Ž¤ùl‘(ðEacš¬rh–ðògenerated“parser“main˜tains“an“in˜ternal“stac˜k“of“in˜termediate“results.‘K¿It“is“simplyŽ¦‘Çaa–fìlist“of“ÍML“Öob‘§jects“of“a“user-de ned“tš¬rypSŽe“that“ha˜v˜e“bSŽeen“built“up“during“the“course“ofŽ¦‘Çathe–Œparser's“execution.‘¼This“results“stac¬rk“is“the“only“methoSŽd“of“building“the“ nal“ob‘§jectŽ¦‘Çathat–dBis“returned“to“the“user,‘‚©and“is“accessed“via“the“ÜPOP‘ÈFÖreservš¬red“sym˜bSŽol“men˜tioned“inŽ¦‘ÇaSection–ø1.6“and“describšSŽed“in“Section“1.7.‘ÕÑIt“is“mo˜di ed“through“action“sym¬rb˜ols“that“theŽ¦‘Çauser–ê¨im¬rbSŽeds“in“the“grammar.Ž¡‘(ðThe–9parser-generator“will“handle“non-determinism“in“proSŽductions.‘ “In“order“to“imple-Ž¦‘Çamenš¬rt–ébthis“feature,‘é£it“w˜as“necessary“to“build“a“bac˜ktrac˜king“mec˜hanism“in˜to“all“generatedŽ¦‘Çaparsers.‘It–‘\is“based“on“ÍML“Öfailure-trapping,‘£8and“simply“creates“a“fail“trap“for“eacš¬rh“branc˜hŽ¦‘Çaof–vDa“prošSŽduction.‘Û´These“traps“are“guaran¬rteed“to“b˜e“hierarcš¬rhical“in“nature“b˜y“the“w˜a˜y“inŽ¦‘Çawhicš¬rh–¨(an“input“grammar“is“spSŽeci ed.‘qaA‘§øone“c˜haracter“loSŽok-ahead“is“used“to“determineŽ¦‘Çaif–Šthe“synš¬rtactic“ob‘§ject“curren˜tly“bSŽeing“parsed“is“follo˜w˜ed“b˜y“useful“input.‘If“it“is“not,‘±êaŽ¦‘Çafailure–ê¨results,“and“the“bac•¬rktrac“king›ê¨mec“hanism˜is˜in“v“ok“ed.ŽŸ+‘Çaç1.6Ž‘@ åReserv‘ÿr°ed‘Ÿ¼W‘þXordsŽŸY‘ÇaÖThe–ëgenerator“makš¬res“use“of“sev˜eral“reserv˜ed“w˜ords.‘+áThey“are“all“in“uppSŽer“case,‘Ëwand“sinceŽ¦‘Çathe–?\parser-generator“is“case-sensitiv¬re,‘TŠwill“not“con ict“with“user-de ned“functions“of“theŽ¦‘Çasame–ê¨name“expressed“in“either“mixed“or“lo•¬rw“er‘ê¨case.ŽŸÑò‘$GPØŽŽŽ‘0'MÍNON-TERMINAL:Ž¤ß‘=`ÖÛ{ŽŽŽ‘JÒÜMAIN_LOOP‘ òÖ|–âa“prošSŽduction“that“the“user“sp˜eci es“to“describ˜e“the“top-lev¬relŽ¦‘JÒparse–W>lošSŽop.‘½The“generator“senses“its“presence“and“outputs“t•¬rw“o–W>wrapp˜ers“to“callŽ¦‘JÒthe– generated“parser“in“a“propšSŽerly“initialised“state.‘|It“ma¬ry“not“b˜e“called“fromŽ¦‘JÒwithin–ê¨the“grammar“at“an¬ry“time.ŽŸß‘$GPØŽŽŽ‘0'MÍTERMINAL:Ž¡‘=`ÖÛ{ŽŽŽ‘JÒÜEOF‘ÕPÖ|–ê¨spšSŽeci es“when“the“end“of“ le“ma¬ry“o˜ccur.ŽŽŽŒ‹Uá ÌU ýFÓŸú™š‘êñëÛ8’ÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘üqÚØŽŽŽ‘Q×ÍAR²!GUMENTS:–¼®ÖThe“folloš¬rwing“can“only“appSŽear“as“argumen˜ts“to“action“sym˜bSŽols.‘Ô7TheirŽ¤€‘Q×presence–Nóanš¬rywhere“else“in“the“input“grammar“will“cause“a“fatal“error.‘eÁTheir“t˜ypSŽesŽ¡‘Q×are–ê¨givš¬ren“paren˜thetically‘ÿV.ŽŸÏû‘‹`Û{ŽŽŽ‘"+\ÜPOP‘͸Ö(Ü:Ùuser-de ne‘ÿffdÖ)–fü|“returns“the“most“recen¬rt“previously“constructed“resultŽ¡‘"+\from–ê¨the“results“list.Ž©Ÿþ‘‹`Û{ŽŽŽ‘"+\ÜTOKEN‘ h|Ö(Ü:stringÖ)–´´|“returns“a“legal“tokš¬ren“iden˜ti er“as“spSŽeci ed“using“theŽ¡‘"+\constructs›)‡bSŽelo•¬rw.‘õ}Successiv“e˜calls˜to˜ÜTOKEN‘)5Öwill˜cause˜new˜iden“ti ers˜to˜bSŽeŽ¡‘"+\obtained–ê¨from“the“input“source.Ž¦‘‹`Û{ŽŽŽ‘"+\ÜWORD‘=4Ö(Ü:stringÖ)–Î|“returns“the“currenš¬rt“string“in“the“input“stream.‘ôíNo“c˜hec˜kingŽ¡‘"+\of–Úyan¬ry“kind“is“pSŽerformed.‘3{The“construct“is“particularly“useful“for“dealing“withŽ¡‘"+\arbitrary–ê¨ob‘§jects“in“the“language“that“the“user“w•¬ran“ts–ê¨to“treat“spSŽecially‘ÿV.ŽŸÏü‘üqÚØŽŽŽ‘Q×ÍDECLARA‘ÿeTIONS:–üSÖBoth“ÜFIRST_CHARS›ø.Öand“ÜCHARS˜ÖbSŽeloš¬rw“m˜ust“appSŽear“for“the“parser-Ž¡‘Q×generator–Ä™to“construct“a“tokš¬reniser.‘,0If“one“is“presen˜t“without“the“other,‘Ì5a“fatal“errorŽ¡‘Q×results.‘8àThey–ê¨maš¬ry“not“bSŽe“m˜ultiply“de ned“within“the“same“grammar.ŽŸÏû‘‹`Û{ŽŽŽ‘"+\ÜFIRST_CHARS‘åÖ|–rëUsed“to“spSŽecify“a“whitespace-separated“string“of“c¬rharactersŽ¡‘"+\represenš¬rting–ê¨the“legal“ rst“c˜haracters“of“iden˜ti ers.‘8àIt“ma˜y“not“bSŽe“empt˜y‘ÿV.Ž¦‘‹`Û{ŽŽŽ‘"+\ÜCHARS‘ ]BÖ|–®ÓUsed“to“spSŽecify“a“whitespace-separated“string“of“c¬rharacters“repre-Ž¡‘"+\senš¬rting–ê¨the“other“legal“c˜haracters“of“iden˜ti ers.‘8àIt“ma˜y“not“bSŽe“empt˜y‘ÿV.Ž¦‘‹`Û{ŽŽŽ‘"+\ÜUSEFUL‘ /ÒÖ|–6Used“to“tell“the“generated“parser“those“c¬rharacters“delineating“aŽ¡‘"+\useful–ŒbloSŽcš¬rk“of“text“whic˜h“should“bSŽe“concatenated“in˜to“a“single“string.‘,It“tak˜esŽ¡‘"+\the–form“of“an“assoSŽciation“list,‘l8where“eacš¬rh“mem˜bSŽer“of“the“list“has“the“t˜ypSŽeŽ¡‘"+\Ü(string#string)Ö.‘=The–ì rst“elemenš¬rt“of“the“pair“is“the“c˜haracter“whic˜h“bSŽeginsŽ¡‘"+\the–´PblošSŽc¬rk,‘æ¹and“the“second“is“the“one“that“terminates“it.‘•×The“generator“do˜esŽ¡‘"+\not›îc•¬rhec“k˜the˜syn“tax˜or˜t“ypSŽe˜of˜the˜list,‘#@and˜it˜is˜incum“bSŽen“t˜upSŽon˜the˜user˜toŽ¡‘"+\makš¬re–ê¨sure“that“it“is“w˜ell-formed.Ž¦‘‹`Û{ŽŽŽ‘"+\ÜIGNORE‘ fÖ{–Ž]The“con•¬rv“erse–Ž]of“ÜUSEFULÖ.“It“is“an“assoSŽciation“list“of“the“same“formŽ¡‘"+\as–¤3ÜUSEFULÖ,“but“is“used“to“spšSŽecify“the“b˜eginning“and“ending“of“blo˜c¬rks“of“textŽ¡‘"+\whic•¬rh›õ ma“y˜bSŽe˜thro“wn˜a“w“a“y˜b“y˜generated˜parser˜as˜it˜is˜reading˜in˜input.‘XITheŽ¡‘"+\declaration–ñbis“particularly“useful“in“remoš¬rving“commen˜ts“from“an“input“streamŽ¡‘"+\bSŽefore–ê¨it“is“passed“to“the“parser.ŽŸÏü‘üqÚØŽŽŽ‘Q×ÍFUNCTIONS:ŽŸÏû‘‹`Û{ŽŽŽ‘"+\ÜPARSE_file‘ n”Ö|–·JThe“ rst“function“deriv¬red“from“the“proSŽduction“ÜMAIN_LOOP‘·Ö.Ž¡‘"+\Its– Zname“therefore“cannot“bSŽe“used“as“the“name“of“a“non-terminal,‘mÇor“as“anŽ¡‘"+\argumenš¬rt–ªMto“an“action“sym˜bSŽol.‘ wÏThe“function“tak˜es“three“argumen˜ts.‘ wÏTheŽ¡‘"+\ rst–ùgis“the“name“of“the“input“ le,‘=and“is“a“standard“ÍML“Östring.‘eIf“terminalŽ¡‘"+\ÍI/O‘rÖis–r‚desired,‘ÔyÜ`nil`“Öshould“bSŽe“supplied.‘ ÐoThe“second“argumenš¬rt“is“of“t˜ypSŽeŽ¡‘"+\Üstring‘,ÍlistÖ,‘Ïxand–Ȭrepresenš¬rts“the“whitespace“used“b˜y“the“language.‘-ŒSupplyingŽ¡‘"+\a–ŒYn¬rull“list“(Ü[]Ö)“will“trigger“the“use“of“the“default“list“of“blank,‘Ÿ5tab“and“newline.Ž¡‘"+\The–ÞŠ nal“argumen¬rt“is“used“to“describšSŽe“sp˜ecial“delimiting“c¬rharacters“and“thoseŽŽŽŒ‹ c ÌU ýFÓŸú™š‘ÇaÛ1.7.‘ €Action‘€Sym b`ols’CÙ9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘JÒÖthat–samaš¬ry“follo˜w“them“to“mak˜e“a“v‘ÿXäalid“tok˜en.‘Ó It“is“an“assoSŽciation“list“of“t˜ypSŽeŽ¤€‘JÒÜ(string–,Í#“string“list)“list–¢ŒÖwhere“the“ rst“elemenš¬rt“of“eac˜h“pair“is“theŽ¡‘JÒdelimiting– Åcš¬rharacter,‘Mand“the“second“is“the“list“of“follo˜wing“c˜haracters.‘Ÿ8A‘ ½n˜ullŽ¡‘JÒfolloš¬rwing–§$list“means“that“the“spSŽecial“c˜haracter“is“a“tok˜en“b˜y“itself.‘"_If“a“n˜ull“listŽ¡‘JÒis–Xproš¬rvided“as“the“argumen˜t,‘!Dthe“only“separators“used“will“bSŽe“those“con˜tainedŽ¡‘JÒin–ê¨the“whitespace“list.Ž©n¬‘=`ÖÛ{ŽŽŽ‘JÒÜPARSE_text‘ÇÖÖ|–cëAnother“function“created“b¬ry“the“proSŽduction“ÜMAIN_LOOP‘cÌÖ.“ItsŽ¡‘JÒargumen¬rts–pùare“the“same“as“for“ÜPARSE_file‘áòÖwith“the“exception“of“the“ rst“one.Ž¡‘JÒHere–5Ôthe“language“constructs“to“bSŽe“parsed“are“directly“stated“as“a“ÍML“Östring.Ž¡‘JÒIt–͉is“impSŽortanš¬rt“to“remem˜bšSŽer“to“include“the“standard“escap˜e“c¬rharacter“in“theseŽ¡‘JÒstrings–ê¨when“required.‘8àF‘ÿVailure“to“do“so,“can“cause“m•¬ruc“h‘ê¨frustration.Ž¦‘=`ÖÛ{ŽŽŽ‘JÒÜTOKEN‘ÕPÖ|–ê¨The“name“of“the“generated“tok¬reniser“function.Ž¦‘=`ÖÛ{ŽŽŽ‘JÒÜTOKEN_1‘ÕPÖ|–ê¨The“name“of“a“helping“function“for“ÜTOKENÖ.Ž¦‘=`ÖÛ{ŽŽŽ‘JÒÜchop_offÖ,–ê¨Üclose_fileÖ,“Ücomplete_separatorÖ,“Üdebug_enterÖ,“Üdebug_offÖ,Ž¡‘JÒÜdebug_onÖ,–ê¨Üdebug_returnÖ,“Üdetermine_lstÖ,“Üdo_returnÖ,“Üdo_return_1Ö,Ž¡‘JÒÜeat_terminalÖ,–ê¨Üe_w_sÖ,“Üe_w_s_okÖ,“Üget_wordÖ,“Üget_word1Ö,“Üget_word2Ö,“ÜgntÖ,Ž¡‘JÒÜopen_fileÖ,–ŠðÜpopÖ,“ÜpushÖ,“Üread_charÖ,“Üread_inputÖ,“Üwrite_string–jâÖ|“These“areŽ¡‘JÒfunctions–·Æthat“are“used“b¬ry“all“generated“parsers,‘Áóand“cannot“bSŽe“used“as“namesŽ¡‘JÒfor–Õthe“user's“action“sym¬rbšSŽols“or“pro˜ductions.Ž¡Ÿ( b‘Çaç1.7Ž‘@ åAction‘Ÿ¼Sym‘ÿr°b‘OolsŽŸb#‘ÇaÖThese–0Rare“spSŽeci ed“bš¬ry“the“user“outside“the“con˜text“of“the“grammar“(i.e.‘úÃin“a“separate“ le).Ž¡‘ÇaTheir–ªPargumenš¬rts“ma˜y“bSŽe“an˜y“of“the“reserv˜ed“argumen˜ts“just“men˜tioned,‘Ú:non-terminals,Ž¡‘Çaor–\°actual“ÍML“Öexpressions.‘ŽøThe“parser-generator“assumes“that“these“functions“exist,‘y2andŽ¡‘Çasimply–ãþcreates“a“call“to“them.‘6§It“is“up“to“the“user“to“mak¬re“sure“that“the“actual“functionsŽ¡‘Çaare›ê¨w•¬rell-t“yp•SŽed˜with˜resp“ect˜to˜the˜generated˜call.ŽŸL‘ÇaÍEXAMPLES:ŽŽŽŸn¬‘> ÕØŽŽŽ‘JÒÜ{action}–¢•Ö|“Generates“a“call“to“the“user-de ned“function“ÜactionÖ.‘Ë„It“is“assumedŽ¡‘JÒthat–ê¨Üaction“Öhas“Ü()“Öas“its“argumen¬rt.Ž¦‘> ÕØŽŽŽ‘JÒÜ{action(prdn)}–^•Ö|“Generates“a“call“to“the“user-de ned“function“ÜactionÖ,‘z™withŽ¡‘JÒthe–F"result“of“the“elabSŽoration“of“the“non-terminal“Üprdn“Öas“its“argumen¬rt.‘KOSinceŽ¡‘JÒthe–sexecution“of“a“non-terminal“results“in“an“ob‘§ject“of“user-de ned“t¬rypSŽe,‘•8theŽ¡‘JÒfunction–ê¨Üaction“Öshould“re ect“this“in“its“spSŽeci cation.Ž¦‘> ÕØŽŽŽ‘JÒÜ{action(prdn1,prdn2)}–e-Ö|“Same“as“abSŽo•¬rv“e.‘ ¨nThe–e-non-terminals“Üprdn1“ÖandŽ¡‘JÒÜprdn2–ê¨Öare“ev‘ÿXäaluated“in“sequence“bSŽefore“the“results“are“passed“to“ÜactionÖ.Ž¦‘> ÕØŽŽŽ‘JÒÜ{action(TOKEN)}‘ •ÊÖ|–ÊåEv‘ÿXäalutates“the“currenš¬rt“input“string“as“an“iden˜ti er“asŽ¡‘JÒspSŽeci ed–*èb¬ry“ÜFIRST_CHARS›UnÖand“ÜCHARS˜Öand“passes“the“result“to“ÜactionÖ.‘øõIf“thereŽ¡‘JÒis–ê¨no“currenš¬rt“string,“one“is“fetc˜hed“from“the“input“source.ŽŽŽŒ‹ qÝ ÌU ýFÓŸú™š‘êñëÛ10’ÿNÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘K_ØŽŽŽ‘"+\Ü{action(TOKEN,TOKEN)}‘³TÖ|–ÙªSame“as“abSŽo•¬rv“e.‘36The›Ùªcurren“t˜string˜and˜the˜nextŽ¤€‘"+\one–Åkread“from“the“input“source“are“ev‘ÿXäaluated“as“iden¬rti ers,‘<and“passed“toŽ¡‘"+\Üaction–ê¨Öin“left-to-righš¬rt“order“as“argumen˜ts.Ž© ‘K_ØŽŽŽ‘"+\Ü{action(POP)}‘ÇæÖ|–cóThe“most“recenš¬rt“previous“result“is“remo˜v˜ed“from“the“resultŽ¡‘"+\list,–ê¨and“passed“as“an“argumen¬rt“to“ÜactionÖ.Ž¦‘K_ØŽŽŽ‘"+\Ü{action(POP,POP)}‘ ÊTÖ|–å*Same“as“abSŽo•¬rv“e.‘(gThe–å*most“recen¬rt“previous“result“isŽ¡‘"+\passed–g as“the“second“argumenš¬rt“to“ÜactionÖ,‘_while“the“one“bSŽefore“it“is“sen˜t“as“theŽ¡‘"+\ rst‘ê¨argumen¬rt.Ž¦‘K_ØŽŽŽ‘"+\Ü{action(POP,TOKEN,prdn,POP)}‘ÛÈÖ|–mäThe“calls“to“ÜPOP‘mÃÖare“ rst“elabSŽorated“inŽ¡‘"+\the–¨manner“just“describšSŽed“(i.e.‘¹áthe“most“recen¬rt“previous“result“will“b˜e“passedŽ¡‘"+\as–I²the“last“argumen¬rt“to“ÜactionÖ,‘iãwhile“the“one“bšSŽefore“that“will“b˜e“the“ rst“one).Ž¡‘"+\ÜTOKEN‘fÖis–ŒËthen“executed“bSŽefore“the“non-terminal“Üprdn“Öis“expanded.‘–After“ÜprdnŽ¡‘"+\Öreturns,–ê¨the“four“results“are“passed“to“ÜactionÖ.ŽŸ'_„‘êñëç1.8Ž‘5oExamplesŽŸb#‘êñëÖIn–¬þthe“examples“that“follo•¬rw,‘Ý”w“e–¬þassume“that“the“parser-generator“has“bSŽeen“loaded“in¬rtoŽ¡‘êñëthe–ê¨ÍHOL“Ösystem.ŽŸ"Ù‘êñëâ1.8.1Ž‘‹lT‘þž¸erminal–…Input“and“ErrorsŽŸYš‘êñëÖThe–*€folloš¬rwing“session“demonstrates“the“generator's“abilit˜y“to“understand“input“from“theŽ¤ ™š‘êñëuser's–console.‘ΕProš¬rviding“Ünil“Öas“the“input“ le“allo˜ws“the“user“to“spSŽecify“a“grammmar“inŽ¡‘êñëan›nain•¬rteractiv“e˜manner.‘Ä In˜the˜curren“t˜example,‘Othere˜is˜an˜error˜in˜the˜grammar˜whic“hŽ¡‘êñëcauses–ê¨an“error“message“to“bSŽe“output“.ŽŸof*‘êñ럚5͉ffÇ I ÂQÌÍŸ}„ÆÎff ÿD<@’°4N„ ׸莒°í6„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#parse();;Ž¤ ‘ÌÍInput‘¿ªfile:‘ TnilŽ¡‘ÌÍOutput–¿ªfile:“fooŽ¡‘ÌÍOpening–¿ªthe“file“foo.ml“(MAIN“OUTPUT)Ž¡‘ÌÍOpening–¿ªthe“file“foo_decls.ml“(DECLARATIONS)Ž¡‘ÌÍLoad–¿ªthe“declarations“file“before“the“main“output.Ž¡‘ÌÍSee–¿ªthe“file“foo_load.ml“for“a“sample.Ž¡‘ÌÍSee–¿ªthe“file“./Makefile.foo“for“a“sample“Makefile.Ž¡‘ÌÍOutput–¿ªtype:“termŽ¡‘ÌÍfoo–¿ª-->“[A]“get_word.Ž¡‘ÌÍevaluation‘¿ªfailedŽŸ‘ÌÍERROR:–¿ªsymbol“"get_word"“encountered“in“the“wrong“place.Ž¡‘ Ë--–¿ªProduction:“fooŽ¡‘ Ë--–¿ªDiagnostic:“"get_word"“is“a“system“function.ŽŽ’Æq°„ÆÎffŽŽŸzã‰ffÇ IŽŽŽŸoì’‘êñëÖSimilar–þgmessages“will“bSŽe“output“for“v‘ÿXäarious“classes“of“errors.‘tAn“e ort“w¬ras“made“to“trapŽ¤€‘êñëall–Ï.pSŽossible“errors,›Ô­and“generate“an“appropriate“message.‘/·The“user“should“note,˜ho•¬rw“ev“er,Ž¡‘êñëthat–wWthere“are“probably“unforeseen“com¬rbinations“of“inputs“not“re ected“in“the“trappingŽ¡‘êñëmec¬rhanism.ŽŽŽŒ‹ O ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Examples’aµó11Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaâ1.8.2Ž‘E`âHOL‘…TŠ=ypuÂesŽŸ´1‘ÇaÖW‘ÿVe–Ï noš¬rw“presen˜t“a“more“complex“example,‘$the“sub‘§ject“of“whic˜h“is“a“re-implemen˜tationŽ¤€‘Çaof–*~the“ÍHOL“Ötš¬rypSŽe“parser.‘øaP˜oin˜ts“of“in˜terest“include“user-de ned“action“sym˜b•SŽols,‘:sop“eratorŽ¡‘Çaprecedences,–ê¨and“seamless“in¬rtegration“of“the“parser“with“the“ÍHOL“Ösystem.ŽŸ «‘ÇaÛ1.8.2.1Ž‘F‡aThe‘€GrammarŽ ‚h‘Ça þð/‰ffÇ I vÌÍŸYœ„Ï¡ff ýñ7u‘ÌÍÓFIRST_CHARS–¿ª`a“b“c“d“e“f“g“h“i“j“k“l“m“n“o“p“q“r“s“t“u“v“w“x“y“zŽ¤ ‘PˆoA–¿ªB“C“D“E“F“G“H“I“J“K“L“M“N“O“P“Q“R“S“T“U“V“W“X“Y“Z“*`.Ž©‘ÌÍCHARS–¿ª`a“b“c“d“e“f“g“h“i“j“k“l“m“n“o“p“q“r“s“t“u“v“w“x“y“zŽ¡‘. sA–¿ªB“C“D“E“F“G“H“I“J“K“L“M“N“O“P“Q“R“S“T“U“V“W“X“Y“ZŽ¡‘. s1–¿ª2“3“4“5“6“7“8“9“0“*`.Ž¦‘ÌÍtyname–¿ª-->“{mk_type_name(TOKEN)}.Ž¦‘ÌÍtyvar–¿ª-->“{mk_type_var(TOKEN)}.Ž¦‘ÌÍMAIN_LOOP–¿ª-->“typ“[EOF].Ž¦‘ÌÍtyp–¿ª-->“type1“more_type.Ž¦‘ÌÍmore_type–¿ª-->“[#]“{add_to_list(type1,POP)}“more_prod_type“sum_or_fun_typeŽ¡‘JÈÅ|–¿ª[->]“{MK_bin_type(`fun`,POP,typ)}Ž¡‘JÈÅ|–¿ª[+]“type1“more_sum_type“fun_typeŽ¡‘JÈÅ|‘¿ª[].Ž¦‘ÌÍmore_prod_type–¿ª-->“[#]“{add_to_list(type1,POP)}“more_prod_typeŽ¡‘g‡|‘¿ª{MK_defd_type(POP,`prod`)}.Ž¦‘ÌÍsum_or_fun_type–¿ª-->“[+]“{MK_bin_type(`sum`,POP,typ)}Ž¡‘mFÁ|–¿ª[->]“{MK_bin_type(`fun`,POP,typ)}Ž¡‘mFÁ|‘¿ª[].Ž¦‘ÌÍmore_sum_type–¿ª-->“[+]“{add_to_list_rev(POP,POP)}“type1“more_sum_typeŽ¡‘aÇm|–¿ª[#]“{add_to_list(type1,POP)}“more_prod_type“more_sum_typeŽ¡‘aÇm|–¿ª{add_to_list_rev(POP,POP)}“{MK_defd_type(POP,`sum`)}.Ž¦‘ÌÍfun_type–¿ª-->“[->]“{MK_bin_type(`fun`,POP,typ)}“|“[].Ž¦‘ÌÍtype1–¿ª-->“[(]“typ“poss_cmpnd_type“|“tyname“more_type1“|“tyvar“more_type1.Ž¦‘ÌÍposs_cmpnd_type–¿ª-->“[)]“more_type1“|“[,]“{add_to_list(POP,typ)}“rest_of_cmpnd.Ž¦‘ÌÍrest_of_cmpnd–¿ª-->“[,]“{add_to_list(POP,typ)}“rest_of_cmpndŽ¡‘aÇm|–¿ª[)]“{MK_type(POP,TOKEN)}“more_type1.Ž¦‘ÌÍmore_type1–¿ª-->“{MK_type(POP,TOKEN)}“more_type1“|“[].ŽŽ’Æq°„Ï¡ffŽŽŸÀ‰ffÇ IŽŽŽŽŽŒ‹ Š× ÌU ýFÓŸú™š‘êñëÛ12’ÿNÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘öSzÖThe–Úgrammar“used“to“spšSŽecify“the“t¬ryp˜e“parser“is“sligh¬rtly“more“complex“to“sp˜ecify“thanŽ¤€‘êñëthe–!¤BošSŽolean“logic“example.‘õßThe“main“di erence“is“in“the“need“to“ha•¬rv“e–!¤a“notion“of“op˜eratorŽ¡‘êñëprecedence–mŒ(Ü->“×>“Ü+“×>“Ü#Ö).‘,In“order“to“preservš¬re“the“ordering,‘†‘it“bSŽecomes“necessary“to“mak˜eŽ¡‘êñëseparate–ê¨prošSŽductions“for“eac¬rh“op˜erator.ŽŸÍþ‘öSzThe–action“symš¬rbSŽols“used“in“the“grammar“all“create“an“ob‘§ject“of“t˜ypSŽe“Ütype‘,ÍlistÖ.‘ˆ(TheŽ¡‘êñëreason–Ûfor“creating“lists“of“tš¬rypSŽes“rather“than“t˜ypSŽes“b˜y“themselv˜es“is“based“on“the“need“toŽ¡‘êñëgather–Ntogether“arbitrarily“manš¬ry“t˜ypSŽes“to“form“a“single“one.‘This“grouping“in˜to“a“list“is“aŽ¡‘êñëstandard–—"ploš¬ry“when“dev˜eloping“grammars“for“parsers“where“the“ nal“ob‘§ject“to“bSŽe“createdŽ¡‘êñëis–ê¨depšSŽenden¬rt“up˜on“an“unknoš¬rwn“n˜um˜bSŽer“of“lik˜e“ob‘§jects.ŽŸ-€ö‘êñëÛ1.8.2.2Ž‘±ëRunning–€the“GeneratorŽ©êñëÖThe–˜õparser-generator“is“run“in“exactly“the“same“fashion“as“for“the“BoSŽolean“logic“example.Ž¡‘êñëThe–k·only“di erence“is“in“supplying“Ütype‘,Ílist“Öas“the“output“t¬rypSŽe“of“the“generated“parser.Ž ˆ”ü‘êñ럓P ‰ffÇ I ÏQÌÍŸYœ„Ó_íff ÿ6÷!’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#parse();;Ž¤ ‘ÌÍInput‘¿ªfile:‘ Ttypes.grmŽ¡‘ÌÍOutput–¿ªfile:“typesŽ¡‘ÌÍOpening–¿ªthe“file“types.ml“(MAIN“OUTPUT)Ž¡‘ÌÍOpening–¿ªthe“file“types_decls.ml“(DECLARATIONS)Ž¡‘ÌÍLoad–¿ªthe“declarations“file“before“the“main“output.Ž¡‘ÌÍSee–¿ªthe“file“types_load.ml“for“a“sample.Ž¡‘ÌÍSee–¿ªthe“file“./Makefile.types“for“a“sample“Makefile.Ž¡‘ÌÍOutput–¿ªtype:“type“listŽŸ'‘ ŒwGenerating–¿ªPARSE_file“and“PARSE_text“(MAIN_LOOP“used).Ž¤‘ÌÍ()–¿ª:“voidŽ¡‘ÌÍ#quit();;ŽŽ’Æq°„Ó_íffŽŽŸÀ‰ffÇ IŽŽŽ l¦‘êñëÛ1.8.2.3Ž‘±ëAuxiliary‘€FilesŽ¦‘êñëÖThe–+› rst“auxiliary“ le“is“not“macš¬rhine-generated.‘û¸It“con˜tains“all“the“functions“used“asŽ¡‘êñëaction–&>symš¬rbSŽols“within“the“grammar.‘÷gÜmk_type_name“Öand“Ümk_type_var“Öare“the“lo˜w˜est-lev˜elŽ¡‘êñëfunctions,‘@²and–5create“tš¬rypSŽe“lists“from“primitiv˜e“t˜ypSŽes“and“t˜ypSŽe“v‘ÿXäariables.‘òÜadd_to_list“ÖandŽ¡‘êñëÜadd_to_list_rev–téÖgroup“individual“tš¬rypSŽe“lists“in˜to“a“single“monolithic“one.‘ A‘tËrev˜ersed“listŽ¡‘êñëof–àátš¬rypSŽes“is“required“to“mak˜e“sure“that“sub•SŽcomp“onen˜ts–àáof“t˜ypšSŽes“asso˜ciate“prop˜erly‘ÿV.‘àHÜMK_typeŽ¡‘êñëÖis–µthe“same“as“the“standard“ÍML“Öfunction“Ümk_type“Öwith“the“exception“that“it“returns“a“t¬rypSŽeŽ¡‘êñëlist.‘}ÜMK_bin_type–JÖis“used“to“return“a“tš¬rypSŽe“list“resulting“from“the“creation“of“a“t˜ypSŽe“from“aŽ¡‘êñëbinary–ß{t¬rypšSŽe“op˜erator.‘5&ÜMK_defd_type“Öuses“Üfix_defd“Öto“create“a“prop˜erly“asso˜ciated“t¬ryp˜eŽ¡‘êñëfrom–ê¨a“revš¬rersed“list“of“t˜ypSŽes.ŽŽŽŒ‹ “ ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Examples’aµó13Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýÚ“$‘ÇaŸ¥£c‰ffÇ I ª_žÌÍŸYœ„®¹:ff ÿ]7u‘ÌÍÓlet–¿ªmk_type_name“thing“=“[mk_type(thing,[])]Ž¤ ‘ÌÍand–¿ªmk_type_var“thing“=“[mk_vartype“thing]Ž¡‘ÌÍand–¿ªadd_to_list“(lst,thing)“=“append“lst“thingŽ¡‘ÌÍand–¿ªadd_to_list_rev“(lst,thing)“=“append“thing“lstŽ¡‘ÌÍand–¿ªMK_type(lst,op)“=“[mk_type(op,lst)]Ž¡‘ÌÍand–¿ªMK_bin_type(op,type1,typ)“=“[mk_type(op,(append“type1“typ))];;Ž©‘ÌÍletrec–¿ªfix_defd(lst,op,result)“=Ž¡‘Ëuif–¿ªnull“lst“then“resultŽ¡‘Ëuelse–¿ªfix_defd(tl“lst,op,mk_type(op,[hd“lst;result]));;Ž¦‘ÌÍlet–¿ªMK_defd_type(lst,op)“=Ž¡‘Ëu[fix_defd(tl–¿ª(tl“lst),op,mk_type(op,[hd“(tl“lst);hd“lst]))];;ŽŽ’Æq°„®¹:ffŽŽŸÀ‰ffÇ IŽŽŽŸg¤I‘(ðÖSevš¬reral–Iadditions“ha˜v˜e“bSŽeen“made“to“the“generated“load“ le.‘£ÃThe“ rst“is“to“load“inŽ¤€‘Çathe–Z le“of“action“function“de nitions“just“describSŽed“(Ütypes_help.mlÖ).‘ ‡'Next,‘µðwš¬re“ha˜v˜eŽ¡‘Çade ned–Œ¯a“list“of“separators“to“alloš¬rw“the“lexical“analyzer“to“break“up“the“input“stream“in˜toŽ¡‘Çameaningful–h£tok¬rens“in“the“pSŽossible“absence“of“standard“whitespace.‘ ‰The“function“Üparse‘ÑFÖisŽ¡‘Çade ned–Íto“call“ÜPARSE_text‘!šÖwith“the“appropriate“argumen¬rts,‘<_and“to“return“the“head“of“theŽ¡‘Çaresult–p½of“its“computation“(a“ÍHOL“Ötš¬rypSŽe).‘ËÜnew_syntax_block“Öis“a“function“pro˜vided“as“aŽ¡‘Çapart–mIof“ÍHOL“ÖV‘ÿVersion“1.12,‘†\and“passes“the“string“bSŽet•¬rw“een–mIits“ rst“and“second“argumen¬rts“toŽ¡‘Çathe–7function“named“bš¬ry“its“third.‘ŒWhile“not“strictly“necessary‘ÿV,‘the“functionalit˜y“pro˜videdŽ¡‘Çabš¬ry–ê¨Ünew_syntax_block“Ömak˜es“input“to“the“generated“parser“visually“more“appSŽealing.Ž ŽùŸ‘Ça ÿ~£c‰ffÇ I ø_žÌÍŸYœ„ü¹:ff ÿ7u‘ÌÍÓ%–¿ªGenerated“parser“load“fileŽ¤‘L!First–¿ªload“some“basic“definitions:“%Ž© ‘ÌÍloadf‘¿ª`/usr/groups/hol/hol2/Library/parser/general`;;Ž¡‘ÌÍ%–¿ªInsert“any“other“files“you“want“loaded“here:“%Ž¦‘ÌÍloadf‘¿ª`types_help`;;Ž¡‘ÌÍ%–¿ªNow“load“the“declarations:“%Ž¦‘ÌÍloadf‘¿ª`types_decls`;;Ž¡‘ÌÍ%–¿ªFinally“load“in“the“function“definitions:“%Ž¦‘ÌÍloadf‘¿ª`types`;;Ž¡‘ÌÍlet–¿ªSEPS“=“[(`(`,[]);(`)`,[]);(`#`,[]);(`-`,[`>`]);(`+`,[]);(`,`,[])];;Ž¡‘ÌÍlet–¿ªparse“thing“=“hd“(PARSE_text(thing,[],SEPS));;Ž¡‘ÌÍnew_syntax_block(`<<`,`>>`,`parse`);;ŽŽ’Æq°„ü¹:ffŽŽŸÀ‰ffÇ IŽŽŽ Nõ‘(ðÖThe–xÒcš¬rhanges“to“the“generated“ÜMakefile“Ö(ÜMakefile.typesÖ)“are“less“extensiv˜e.‘îW‘ÿVe“ha˜v˜eŽ¡‘Çaadded–lÖa“rule“to“deal“with“the“compilation“of“the“ le“of“action“functions.‘ïThe“new“rule“hasŽ¡‘Çathen–JÇbSŽeen“linkš¬red“in˜to“the“depSŽendencies“of“the“parser's“compilation“through“its“inclusionŽ¡‘Çaon–ê¨the“ob‘§ject“list“of“Ütypes_decls_ml.oÖ.ŽŽŽŒ‹žÂ ÌU ýFÓŸú™š‘êñëÛ14’ÿNÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß þiX‘êñë ÿ/‰ffÇ I ÇvÌÍŸYœ„ËÏ¡ff þ?7u‘ÌÍÓ#–¿ªGenerated“parser“MakefileŽ¤‘ÌÍ#–¿ªVersion“of“HOL“to“be“used:Ž© ‘ÌÍHOL=/usr/groups/hol/hol2/holŽ¡‘ÌÍ#–¿ªGeneral“definitions“for“all“generated“parsers:Ž¦‘ÌÍGENERAL=/usr/groups/hol/hol2/Library/parser/generalŽ¡‘ÌÍ#–¿ªInsert“entries“for“user-defined“stuff“here:Ž¦‘ÌÍ#–¿ªRemember“to“insert“the“appropriate“dependencies“and“"load"'s“below.Ž¦‘ÌÍtypes_help_ml.o:‘¿ªtypes_help.mlŽ¦‘ÌÍecho‘¿ª'set_flag(`abort_when_fail`,true);;'\Ž¦‘"‹'loadf‘¿ª`$(GENERAL)`;;'\Ž¦‘"‹'compilet‘¿ª`types_help`;;'\Ž¦‘"‹'quit();;'–¿ª|“$(HOL)Ž¡‘ÌÍ#–¿ªNow“compile“the“declarations:Ž¦‘ÌÍtypes_decls_ml.o:–¿ªtypes_decls.ml“types_help_ml.oŽ¦‘ÌÍecho‘¿ª'set_flag(`abort_when_fail`,true);;'\Ž¦‘"‹'loadf‘¿ª`$(GENERAL)`;;'\Ž¦‘"‹'loadf‘¿ª`types_help`;;'\Ž¦‘"‹'compilet‘¿ª`types_decls`;;'\Ž¦‘"‹'quit();;'–¿ª|“$(HOL)Ž¡‘ÌÍ#–¿ªFinally“do“the“actual“functionsŽ¦‘ÌÍtypes_ml.o:–¿ªtypes.ml“types_decls_ml.oŽ¦‘ÌÍecho‘¿ª'set_flag(`abort_when_fail`,true);;'\Ž¦‘"‹'loadf‘¿ª`$(GENERAL)`;;'\Ž¦‘"‹'loadf‘¿ª`types_help`;;'\Ž¦‘"‹'loadf‘¿ª`types_decls`;;'\Ž¦‘"‹'compilet‘¿ª`types`;;'\Ž¦‘"‹'quit();;'–¿ª|“$(HOL)Ž¡‘ÌÍall:‘¿ªtypes_ml.oŽ¦‘ÌÍ@echo–¿ª'===>“Parser“"types"“built.'ŽŽ’Æq°„ËÏ¡ffŽŽŸÀ‰ffÇ IŽŽŽ ?b{‘êñëÛ1.8.2.4Ž‘±ëRunning–€the“Generated“P arserŽŸ+ÿ.‘êñëÖRunning–Qthe“parser“is“the“m•¬ruc“h–Qsame“as“for“the“BoSŽolean“logic“example.‘ÉÃThe“only“signi can¬rtŽ¤€‘êñëcš¬rhange–Uis“in“the“moSŽde“of“input,‘swhic˜h“has“bSŽeen“pro˜vided“b˜y“Ünew_syntax_blockÖ.‘The“ rstŽ¡‘êñëpart–Z.of“the“folloš¬rwing“session“deals“with“loading“in“the“generated“parser“in˜to“the“ÍHOLŽ¡‘êñëÖsystem,–ê¨and“presen¬rts“an“example“input.ŽŽŽŒ‹©× ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Examples’aµó15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý¸æ~‘ÇaŸÇP ‰ffÇ IŸgQÌÍŸYœ„k_íffŸž÷!’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#loadf‘¿ª`loader`;;Ž¤ ‘ÌÍ...................................................................()–¿ª:“voidŽ©‘ÌÍ#":bool";;Ž¡‘ÌÍ":bool"–¿ª:“typeŽ¦‘ÌÍ#<<–¿ªbool“>>;;Ž¡‘ÌÍ":bool"–¿ª:“typeŽŽ’Æq°„k_íffŽŽŸÀ‰ffÇ IŽŽŽŸGâú‘(ðÖSince–èÛwš¬re“ha˜v˜e“re-implemen˜ted“the“ÍHOL“Öt˜ypSŽe“parser,‘(gw˜e“ha˜v˜e“ev˜ery“reason“to“expSŽectŽ¤€‘Çathat–z\our“parser“constructs“tš¬rypSŽes“that“are“indistinguishable“from“those“created“b˜y“theŽ¡‘Çasystem.‘`W‘ÿVe–÷çshould“also“anš¬rticipate“that“our“parser“will“not“construct“in˜v‘ÿXäalid“t˜ypSŽes,‘û7whileŽ¡‘Çaat–ù1the“same“time“remaining“sensitivš¬re“to“an˜y“additional“ones“created“b˜y“the“user.‘dzTheŽ¡‘Çacon•¬rtin“uation–)of“the“previous“session“demonstrates“these“propSŽerties.‘õ˜Also“sho¬rwn“is“theŽ¡‘Çaw•¬ra“y–Fin“whicš¬rh“the“ÜSEPS‘E¿Ölist“(declared“in“the“load“ le)“pSŽermits“a“more“natural“st˜yle“ofŽ¡‘Çainput.Ž ½. ‘Ça ÿRP ‰ffÇ I QQÌÍŸYœ„U_íff þ´÷!’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#":((*–¿ª#“(ind“->“bool))list“list“+“*list“#“*“list“->“*)list";;Ž¤ ‘ÌÍ":(((*–¿ª#“(ind“->“bool))list)list“+“*list“#“(*)list“->“*)list"“:“typeŽ©‘ÌÍ#<<–¿ª((*“#“(ind“->“bool))list“list“+“*list“#“*“list“->“*)list“>>;;Ž¡‘ÌÍ":(((*–¿ª#“(ind“->“bool))list)list“+“*list“#“(*)list“->“*)list"“:“typeŽ¦‘ÌÍ#":((bool,ind)fun,(*,*1)prod)sum";;Ž¡‘ÌÍ":(bool–¿ª->“ind)“+“*“#“*1"“:“typeŽ¦‘ÌÍ#<<–¿ª((bool,ind)fun,(*,*1)prod)sum“>>;;Ž¡‘ÌÍ":(bool–¿ª->“ind)“+“*“#“*1"“:“typeŽ¦‘ÌÍ#":(bool,ind,*)tri";;Ž¡‘ÌÍevaluation–¿ªfailed‘¾Rmk_type“in“quotationŽ¦‘ÌÍ#<<–¿ª(bool,ind,*)tri“>>;;Ž¡‘ÌÍevaluation‘¿ªfailed‘¾RfailŽ¦‘ÌÍ#new_theory`tri`;–¿ªnew_type“3“`tri`;;Ž¡‘ÌÍ()–¿ª:“voidŽ¦‘ÌÍ#":(bool,ind,*)tri";;Ž¡‘ÌÍ":(bool,ind,*)tri"–¿ª:“typeŽ¦‘ÌÍ#<<–¿ª(bool,ind,*)tri“>>;;Ž¡‘ÌÍ":(bool,ind,*)tri"–¿ª:“typeŽŽ’Æq°„U_íffŽŽŸÀ‰ffÇ IŽŽŽ Å¯á‘Çaâ1.8.3Ž‘E`âBlouÂcŠ=ksŽŸØž‘ÇaÖHere–P wš¬re“demonstrate“the“use“of“the“bloSŽc˜k“declarations“ÜIGNORE‘ŸäÖand“ÜUSEFUL‘OòÖ.“While“theŽ¡‘Çagrammar–Mˆwill“bšSŽe“trivial,‘¦Athe“concept“it“sho¬rws“is“imp˜ortanš¬rt.‘ aW‘ÿVe“will“only“presen˜t“theŽŽŽŒ‹±6 ÌU ýFÓŸú™š‘êñëÛ16’ÿNÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖgrammar,‘vgand–Ztexamples“of“the“generated“parser.‘ˆEThe“generation“proSŽcess“is“the“same“asŽ¤€‘êñëfor–ê¨the“previous“examples.ŽŸÔ"‘êñëÛ1.8.3.1Ž‘±ëThe‘€GrammarŽ©mT‘êñëÖThe–€ªfolloš¬rwing“grammar“sho˜ws“the“pattern“of“input“that“is“of“in˜terest.‘‹Note“that“no“spSŽeci-Ž¡‘êñë cation–Å&of“legal“cš¬rharacters“is“giv˜en,‘̦with“the“result“that“no“tok˜en“recogniser“is“generated.Ž¡‘êñëThe–ÛÎÜUSEFUL‘·”Ödeclaration“states“that“all“sequences“of“cš¬rharacters“enclosed“b˜y“single“quotesŽ¡‘êñëshould–õ|bšSŽe“concatenated“in¬rto“a“single“string.‘Y[ÜIGNORE‘ ênÖdescrib˜es“the“blo˜c¬rks“that“can“b˜eŽ¡‘êñëthro•¬rwn›Ía“w“a“y‘ÿV.‘ (PThe˜action˜sym“bSŽol˜is˜a˜standard˜ÍML˜Öfunction˜that˜returns˜t“ypSŽe˜ÜvoidÖ,Ž¡‘êñëwhicš¬rh–ê¨is“also“the“t˜ypSŽe“whic˜h“should“bSŽe“pro˜vided“to“the“generator.ŽŸAž‘êñëŸÌ£c‰ffÇ IŸ\_žÌÍŸYœ„`¹:ffŸ«7u‘ÌÍÓUSEFUL‘¿ª[(`'`,`'`)].Ž¤‘ÌÍIGNORE‘¿ª[(`"`,`"`)].Ž¡‘ÌÍMAIN_LOOP–¿ª-->“foo“[EOF].Ž¡‘ÌÍfoo–¿ª-->“[']“{print_string(WORD)}“[']“foo“|“[].ŽŽ’Æq°„`¹:ffŽŽŸÀ‰ffÇ IŽŽŽŸHly‘êñëÛ1.8.3.2Ž‘±ëRunning–€the“Generated“P arserŽ¦‘êñëÖW‘ÿVe–ê¨proš¬rvide“bSŽelo˜w“some“sample“input“to“the“generated“parser.‘8àIt“pšSŽerforms“as“exp˜ected.ŽŸFñq‘êñëŸÇP ‰ffÇ IŸgQÌÍŸYœ„k_íffŸž÷!’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ#loadf‘¿ª`blocks_load`;;Ž¤ ‘ÌÍ....................................()–¿ª:“voidŽ©‘ÌÍ#PARSE_text(`'a;lsdkfj'`,[],[]);;Ž¡‘ÌÍa;lsdkfj()–¿ª:“voidŽ¦‘ÌÍ#PARSE_text(`'a;lsdkfj'"IIIIII'III"'MMMMM"""'`,[],[]);;Ž¡‘ÌÍa;lsdkfjMMMMM"""()–¿ª:“voidŽŽ’Æq°„k_íffŽŽŸÀ‰ffÇ IŽŽŽŸOj}‘êñëâ1.8.4Ž‘‹lOther‘…ExamplesŽ¦‘êñëÖMore–°_examples“are“proš¬rvided“in“the“ÜExamples“Ödirectory“distributed“with“the“curren˜t“v˜ersionŽ¡‘êñëof–$‚the“generator.‘æmSee“the“ÜREAD-ME‘$sÖ le“assoSŽciated“with“eac¬rh“for“a“brief“description“of“theŽ¡‘êñëfeatures.‘8àThese–ê¨additional“examples“are:Ž¤ït‘üqÚØŽŽŽ‘Q×ÜExamples/HOL–ê¨Ö|“A“subset“of“the“ÍHOL“Öterm“parser.Ž¡‘üqÚØŽŽŽ‘Q×ÜExamples/ella–ê¨Ö|“A“parser“for“the“the“ÍELLA“Öhardw¬rare“description“language.Ž¡‘üqÚØŽŽŽ‘Q×ÜExamples/tiny–±Ö|“A‘wfor“the“programming“language“from“the“Üprog_logic88“Ölibrary‘ÿV.Ž¡‘üqÚØŽŽŽ‘Q×ÜExamples/user_guide–ê¨Ö|“Examples“used“in“this“doSŽcumen¬rt:ŽŸïu‘‹`Û{ŽŽŽ‘"+\Üblocks–ê¨Ö|“The“use“of“ÜUSEFUL‘ÕPÖand“ÜIGNORE“Ö.ŽŽŽŒ‹º‚ ÌU ýFÓŸú™š‘ÇaÛ1.8.‘ €Examples’aµó17Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘=`Ö{ŽŽŽ‘JÒÜbool–ê¨Ö|“BoSŽolean“logic.ŽŸ€‘=`ÖÛ{ŽŽŽ‘JÒÜtypes–ê¨Ö|“The“ÍHOL“Öt¬rypSŽe“parser.ŽŽŽŒ‹Äd ÌU ýFÓŸú™š‘êñëÛ18’ÿNÕChapter–€1.‘ €The“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëç1.9Ž‘5oThe–Ÿ¼P‘ÿr°arser-Generating“LanguageŽŸ{½‘êñëÖThe–YìÍBNF‘YÏÖsynš¬rtax“for“the“parser-generator's“input“grammar“is“describSŽed“b˜y“the“follo˜wingŽ¤ ™š‘êñëproSŽductions.‘hIItems–úvin“Ütypewriter“Öfonš¬rt“are“the“terminal“sym˜bSŽols.‘hIA‘úrcommen˜t“bSŽeginningŽ¡‘êñëand–—¯ending“with“the“cš¬rharacter“Ü%“Öma˜y“appSŽear“an˜ywhere“in“the“grammar“input“to“theŽ¡‘êñëgenerator.Ž G]‘êñë þùt]‰ffÇ I ‰0ÌÍŸ}„­ff þAñžûƒ‘ ÌÍÍgrammar–¦f::=“declarations“prošMÞductions“Ïj“Ípro˜ductions“declarations“Ïj“Ípro˜ductionsŽŽŽŽŽ¡žûƒ‘ ÌÍdeclarations–¦f::=“ rst‘¨/‰ffHøŽ‘ñ'cš²!hars“c˜hars“bloMÞc˜ks“Ïj“Íc˜hars“bloMÞc˜ks“ rst‘¨/‰ffHøŽ‘ñ'c˜hars“Ïj“ÍbloMÞc˜ks“ rst‘¨/‰ffHøŽ‘ñ'c˜hars“c˜harsŽŽŽŽŽ¡žûƒ‘ ÌÍ rst‘¨/‰ffHøŽ›ñ'c²!hars–¦f::=“ÓFIRST_CHARS“Íhol‘¨/‰ffHøŽ˜string“Ó.ŽŽŽŽŽ¡žûƒ‘ ÌÍÍc²!hars–¦f::=“ÓCHARS“Íhol‘¨/‰ffHøŽ‘ñ'string“Ó.ŽŽŽŽŽ¡žûƒ‘ ÌÍÍhol‘¨/‰ffHøŽ‘ñ'string–¦f::=“Ð(a–êêstandar›ÿp¹d“ÍML“Ðstring“of“whitesp˜ac˜e-sep˜ar˜ate˜d“char˜acters)ŽŽŽŽŽ¡žûƒ‘ ÌÍÍbloMÞc²!ks–¦f::=“useful“ignore“Ïj“Íignore“useful“Ïj“Íuseful“Ïj“Íignore“Ïj“ó#  b> ó3 cmmi10ÎŽŽŽŽŽ¡žûƒ‘ ÌÍÍuseful–¦f::=“ÓUSEFUL“ÍassoMÞc‘¨/‰ffHøŽ‘ñ'list“Ó.ŽŽŽŽŽ¡žûƒ‘ ÌÍÍignore–¦f::=“ÓIGNORE“ÍassoMÞc‘¨/‰ffHøŽ‘ñ'list“Ó.ŽŽŽŽŽ¡žûƒ‘ ÌÍÍassoMÞc‘¨/‰ffHøŽ‘ñ'list–¦f::=“Ð(a–êêstandar›ÿp¹d“ÍML“Ðlist“of“typ˜e“(stringÍ#Ðstring))ŽŽŽŽŽŸfeŸù.·‘ ÌÍÍproMÞductionsŽ‘P)„::=Ž‘jà prošMÞduction‘¨/‰ffHøŽ‘ñ'name–¦fÓ-->“Ípro˜duction“pro˜ductionsŽŽŸ ™™‘[¸uÏjŽ‘jà ÎŽŽŽŽŽ¤32Ÿù.·‘ ÌÍÍproMÞductionŽ‘K×Ï::=Ž‘fqkterminal‘¦fprdn‘¨/‰ffHøŽ–ñ'with‘¨/‰ffHøŽ“c²!hoiceŽŽŸ ™™‘WfÀÏjŽ‘fqkÍone‘¨/‰ffHøŽ‘ñ'linerŽŽŽŽŽŸffžûƒ‘ ÌÍterminal–¦f::=“Ó[“Íterminal‘¨/‰ffHøŽ‘ñ'sym²!bMÞol“Ó]ŽŽŽŽŽ¡Ÿòaê‘ ÌÍÍterminal‘¨/‰ffHøŽ‘ñ'sym²!bMÞolŽ‘e¾ñ::=Ž’€XÐ(any–êêalphanumeric“char‘ÿp¹acter)‘¦fÍterminal‘¨/‰ffHøŽ‘ñ'sym²!bMÞolŽŽ¤ ™™‘qMâÏjŽ’€XÓ\›¦fÍsp•MÞecial‘¨/‰ffHøŽ‘ñ'sym²!b“ol˜terminal‘¨/‰ffHøŽ‘ñ'sym²!b“olŽŽ¡‘qMâÏjŽ’€XÎŽŽŽŽŽ¡žûƒ‘ ÌÍÍsp•MÞecial‘¨/‰ffHøŽ‘ñ'sym²!b“ol–¦f::=“Ó{“Ïj“Ó}“Ïj“Ó\“Ïj“Ó[“Ïj“Ó]ŽŽŽŽŽ¤ ™šžûƒ‘ ÌÍÍproMÞduction‘¨/‰ffHøŽ›ñ'name–¦f::=“lead‘¨/‰ffHøŽ˜c²!har“Ð(any›êêse–ÿp¹quenc“e˜of˜alphanumeric˜char“acters)ŽŽŽŽŽ¡žûƒ‘ ÌÍÍlead‘¨/‰ffHøŽ‘ñ'c²!har–¦f::=“Ð(any–êêalphab›ÿp¹etic“char˜acter)ŽŽŽŽŽ¡žûƒ‘ ÌÍÍaction‘¨/‰ffHøŽ›ñ'sym²!bMÞol–¦f::=“Ïf“Íaction‘¨/‰ffHøŽ˜name“optional‘¨/‰ffHøŽ˜args“ÏgŽŽŽŽŽ¡žûƒ‘ ÌÍÍoptional‘¨/‰ffHøŽ‘ñ'args–¦f::=“Ó(“Íargs“Ó)“Ïj“ÎŽŽŽŽŽ¡žûƒ‘ ÌÍÍaction‘¨/‰ffHøŽ›ñ'name–¦f::=“lead‘¨/‰ffHøŽ˜c²!har“Ð(any›êêse–ÿp¹quenc“e˜of˜alphanumeric˜char“acters)ŽŽŽŽŽ¡žûƒ‘ ÌÍÍargs–¦f::=“arg“Ó,“Íargs“Ïj“ÍargŽŽŽŽŽŸ)ÌËŸäÈQ‘ ÌÍargŽ‘' í::=Ž‘A£‰ÓTOKENŽŽ¤ ™™‘2˜ÞÏjŽ‘A£‰ÓWORDŽŽ¡‘2˜ÞÏjŽ‘A£‰ÓPOPŽŽ¡‘2˜ÞÏjŽ‘A£‰ÍproMÞduction‘¨/‰ffHøŽ‘ñ'nameŽŽ¡‘2˜ÞÏjŽ‘A£‰Ð(‘ §ÍHOL–êêÐstring“or“term)ŽŽŽŽŽŸDÿýŸäÈQ‘ ÌÍÍprdn‘¨/‰ffHøŽ–ñ'with‘¨/‰ffHøŽ“c²!hoiceŽ‘hi ::=Ž’ƒ¨terminal‘¦fprdn‘¨/‰ffHøŽ–ñ'with‘¨/‰ffHøŽ“c²!hoiceŽŽ¤ ™™‘s÷ýÏjŽ’ƒ¨Íaction‘¨/‰ffHøŽ–ñ'symš²!bMÞol‘¦fprdn‘¨/‰ffHøŽ“with‘¨/‰ffHøŽ“c˜hoiceŽŽ¡‘s÷ýÏjŽ’ƒ¨ÍproMÞduction‘¨/‰ffHøŽ–ñ'name‘¦fprdn‘¨/‰ffHøŽ“with‘¨/‰ffHøŽ“c²!hoiceŽŽ¡‘s÷ýÏjŽ’ƒ¨Ó|‘¦fÍprdn‘¨/‰ffHøŽ–ñ'with‘¨/‰ffHøŽ“c²!hoiceŽŽ¡‘s÷ýÏjŽ’ƒ¨Ó.ŽŽŽŽŽŸ7fdŸòaê‘ ÌÍÍone‘¨/‰ffHøŽ‘ñ'linerŽ‘A}8::=Ž‘\Ôaction‘¨/‰ffHøŽ–ñ'sym²!bMÞol‘¦fone‘¨/‰ffHøŽ“linerŽŽ¤ ™™‘M )ÏjŽ‘\ÔÍproMÞduction‘¨/‰ffHøŽ–ñ'name‘¦fone‘¨/‰ffHøŽ“linerŽŽ¡‘M )ÏjŽ‘\ÔÓ.ŽŽŽŽŽŽ’Æq°„­ffŽŽŸzã‰ffÇ IŽŽŽŽŽŒ‹ÅP ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|ŸGëHML– ‰‹F‘ýunctions“in“the“parser“LibraryŽŸÖx‰Ç>|Ÿ:UTÖThis–¬4cš¬rhapter“pro˜vides“doSŽcumen˜tation“on“the“single“ÍML“Öfunction“that“is“made“a˜v‘ÿXäailable“inŽ¤€ÍHOL–O}Öwhen“the“ÓparserŽ‘+öÖlibrary“is“loaded.‘g^This“doSŽcumenš¬rtation“is“also“a˜v‘ÿXäailable“online“viaŽ¡the‘ê¨ÓhelpŽ‘ÓøÖfacilit¬ry‘ÿV.ŽŸ'€Ÿ+WŸê;‰ffÇBXŸÄñÌÍŸÄñ„%‰âffŸïd‘ÌÍóIßê“void)Ž©€âSynopsisŽ¡ÖT‘ÿVop-levš¬rel–ê¨function“to“in˜v˜ok˜e“the“parser-generator.Ž¦âDescriptionŽ¡ÖThe–éfunction“in•¬rv“ok“es–éthe“parser-generator.‘8YThe“generator“prompts“for“v‘ÿXäarious“input“ lesŽ¡and‘ê¨t¬rypSŽes.Ž¦âF‘þž¸ailureŽ¡ÖF‘ÿVails–g{if“there“is“an“error“in“the“input“grammar“that“spšSŽeci es“the“op˜eration“of“the“parser“toŽ¡bšSŽe–rugenerated.‘ÏA‘rVdescriptiv¬re“message“is“pro˜duced“to“help“pinp˜oin¬rt“the“cause“of“the“failure.Ž¦âExampleŽŸ™šÓ#parse();;Ž¤ ™šInput‘¿ªfile:‘ Tfoo.grmŽ¡Output–¿ªfile:“fooŽ¡Opening–¿ªthe“file“foo.ml“(MAIN“OUTPUT)Ž¡Opening–¿ªthe“file“foo_decls.ml“(DECLARATIONS)Ž¡Load–¿ªthe“declarations“file“before“the“main“output.Ž¡See–¿ªthe“file“foo_load.ml“for“a“sample.Ž¡See–¿ªthe“file“./Makefile.foo“for“a“sample“Makefile.Ž¡Output–¿ªtype:“*ŽŽŸ$ý’烈Û19ŽŽŒ‹Ô‘ ÌU ýFÓŸú™š‘êñëÛ20’œØChapter–€2.‘ €ML“F‘þàunctions“in“the“parser“LibraryŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹Ú ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…3Ž‘ÇaŸ Ì̉Ç>|ŸGëHPre-pro–ÿ4‰v“ed‘ ‰‹TheoremsŽŸÖx‰Ç>|ŽŸ$ý’烈Û21ŽŽŒ‹Ú³ ÌU ýFÓŸú™š‘êñëÛ22’ðD,Chapter›€3.‘ €Pre-pro• v“ed˜TheoremsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹Û[ ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|ŸGëHReferencesŽŸ‰Ç>|Ÿ;‘ßüÖ[1]ŽŽ‘' L.–P%Sterling“and“E.“Shapiro,‘i„ÙThe–~A³2rt“of“Pr–ÿffolo“g:‘ ûA“dvanc“e“d›~Pr“o“gr“amming˜T‘ÿ™e“chniquesÖ,ŽŸ€‘' ÍMIT–ê¨ÖPress,“1986.ŽŸ€‘ßü[2]ŽŽ‘' C.N.–ÜnFisc¬rher“and“R.J.“LeBlanc,–yJr.,“ÙCr‘ÿffafting–:Òa“CompilerÖ,–yBenjamin/Cummings,“1988.ŽŽŸ$ý’烈Û23ŽŽŒ‹Ûë ÌU ýFÓ ”/ß ýáä‘êñ럳¸ä‰Ç>|ŸGëHIndexŽŸ‰Ç>|Ž ø þä‘êñëÖaction–ê¨sym¬rbSŽols,“9Ž©tã‘êñëÜCHARSÖ,–ê¨2,“8,“9Ž¤€‘êñëÜchop_offÖ,‘ê¨9Ž¡‘êñëÜclose_fileÖ,‘ê¨9Ž¡‘êñëÜcomplete_separatorÖ,‘ê¨9Ž¦‘êñëÜdebug_enterÖ,‘ê¨9Ž¡‘êñëÜdebug_offÖ,–ê¨5,“9Ž¡‘êñëÜdebug_onÖ,–ê¨5,“9Ž¡‘êñëÜdebug_returnÖ,‘ê¨9Ž¡‘êñëdebugging,‘ê¨5Ž¡‘êñëÜdeterimine_lstÖ,‘ê¨9Ž¡‘êñëÜdo_returnÖ,‘ê¨9Ž¡‘êñëÜdo_return_1Ö,‘ê¨9Ž¦‘êñëÜe_w_s_okÖ,‘ê¨9Ž¡‘êñëÜe_w_sÖ,‘ê¨9Ž¡‘êñëÜeat_terminalÖ,‘ê¨9Ž¡‘êñëÜEOFÖ,–ê¨2,“7Ž¡‘êñëerror–ê¨messages,“5,“6,“10Ž¦‘êñëÜFIRST_CHARSÖ,–ê¨2,“8,“9Ž¡‘êñëÜFIRST_CHARS–ê¨Ö,“8Ž¦‘êñëÜget_wordÖ,‘ê¨9Ž¡‘êñëÜget_word1Ö,‘ê¨9Ž¡‘êñëÜget_word2Ö,‘ê¨9Ž¡‘êñëÜgntÖ,‘ê¨9Ž¦‘êñëÜIGNOREÖ,–ê¨8,“15,“16Ž¦‘êñëÜMAIN_LOOPÖ,–ê¨2,“3,“7{9Ž¦‘êñëÜopen_fileÖ,‘ê¨9Ž¦‘êñëÜparseÖ,–ê¨2,“13,“19Ž¡‘êñëÜPARSE_fileÖ,–ê¨3,“8,“9Ž¡‘êñëÜPARSE_textÖ,–ê¨3,“5,“9,“13ŽŽŽ þä’à)ÜPOPÖ,–ê¨7,“8,“10Ž¤€’à)ÜpopÖ,‘ê¨9Ž¡’à)ÜpushÖ,‘ê¨9Ž©€’à)Üread_charÖ,‘ê¨9Ž¡’à)Üread_inputÖ,‘ê¨9Ž¦’à)ÜTOKENÖ,‘ê¨8{10Ž¡’à)ÜTOKEN_1Ö,‘ê¨9Ž¦’à)ÜUSEFULÖ,–ê¨8,“15,“16Ž¦’à)ÜWORDÖ,‘ê¨8Ž¡’à)Üwrite_stringÖ,‘ê¨9ŽŽŽŽŽŽŸ$ý’ÇÑ)Û24ŽŽŒøÝŽƒ’À;èÌUÚÝóIßê ó3 cmmi10ó"Kñ`y ó3 cmr10óp®0J cmsl10ùâEßßßßhol88-2.02.19940316/Library/parser/Manual/parser.toc0000640000212700021270000000322405535604607020057 0ustar cammcamm\contentsline {chapter}{\numberline {1}The parser Library}{1} \contentsline {section}{\numberline {1.1}Introduction}{1} \contentsline {section}{\numberline {1.2}Syntax}{1} \contentsline {section}{\numberline {1.3}Generating Parsers}{2} \contentsline {subsection}{\numberline {1.3.1}Auxiliary Files}{3} \contentsline {subsection}{\numberline {1.3.2}Running the Generated Parser}{5} \contentsline {section}{\numberline {1.4}Error Messages}{6} \contentsline {section}{\numberline {1.5}Internals}{6} \contentsline {section}{\numberline {1.6}Reserved Words}{7} \contentsline {section}{\numberline {1.7}Action Symbols}{9} \contentsline {section}{\numberline {1.8}Examples}{10} \contentsline {subsection}{\numberline {1.8.1}Terminal Input and Errors}{10} \contentsline {subsection}{\numberline {1.8.2}HOL Types}{11} \contentsline {subsubsection}{\numberline {1.8.2.1}The Grammar}{11} \contentsline {subsubsection}{\numberline {1.8.2.2}Running the Generator}{12} \contentsline {subsubsection}{\numberline {1.8.2.3}Auxiliary Files}{12} \contentsline {subsubsection}{\numberline {1.8.2.4}Running the Generated Parser}{14} \contentsline {subsection}{\numberline {1.8.3}Blocks}{15} \contentsline {subsubsection}{\numberline {1.8.3.1}The Grammar}{16} \contentsline {subsubsection}{\numberline {1.8.3.2}Running the Generated Parser}{16} \contentsline {subsection}{\numberline {1.8.4}Other Examples}{16} \contentsline {section}{\numberline {1.9}The Parser-Generating Language}{18} \contentsline {chapter}{\numberline {2}ML Functions in the parser Library}{19} \contentsline {chapter}{\numberline {3}Pre-proved Theorems}{21} \contentsline {chapter}{References}{23} \contentsline {chapter}{Index}{24} hol88-2.02.19940316/Library/parser/Manual/description.aux0000640000212700021270000000627105535604606021122 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {1}The parser Library}{1}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.1}Introduction}{1}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.2}Syntax}{1}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.3}Generating Parsers}{2}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.3.1}Auxiliary Files}{3}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.3.2}Running the Generated Parser}{5}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.4}Error Messages}{6}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.5}Internals}{6}} \newlabel{Internals}{{1.5}{6}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.6}Reserved Words}{7}} \newlabel{reserved}{{1.6}{7}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.7}Action Symbols}{9}} \newlabel{actions}{{1.7}{9}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.8}Examples}{10}} \newlabel{ex}{{1.8}{10}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.8.1}Terminal Input and Errors}{10}} \newlabel{ex:errs}{{1.8.1}{10}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.8.2}HOL Types}{11}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.1}The Grammar}{11}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.2}Running the Generator}{12}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.3}Auxiliary Files}{12}} \newlabel{SEPS}{{1.8.2.3}{12}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.2.4}Running the Generated Parser}{14}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.8.3}Blocks}{15}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.3.1}The Grammar}{16}} \@writefile{toc}{\string\contentsline\space {subsubsection}{\string\numberline\space {1.8.3.2}Running the Generated Parser}{16}} \@writefile{toc}{\string\contentsline\space {subsection}{\string\numberline\space {1.8.4}Other Examples}{16}} \@writefile{toc}{\string\contentsline\space {section}{\string\numberline\space {1.9}The Parser-Generating Language}{18}} \newlabel{BNFsec}{{1.9}{18}} \global\@namedef{cp@description}{ \setcounter{page}{19} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{1} \setcounter{section}{9} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/parser/Manual/entries.aux0000640000212700021270000000133705535604606020246 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {2}ML Functions in the parser Library}{19}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \global\@namedef{cp@entries}{ \setcounter{page}{20} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{2} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/parser/Manual/theorems.aux0000640000212700021270000000132105535604606020414 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{\string\numberline\space {3}Pre-proved Theorems}{21}} \@writefile{lof}{\string\addvspace\space {10\p@ }} \@writefile{lot}{\string\addvspace\space {10\p@ }} \global\@namedef{cp@theorems}{ \setcounter{page}{22} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/parser/Manual/references.aux0000640000212700021270000000116205535604607020713 0ustar cammcamm\relax \bibcite{shapiro}{1} \bibcite{fischer}{2} \@writefile{toc}{\string\contentsline\space {chapter}{References}{23}} \global\@namedef{cp@references}{ \setcounter{page}{24} \setcounter{equation}{0} \setcounter{enumi}{2} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/parser/Manual/index.aux0000640000212700021270000000107605535604607017705 0ustar cammcamm\relax \@writefile{toc}{\string\contentsline\space {chapter}{Index}{24}} \global\@namedef{cp@index}{ \setcounter{page}{25} \setcounter{equation}{0} \setcounter{enumi}{2} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{3} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{2} } hol88-2.02.19940316/Library/parser/Manual/Makefile0000640000212700021270000000336505267277407017530 0ustar cammcamm# ===================================================================== # Makefile for the parser library documentation # ===================================================================== # --------------------------------------------------------------------- # Pathname to the parser help files # --------------------------------------------------------------------- Help=../help # --------------------------------------------------------------------- # Pathname to the doc-to-tex script and doc-to-tex.sed file # --------------------------------------------------------------------- DOCTOTEX=../../../Manual/Reference/bin/doc-to-tex DOCTOTEXSED=../../../Manual/Reference/bin/doc-to-tex.sed # --------------------------------------------------------------------- # Pathname to the makeindex script # --------------------------------------------------------------------- MAKEINDEX=../../../Manual/LaTeX/makeindex ../../../ default: @echo "INSTRUCTIONS: Type \"make all\" to make the documentation" # --------------------------------------------------------------------- # Remove all trace of previous LaTeX jobs # --------------------------------------------------------------------- clean: rm -f *.dvi *.aux *.toc *.log *.idx *.ilg @echo "\begin{theindex}" > index.tex @echo "\mbox{}" >> index.tex @echo "\end{theindex}" >> index.tex tex: ids theorems @echo "TeX files made" ids: @echo "\chapter{ML Functions in the parser Library}">entries.tex @echo "\input{entries-intro}" >> entries.tex /bin/sh ${DOCTOTEX} ${DOCTOTEXSED} ${Help}/entries entries.tex theorems: @echo "\chapter{Pre-proved Theorems}" > theorems.tex index: ${MAKEINDEX} parser.idx index.tex parser: latex parser.tex all: make clean; make tex; make parser; make index; make parser hol88-2.02.19940316/Library/parser/Manual/description.tex0000640000212700021270000012637205034563601021123 0ustar cammcamm\chapter{The parser Library} \begin{quote} \it That which can be conceived can be created. \rm -- Enzo Ferrari \end{quote} \section{Introduction} We describe a generic parser-generator to aid in the embedding of languages in \HOL. The need for such a tool is becoming readily apparent as support for various languages in \HOL\ has either been implemented or is in progress. The parser-generator described in this document was written to fulfill the needs of various projects underway in the Computer Laboratory dealing with either hardware description or programming languages. The input to the generator is a form of modified {\small BNF} notation consisting of terminals, non-terminals, and action symbols. Users familiar with the definite clause grammar ({\small DCG}) notation of Prolog will see similarities here. This input is not, however, a full attribute grammar, and may originate either from the user's terminal or a file. The output of the generator is an \ML\ program that builds an object of user-defined type from input that meets the syntax specified by the grammar. The discussion of the generator that follows will first cover the syntax of the input language. An overview of the translation process will then be delivered. It will be followed by a presentation of the generator's reserved words, and an exposition of the construction of action symbols. We will conclude with some extended examples to demonstrate the use of the parser-generator. \section{Syntax} The generator is meant to deal with non left-recursive context free grammars. There is no checking for left-recursion, and any input employing it will necessarily cause an infinite loop to be generated. Action symbols are then embedded in the grammar to construct the user's semantics for the syntax. If these symbols are not present, a simple recogniser for the language in question will be created. \newpage As an example, if we wished to specify a grammar for a prefix representation of a subset of Boolean logic, the following {\small BNF} description might be used: \small \begin{center} \begin{boxed} \begin{tabular}{lcl} bool & ::= & term {\it EOF} \\ term & ::= & neg $|$ imp $|$ conj $|$ disj $|$ {\it var} \\ neg & ::= & {\bf NEG} term \\ imp & ::= & {\bf IMP} term term \\ conj & ::= & {\bf CONJ} term term \\ disj & ::= & {\bf DISJ} term term \\ \end{tabular} \end{boxed} \end{center} \normalsize where terminal symbols appear in boldface, {\it var} represents a Boolean variable, and {\it EOF} shows where the end of the input stream should occur. The above grammar may be represented as input to the parser-generator as follows: \small \begin{center} \begin{boxed} \begin{verbatim} FIRST_CHARS `a b`. CHARS `a b c d`. MAIN_LOOP --> term [EOF]. term --> neg | imp | conj | disj | {mk_var(TOKEN,":bool")}. conj --> [CONJ] {mk_conj(term,term)}. disj --> [DISJ] {mk_disj(term,term)}. neg --> [NEG] {mk_neg(term)}. imp --> [IMP] {mk_imp(term,term)}. \end{verbatim} \end{boxed} \end{center} \normalsize \verb"FIRST_CHARS"\autoindex{FIRST\_CHARS@{\ptt FIRST\_CHARS}} and \verb"CHARS"\autoindex{CHARS@{\ptt CHARS}} are declarations which define the legal first and other characters of the language's identifiers. Within the grammar itself, action symbols are enclosed by braces (\verb"{}") whilst terminal symbols are delimited with square brackets (\verb"[]"), and conditional branches are separated by vertical bars (\verb"|"). The non-terminal \verb"MAIN_LOOP"\autoindex{MAIN\_LOOP@{\ptt MAIN\_LOOP}} is a reserved symbol defining the start of the parser. The terminal symbol \verb"EOF"\autoindex{EOF@{\ptt EOF}} is also reserved, and marks where the end of file should occur. The {\small BNF} syntax for the parser-generator's input language is provided in Section~\ref{BNFsec}, and the system's reserved words (including \verb"MAIN_LOOP" and \verb"EOF") are described in Section~\ref{reserved}. \section{Generating Parsers} The parser-generator may be incorporated into the \HOL\ system by loading in the library \verb"parser". Once loaded, the generator is invoked by the function \verb"parse"\autoindex{parse@{\ptt parse}}. Continuing with the Boolean logic example, the following session shows how a parser is generated from the grammar just specified. \setcounter{sessioncount}{1} \small \begin{center} \begin{session} \begin{verbatim} #parse();; Input file: bool.grm Output file: bool Opening the file bool.ml (MAIN OUTPUT) Opening the file bool_decls.ml (DECLARATIONS) Load the declarations file before the main output. See the file bool_load.ml for a sample. See the file ./Makefile.bool for a sample Makefile. Output type: term Generating PARSE_file and PARSE_text (MAIN_LOOP used). () : void #quit();; \end{verbatim} \end{session} \end{center} \normalsize The generator prompts for an input file containing the grammar. It is assumed that the Boolean logic grammar is found in the file \verb"bool.grm". The second file is the beginning of the file name for the output of the generator. Since we want to create a \HOL\ term using the generated parser, the appropritate type is supplied when prompted. The generator keys on the use of the non-terminal \verb"MAIN_LOOP"\autoindex{MAIN\_LOOP@{\ptt MAIN\_LOOP}} to construct two functions to invoke the generated parser. \verb"PARSE_text"\autoindex{PARSE\_text@{\ptt PARSE\_text}} allows target language constructs to be parsed from a \ML\ string. \verb"PARSE_file"\autoindex{PARSE\_file@{\ptt PARSE\_file}} provides the same functionality for input files containing these same objects. \subsection {Auxiliary Files} The first file created by the generator (\verb"bool_load.ml") is one that will load the parts of the newly-constructed parser into the \HOL\ system in the proper order. In the current example, there are no user-specified actions. We therefore have no need to include any files other than the ones output by the parser-generator. The inital file loaded (\verb"general.ml") contains functions used by all generated parsers to provide basic operations. Once these functions have been loaded, declarations for each production are incorporated via the file {\tt bool\_decls.ml}. They are in turn followed by a file holding the functions describing each production ({\tt bool.ml}). The rationale behind the creation of these last two files is discussed in Section~\ref{Internals}. \small \begin{center} \begin{boxed} \begin{verbatim} % Generated parser load file First load some basic definitions: % loadf `/usr/groups/hol/hol2/Library/parser/general`;; % Insert any other files you want loaded here: % % Now load the declarations: % loadf `bool_decls`;; % Finally load in the function definitions: % loadf `bool`;; \end{verbatim} \end{boxed} \end{center} \normalsize No editing of the generated {\tt Makefile} (\verb"./Makefile.bool") is required either. It simply compiles the generated files in the same order that they should be loaded. While compilation is not essential to use the generated parser, it is recommended. The system will run much faster. In order to make a compiled version of the parser, we need only execute the command \verb"make -f Makefile.bool all" at the Unix prompt. \small \begin{center} \begin{boxed} \begin{verbatim} # Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol2/hol # General definitions for all generated parsers: GENERAL=/usr/groups/hol/hol2/Library/parser/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. # Now compile the declarations: bool_decls_ml.o: bool_decls.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `bool_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions bool_ml.o: bool.ml bool_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `bool_decls`;;'\ 'compilet `bool`;;'\ 'quit();;' | $(HOL) all: bool_ml.o @echo '===> Parser "bool" built. \end{verbatim} \end{boxed} \end{center} \normalsize {\bf NB:} Both the load and make files are created every time the generator is run. It is therefore advisable to save a copy of each once their contents has been fixed. \subsection{Running the Generated Parser} We use the generated load file to install the parser in the \HOL\ system. Note that the parser-generator is no longer needed. Invoking the function \verb"PARSE_text"\autoindex{PARSE\_text@{\ptt PARSE\_text}} will then run the parser on the desired input. We have supplied a null list as both the second and third arguments to \verb"PARSE_text"\autoindex{PARSE\_text@{\ptt PARSE\_text}}. The result is that only the default whitespace list (space, tab, and newline) is used to separate tokens. We will fully describe the nature of these arguments in Section~\ref{reserved}, and an example their use appears in Section~\ref{SEPS}. \setcounter{sessioncount}{1} \small \begin{center} \begin{session} \begin{verbatim} #loadf `bool_load`;; ................................................() : void #PARSE_text(`IMP CONJ a b CONJ b a`,[],[]);; "a /\ b ==> b /\ a" : term \end{verbatim} \end{session} \end{center} \normalsize We now introduce an error\autoindex{errors@error\ messages} in the input to demonstrate the use of the debugging\autoindex{debugging@debugging} features of the system. The function \verb"debug_on"\autoindex{debug\_on@{\ptt debug\_on}} puts the parser into debugging mode, and returns the previous debug state. Its converse is \verb"debug_off"\autoindex{debug\_off@{\ptt debug\_off}}. \small \begin{center} \begin{session} \begin{verbatim} #PARSE_text(`IMP CON a b CONJ b a`,[],[]);; evaluation failed fail #debug_on();; false : bool #PARSE_text (`IMP CON a b CONJ b a`,[],[]);; ENTERING prdn "MAIN_LOOP": Curr. Token = "IMP"; Expected = "nil". ENTERING prdn "term": Curr. Token = "IMP"; Expected = "nil". ENTERING prdn "neg": Curr. Token = "IMP"; Expected = "nil". ENTERING prdn "imp": Curr. Token = "IMP"; Expected = "nil". ENTERING prdn "term": Curr. Token = "CON"; Expected = "nil". ENTERING prdn "neg": Curr. Token = "CON"; Expected = "nil". ENTERING prdn "imp": Curr. Token = "CON"; Expected = "nil". ENTERING prdn "conj": Curr. Token = "CON"; Expected = "nil". ENTERING prdn "disj": Curr. Token = "CON"; Expected = "nil". ENTERING prdn "conj": Curr. Token = "IMP"; Expected = "nil". ENTERING prdn "disj": Curr. Token = "IMP"; Expected = "nil". evaluation failed fail #debug_off();; true : bool #PARSE_text(`IMP CONJ a b CONJ b a`,[],[]);; "a /\ b ==> b /\ a" : term \end{verbatim} \end{session} \end{center} \normalsize The only mysterious part of the debugger is the \verb"Expected" statement. It shows the character or language construct that should immediately follow the string currently being parsed. \verb"nil" represents a ``don't care'' case. \section{Error Messages} The parser-generator is quite sensitive to the context in which an error\autoindex{errors@error\ messages} within the input grammar appears. Should an error be present, a message of the following form will occur. \begin{center} \begin{boxed} \verb+ERROR: symbol "+{\it symbol}$\;$\verb+" encountered in the wrong place.+ \\ \hspace*{4ex}\verb+-- Production: +{\it production} \\ \hspace*{4ex}\verb+-- Diagnostic: +{\it reason} \end{boxed} \end{center} {\it symbol} is the token that caused the error, {\it production} is the production in which it occurred, and {\it reason} is the reason that the parser-generator thinks might have caused the error. \section{Internals}\label{Internals} We now present a short discussion of the internals of the parser-generator, as well as the design decisions that were made. The following were the main goals during the development of the generator. \begin{itemize} \item The order in which productions are specified should not be important \item Mutual recursion of productions should be allowed. \item Non-determinism within a given production should be possible (i.e. not just regular grammars). \item The output of any generated parser should be an object of user-defined type. \item The generator ought to operate in one pass. \end{itemize} Obstacles were presented to the first two of these goals by the way in which \ML\ functions are declared and used. The difficulty is based on the fact that functions may not be used before they are defined, otherwise typechecking becomes problematic. As an illustration, if production {\it A} was to reference production {\it B}, then the function describing {\it B} must be defined in the \ML\ system before the one specifying {\it A}. The result, therefore, is that production {\it B} would have to appear in the input grammar before production {\it A}. Even if the restriction of confining the user to a particular ordering of productions was adopted, it would still be insufficient to deal with the case where {\it A} and {\it B} are mutually recursive. The use of a gigantic {\tt let}--{\tt and} in \ML\ would take care of the mutual recursion problem, but does not allow for the operation to be spread accross multiple files should one decide to structure one's grammar in that manner. To overcome these problems, the following translation scheme was developed: \begin{itemize} \item Each production specified by the user generates two objects, each in a separate file. \item Objects in the first file are \ML\ {\tt letref} declarations specifying the input and output types of the function that will be generated. \item Objects in the second file are $\lambda$-expressions representing the functions that describe the productions. \item Objects from the second file are bound to objects in the first file via assignment. \item When a generated parser is compiled, the file containing the declarations is loaded first. The one containing the $\lambda$-expressions and their assignments to an object from the first file is loaded afterwards. \end{itemize} The result of the above process is that all functions are declared before they are used. The productions that the user specifies may therefore reference each other in any order. Furthermore, should the user wish to describe a parser in many files, the productions may reference each other across those files. The proviso is, of course, that all generated declarations are loaded into the system first when the generated parser is run. Each generated parser maintains an internal stack of intermediate results. It is simply a list of \ML\ objects of a user-defined type that have been built up during the course of the parser's execution. This results stack is the only method of building the final object that is returned to the user, and is accessed via the \verb"POP"\autoindex{POP@{\ptt POP}} reserved symbol mentioned in Section~\ref{reserved} and described in Section~\ref{actions}. It is modified through action symbols that the user imbeds in the grammar. The parser-generator will handle non-determinism in productions. In order to implement this feature, it was necessary to build a backtracking mechanism into all generated parsers. It is based on \ML\ failure-trapping, and simply creates a fail trap for each branch of a production. These traps are guaranteed to be hierarchical in nature by the way in which an input grammar is specified. A one character look-ahead is used to determine if the syntactic object currently being parsed is followed by useful input. If it is not, a failure results, and the backtracking mechanism is invoked. \section{Reserved Words}\label{reserved} The generator makes use of several reserved words. They are all in upper case, and since the parser-generator is case-sensitive, will not conflict with user-defined functions of the same name expressed in either mixed or lower case. \begin{itemize} \item {\small NON-TERMINAL:} $\;$ \begin{itemize} \item \verb"MAIN_LOOP"\autoindex{MAIN\_LOOP@{\ptt MAIN\_LOOP}} \normalsize--- a production that the user specifies to describe the top-level parse loop. The generator senses its presence and outputs two wrappers to call the generated parser in a properly initialised state. It may not be called from within the grammar at any time. \end{itemize} \item {\small TERMINAL:} $\;$ \begin{itemize} \item \verb"EOF"\autoindex{EOF@{\ptt EOF}} \normalsize--- specifies when the end of file may occur. \end{itemize} \item {\small ARGUMENTS:} The following can only appear as arguments to action symbols. Their presence anywhere else in the input grammar will cause a fatal error. Their types are given parenthetically. \begin{itemize} \item \verb"POP"\autoindex{POP@{\ptt POP}} (\verb":"{\it user-defined}) \normalsize--- returns the most recent previously constructed result from the results list. \item \verb"TOKEN"\autoindex{TOKEN@{\ptt TOKEN}} (\verb":string") \normalsize--- returns a legal token identifier as specified using the constructs below. Successive calls to \verb"TOKEN" will cause new identifiers to be obtained from the input source. \item \verb"WORD"\autoindex{WORD@{\ptt WORD}} (\verb":string") \normalsize--- returns the current string in the input stream. No checking of any kind is performed. The construct is particularly useful for dealing with arbitrary objects in the language that the user wants to treat specially. \end{itemize} \item {\small DECLARATIONS:} Both \verb"FIRST_CHARS"\autoindex{FIRST\_CHARS@{\ptt FIRST\_CHARS}} and \verb"CHARS"\autoindex{CHARS@{\ptt CHARS}} below must appear for the parser-generator to construct a tokeniser. If one is present without the other, a fatal error results. They may not be multiply defined within the same grammar. \begin{itemize} \item \verb"FIRST_CHARS"\autoindex{FIRST\_CHARS@{\ptt FIRST\_CHARS} } \normalsize--- Used to specify a whitespace-separated string of characters representing the legal first characters of identifiers. It may not be empty. \item \verb"CHARS"\autoindex{CHARS@{\ptt CHARS}} \normalsize--- Used to specify a whitespace-separated string of characters representing the other legal characters of identifiers. It may not be empty. \item \verb"USEFUL"\autoindex{USEFUL@{\ptt USEFUL}} \normalsize--- Used to tell the generated parser those characters delineating a useful block of text which should be concatenated into a single string. It takes the form of an association list, where each member of the list has the type \verb"(string#string)". The first element of the pair is the character which begins the block, and the second is the one that terminates it. The generator does not check the syntax or type of the list, and it is incumbent upon the user to make sure that it is well-formed. \item \verb"IGNORE"\autoindex{IGNORE@{\ptt IGNORE}} \normalsize-- The converse of \verb"USEFUL". It is an association list of the same form as \verb"USEFUL", but is used to specify the beginning and ending of blocks of text which may be thrown away by generated parser as it is reading in input. The declaration is particularly useful in removing comments from an input stream before it is passed to the parser. \end{itemize} \item {\small FUNCTIONS:} $\;$ \begin{itemize} \item \verb"PARSE_file"\autoindex{PARSE\_file@{\ptt PARSE\_file}} \normalsize --- The first function derived from the production \verb"MAIN_LOOP"\autoindex{MAIN\_LOOP@{\ptt MAIN\_LOOP}}. Its name therefore cannot be used as the name of a non-terminal, or as an argument to an action symbol. The function takes three arguments. The first is the name of the input file, and is a standard \ML\ string. If terminal {\small I/O} is desired, \verb"`nil`" should be supplied. The second argument is of type \verb"string list", and represents the whitespace used by the language. Supplying a null list (\verb"[]") will trigger the use of the default list of blank, tab and newline. The final argument is used to describe special delimiting characters and those that may follow them to make a valid token. It is an association list of type \verb"(string # string list) list" where the first element of each pair is the delimiting character, and the second is the list of following characters. A null following list means that the special character is a token by itself. If a null list is provided as the argument, the only separators used will be those contained in the whitespace list. \item \verb"PARSE_text"\autoindex{PARSE\_text@{\ptt PARSE\_text}} \normalsize --- Another function created by the production \verb"MAIN_LOOP"\autoindex{MAIN\_LOOP@{\ptt MAIN\_LOOP}}. Its arguments are the same as for \verb"PARSE_file"\autoindex{PARSE\_file@{\ptt PARSE\_file}} with the exception of the first one. Here the language constructs to be parsed are directly stated as a \ML\ string. It is important to remember to include the standard escape character in these strings when required. Failure to do so, can cause much frustration. \item \verb"TOKEN"\autoindex{TOKEN@{\ptt TOKEN}} \normalsize--- The name of the generated tokeniser function. \item \verb"TOKEN_1"\autoindex{TOKEN\_1@{\ptt TOKEN\_1}} \normalsize--- The name of a helping function for \verb"TOKEN". \item {\raggedright \verb"chop_off", \verb"close_file", \verb"complete_separator", \verb"debug_enter", \verb"debug_off",\\ \verb"debug_on", \verb"debug_return", \verb"determine_lst", \verb"do_return", \verb"do_return_1",\\ \verb"eat_terminal", \verb"e_w_s", \verb"e_w_s_ok", \verb"get_word", \verb"get_word1", \verb"get_word2", \verb"gnt",\\ \verb"open_file", \verb"pop", \verb"push", \verb"read_char", \verb"read_input", \verb"write_string"} --- These are functions that are used by all generated parsers, and cannot be used as names for the user's action symbols or productions. \autoindex{chop\_off@{\ptt chop\_off}} \autoindex{close\_file@{\ptt close\_file}} \autoindex{complete\_separator@{\ptt complete\_separator}} \autoindex{debug\_enter@{\ptt debug\_enter}} \autoindex{debug\_off@{\ptt debug\_off}} \autoindex{debug\_on@{\ptt debug\_on}} \autoindex{debug\_return@{\ptt debug\_return}} \autoindex{determine\_lst@{\ptt deterimine\_lst}} \autoindex{do\_return@{\ptt do\_return}} \autoindex{do\_return\_1@{\ptt do\_return\_1}} \autoindex{eat\_terminal@{\ptt eat\_terminal}} \autoindex{e\_w\_w@{\ptt e\_w\_s}} \autoindex{e\_w\_s\_ok@{\ptt e\_w\_s\_ok}} \autoindex{get\_word@{\ptt get\_word}} \autoindex{get\_word1@{\ptt get\_word1}} \autoindex{get\_word2@{\ptt get\_word2}} \autoindex{gnt@{\ptt gnt}} \autoindex{open\_file@{\ptt open\_file}} \autoindex{pop@{\ptt pop}} \autoindex{push@{\ptt push}} \autoindex{read\_char@{\ptt read\_char}} \autoindex{read\_input@{\ptt read\_input}} \autoindex{write\_string@{\ptt write\_string}} \end{itemize} \end{itemize} \section{Action Symbols}\label{actions}\autoindex{action@{action\ symbols}} These are specified by the user outside the context of the grammar (i.e. in a separate file). Their arguments may be any of the reserved arguments just mentioned, non-terminals, or actual \ML\ expressions. The parser-generator assumes that these functions exist, and simply creates a call to them. It is up to the user to make sure that the actual functions are well-typed with respect to the generated call. \begin{description} \item[{\small EXAMPLES:}] $\;$ \begin{itemize} \item \verb"{action}" --- Generates a call to the user-defined function {\tt action}. It is assumed that {\tt action} has {\tt ()} as its argument. \item \verb"{action(prdn)}" --- Generates a call to the user-defined function {\tt action}, with the result of the elaboration of the non-terminal {\tt prdn} as its argument. Since the execution of a non-terminal results in an object of user-defined type, the function {\tt action} should reflect this in its specification. \item \verb"{action(prdn1,prdn2)}" --- Same as above. The non-terminals {\tt prdn1} and {\tt prdn2} are evaluated in sequence before the results are passed to {\tt action}. \item \verb"{action(TOKEN)}"\autoindex{TOKEN@{\ptt TOKEN}} --- Evalutates the current input string as an identifier as specified by \verb"FIRST_CHARS"\autoindex{FIRST\_CHARS@{\ptt FIRST\_CHARS}} and \verb"CHARS"\autoindex{CHARS@{\ptt CHARS}} and passes the result to {\tt action}. If there is no current string, one is fetched from the input source. \item \verb"{action(TOKEN,TOKEN)}"\autoindex{TOKEN@{\ptt TOKEN}} --- Same as above. The current string and the next one read from the input source are evaluated as identifiers, and passed to {\tt action} in left-to-right order as arguments. \item \verb"{action(POP)}"\autoindex{POP@{\ptt POP}} --- The most recent previous result is removed from the result list, and passed as an argument to {\tt action}. \item \verb"{action(POP,POP)}"\autoindex{POP@{\ptt POP}} --- Same as above. The most recent previous result is passed as the second argument to {\tt action}, while the one before it is sent as the first argument. \item \verb"{action(POP,TOKEN,prdn,POP)}"\autoindex{POP@{\ptt POP}} --- The calls to \verb"POP" are first elaborated in the manner just described (i.e. the most recent previous result will be passed as the last argument to {\tt action}, while the one before that will be the first one). \verb"TOKEN"\autoindex{TOKEN@{\ptt TOKEN}} is then executed before the non-terminal {\tt prdn} is expanded. After {\tt prdn} returns, the four results are passed to {\tt action}. \end{itemize} \end{description} \section{Examples} \label{ex} In the examples that follow, we assume that the parser-generator has been loaded into the \HOL\ system. \subsection{Terminal Input and Errors} \label{ex:errs} The following session demonstrates the generator's ability to understand input from the user's console. Providing \verb"nil" as the input file allows the user to specify a grammmar in an interactive manner. In the current example, there is an error in the grammar which causes an error message to be output\autoindex{errors@error\ messages}. \setcounter{sessioncount}{1} \small \begin{center} \begin{session} \begin{verbatim} #parse();; Input file: nil Output file: foo Opening the file foo.ml (MAIN OUTPUT) Opening the file foo_decls.ml (DECLARATIONS) Load the declarations file before the main output. See the file foo_load.ml for a sample. See the file ./Makefile.foo for a sample Makefile. Output type: term foo --> [A] get_word. evaluation failed ERROR: symbol "get_word" encountered in the wrong place. -- Production: foo -- Diagnostic: "get_word" is a system function. \end{verbatim} \end{session} \end{center} \normalsize Similar messages will be output for various classes of errors. An effort was made to trap all possible errors, and generate an appropriate message. The user should note, however, that there are probably unforeseen combinations of inputs not reflected in the trapping mechanism. \subsection{HOL Types} We now present a more complex example, the subject of which is a re-implementation of the \HOL\ type parser. Points of interest include user-defined action symbols, operator precedences, and seamless integration of the parser with the \HOL\ system. \subsubsection{The Grammar} \begin{center} \begin{boxed} \begin{verbatim} FIRST_CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *`. CHARS `a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1 2 3 4 5 6 7 8 9 0 *`. tyname --> {mk_type_name(TOKEN)}. tyvar --> {mk_type_var(TOKEN)}. MAIN_LOOP --> typ [EOF]. typ --> type1 more_type. more_type --> [#] {add_to_list(type1,POP)} more_prod_type sum_or_fun_type | [->] {MK_bin_type(`fun`,POP,typ)} | [+] type1 more_sum_type fun_type | []. more_prod_type --> [#] {add_to_list(type1,POP)} more_prod_type | {MK_defd_type(POP,`prod`)}. sum_or_fun_type --> [+] {MK_bin_type(`sum`,POP,typ)} | [->] {MK_bin_type(`fun`,POP,typ)} | []. more_sum_type --> [+] {add_to_list_rev(POP,POP)} type1 more_sum_type | [#] {add_to_list(type1,POP)} more_prod_type more_sum_type | {add_to_list_rev(POP,POP)} {MK_defd_type(POP,`sum`)}. fun_type --> [->] {MK_bin_type(`fun`,POP,typ)} | []. type1 --> [(] typ poss_cmpnd_type | tyname more_type1 | tyvar more_type1. poss_cmpnd_type --> [)] more_type1 | [,] {add_to_list(POP,typ)} rest_of_cmpnd. rest_of_cmpnd --> [,] {add_to_list(POP,typ)} rest_of_cmpnd | [)] {MK_type(POP,TOKEN)} more_type1. more_type1 --> {MK_type(POP,TOKEN)} more_type1 | []. \end{verbatim} \end{boxed} \end{center} The grammar used to specify the type parser is slightly more complex to specify than the Boolean logic example. The main difference is in the need to have a notion of operator precedence (\verb"->" $>$ \verb"+" $>$ \verb"#"). In order to preserve the ordering, it becomes necessary to make separate productions for each operator. The action symbols used in the grammar all create an object of type \verb"type list". The reason for creating lists of types rather than types by themselves is based on the need to gather together arbitrarily many types to form a single one. This grouping into a list is a standard ploy when developing grammars for parsers where the final object to be created is dependent upon an unknown number of like objects. \subsubsection{Running the Generator} The parser-generator is run in exactly the same fashion as for the Boolean logic example. The only difference is in supplying \verb"type list" as the output type of the generated parser. \setcounter{sessioncount}{1} \begin{center} \begin{session} \begin{verbatim} #parse();; Input file: types.grm Output file: types Opening the file types.ml (MAIN OUTPUT) Opening the file types_decls.ml (DECLARATIONS) Load the declarations file before the main output. See the file types_load.ml for a sample. See the file ./Makefile.types for a sample Makefile. Output type: type list Generating PARSE_file and PARSE_text (MAIN_LOOP used). () : void #quit();; \end{verbatim} \end{session} \end{center} \subsubsection{Auxiliary Files}\label{SEPS} The first auxiliary file is not machine-generated. It contains all the functions used as action symbols within the grammar. \verb"mk_type_name" and \verb"mk_type_var" are the lowest-level functions, and create type lists from primitive types and type variables. \verb"add_to_list" and \verb"add_to_list_rev" group individual type lists into a single monolithic one. A reversed list of types is required to make sure that subcomponents of types associate properly. \verb"MK_type" is the same as the standard \ML\ function \verb"mk_type" with the exception that it returns a type list. \verb"MK_bin_type" is used to return a type list resulting from the creation of a type from a binary type operator. \verb"MK_defd_type" uses \verb"fix_defd" to create a properly associated type from a reversed list of types. \begin{center} \begin{boxed} \begin{verbatim} let mk_type_name thing = [mk_type(thing,[])] and mk_type_var thing = [mk_vartype thing] and add_to_list (lst,thing) = append lst thing and add_to_list_rev (lst,thing) = append thing lst and MK_type(lst,op) = [mk_type(op,lst)] and MK_bin_type(op,type1,typ) = [mk_type(op,(append type1 typ))];; letrec fix_defd(lst,op,result) = if null lst then result else fix_defd(tl lst,op,mk_type(op,[hd lst;result]));; let MK_defd_type(lst,op) = [fix_defd(tl (tl lst),op,mk_type(op,[hd (tl lst);hd lst]))];; \end{verbatim} \end{boxed} \end{center} Several additions have been made to the generated load file. The first is to load in the file of action function definitions just described (\verb"types_help.ml"). Next, we have defined a list of separators to allow the lexical analyzer to break up the input stream into meaningful tokens in the possible absence of standard whitespace. The function \verb"parse"\autoindex{parse@{\ptt parse}} is defined to call \verb"PARSE_text"\autoindex{PARSE\_text@{\ptt PARSE\_text}} with the appropriate arguments, and to return the head of the result of its computation (a \HOL\ type). \verb"new_syntax_block" is a function provided as a part of \HOL\ Version 1.12, and passes the string between its first and second arguments to the function named by its third. While not strictly necessary, the functionality provided by \verb"new_syntax_block" makes input to the generated parser visually more appealing. \begin{center} \begin{boxed} \begin{verbatim} % Generated parser load file First load some basic definitions: % loadf `/usr/groups/hol/hol2/Library/parser/general`;; % Insert any other files you want loaded here: % loadf `types_help`;; % Now load the declarations: % loadf `types_decls`;; % Finally load in the function definitions: % loadf `types`;; let SEPS = [(`(`,[]);(`)`,[]);(`#`,[]);(`-`,[`>`]);(`+`,[]);(`,`,[])];; let parse thing = hd (PARSE_text(thing,[],SEPS));; new_syntax_block(`<<`,`>>`,`parse`);; \end{verbatim} \end{boxed} \end{center} The changes to the generated \verb"Makefile" (\verb"Makefile.types") are less extensive. We have added a rule to deal with the compilation of the file of action functions. The new rule has then been linked into the dependencies of the parser's compilation through its inclusion on the object list of \verb"types_decls_ml.o". \begin{center} \begin{boxed} \begin{verbatim} # Generated parser Makefile # Version of HOL to be used: HOL=/usr/groups/hol/hol2/hol # General definitions for all generated parsers: GENERAL=/usr/groups/hol/hol2/Library/parser/general # Insert entries for user-defined stuff here: # Remember to insert the appropriate dependencies and "load"'s below. types_help_ml.o: types_help.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'compilet `types_help`;;'\ 'quit();;' | $(HOL) # Now compile the declarations: types_decls_ml.o: types_decls.ml types_help_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `types_help`;;'\ 'compilet `types_decls`;;'\ 'quit();;' | $(HOL) # Finally do the actual functions types_ml.o: types.ml types_decls_ml.o echo 'set_flag(`abort_when_fail`,true);;'\ 'loadf `$(GENERAL)`;;'\ 'loadf `types_help`;;'\ 'loadf `types_decls`;;'\ 'compilet `types`;;'\ 'quit();;' | $(HOL) all: types_ml.o @echo '===> Parser "types" built.' \end{verbatim} \end{boxed} \end{center} \subsubsection{Running the Generated Parser} Running the parser is the much same as for the Boolean logic example. The only significant change is in the mode of input, which has been provided by \verb"new_syntax_block". The first part of the following session deals with loading in the generated parser into the \HOL\ system, and presents an example input. \setcounter{sessioncount}{1} \begin{center} \begin{session} \begin{verbatim} #loadf `loader`;; ...................................................................() : void #":bool";; ":bool" : type #<< bool >>;; ":bool" : type \end{verbatim} \end{session} \end{center} Since we have re-implemented the \HOL\ type parser, we have every reason to expect that our parser constructs types that are indistinguishable from those created by the system. We should also anticipate that our parser will not construct invalid types, while at the same time remaining sensitive to any additional ones created by the user. The continuation of the previous session demonstrates these properties. Also shown is the way in which the \verb"SEPS" list (declared in the load file) permits a more natural style of input. \begin{center} \begin{session} \begin{verbatim} #":((* # (ind -> bool))list list + *list # * list -> *)list";; ":(((* # (ind -> bool))list)list + *list # (*)list -> *)list" : type #<< ((* # (ind -> bool))list list + *list # * list -> *)list >>;; ":(((* # (ind -> bool))list)list + *list # (*)list -> *)list" : type #":((bool,ind)fun,(*,*1)prod)sum";; ":(bool -> ind) + * # *1" : type #<< ((bool,ind)fun,(*,*1)prod)sum >>;; ":(bool -> ind) + * # *1" : type #":(bool,ind,*)tri";; evaluation failed mk_type in quotation #<< (bool,ind,*)tri >>;; evaluation failed fail #new_theory`tri`; new_type 3 `tri`;; () : void #":(bool,ind,*)tri";; ":(bool,ind,*)tri" : type #<< (bool,ind,*)tri >>;; ":(bool,ind,*)tri" : type \end{verbatim} \end{session} \end{center} \subsection{Blocks} Here we demonstrate the use of the block declarations \verb"IGNORE"\autoindex{IGNORE@{\ptt IGNORE}} and \verb"USEFUL"\autoindex{USEFUL@{\ptt USEFUL}}. While the grammar will be trivial, the concept it shows is important. We will only present the grammar, and examples of the generated parser. The generation process is the same as for the previous examples. \subsubsection{The Grammar} The following grammar shows the pattern of input that is of interest. Note that no specification of legal characters is given, with the result that no token recogniser is generated. The \verb"USEFUL"\autoindex{USEFUL@{\ptt USEFUL}} declaration states that all sequences of characters enclosed by single quotes should be concatenated into a single string. \verb"IGNORE"\autoindex{IGNORE@{\ptt IGNORE}} describes the blocks that can be thrown away. The action symbol is a standard \ML\ function that returns type \verb"void", which is also the type which should be provided to the generator. \begin{center} \begin{boxed} \begin{verbatim} USEFUL [(`'`,`'`)]. IGNORE [(`"`,`"`)]. MAIN_LOOP --> foo [EOF]. foo --> ['] {print_string(WORD)} ['] foo | []. \end{verbatim} \end{boxed} \end{center} \subsubsection{Running the Generated Parser} We provide below some sample input to the generated parser. It performs as expected. \setcounter{sessioncount}{1} \begin{center} \begin{session} \begin{verbatim} #loadf `blocks_load`;; ....................................() : void #PARSE_text(`'a;lsdkfj'`,[],[]);; a;lsdkfj() : void #PARSE_text(`'a;lsdkfj'"IIIIII'III"'MMMMM"""'`,[],[]);; a;lsdkfjMMMMM"""() : void \end{verbatim} \end{session} \end{center} \subsection{Other Examples} More examples are provided in the \verb"Examples" directory distributed with the current version of the generator. See the \verb"READ-ME" file associated with each for a brief description of the features. These additional examples are: \begin{itemize} \item \verb"Examples/HOL" --- A subset of the \HOL\ term parser. \item \verb"Examples/ella" --- A parser for the the {\small ELLA} hardware description language. \item \verb"Examples/tiny" --- A for the programming language from the \verb"prog_logic88" library. \item \verb"Examples/user_guide" --- Examples used in this document: \begin{itemize} \item \verb"blocks" --- The use of \verb"USEFUL"\autoindex{USEFUL@{\ptt USEFUL}} and \verb"IGNORE"\autoindex{IGNORE@{\ptt IGNORE}}. \item \verb"bool" --- Boolean logic. \item \verb"types" --- The \HOL\ type parser. \end{itemize} \end{itemize} \newpage \section{The Parser-Generating Language}\label{BNFsec} The {\small BNF} syntax for the parser-generator's input grammar is described by the following productions. Items in {\tt typewriter} font are the terminal symbols. A comment beginning and ending with the character \verb"%" may appear anywhere in the grammar input to the generator. \small \begin{center} \begin{boxed} \begin{tabular}{l} grammar ::= declarations productions $|$ productions declarations $|$ productions \end{tabular} \\ \begin{tabular}{l} declarations ::= first\_chars chars blocks $|$ chars blocks first\_chars $|$ blocks first\_chars chars \end{tabular} \\ \begin{tabular}{l} first\_chars ::= \verb"FIRST_CHARS" hol\_string {\tt .} \end{tabular} \\ \begin{tabular}{l} chars ::= \verb"CHARS" hol\_string {\tt .} \end{tabular} \\ \begin{tabular}{l} hol\_string ::= {\it (a standard \ML\ string of whitespace-separated characters)} \end{tabular} \\ \begin{tabular}{l} blocks ::= useful ignore $|$ ignore useful $|$ useful $|$ ignore $|$ $\epsilon$ \end{tabular} \\ \begin{tabular}{l} useful ::= \verb"USEFUL" assoc\_list {\tt .} \end{tabular} \\ \begin{tabular}{l} ignore ::= \verb"IGNORE" assoc\_list {\tt .} \end{tabular} \\ \begin{tabular}{l} assoc\_list ::= {\it (a standard \ML\ list of type (string{\small \#}string))} \end{tabular}\\ \begin{tabular}{lrl} productions & ::= & production\_name \verb"-->" production productions \\ & $|$ & $\epsilon$ \end{tabular} \\ \begin{tabular}{lrl} production & ::= & terminal prdn\_with\_choice \\ & $|$ & one\_liner \end{tabular} \\ \begin{tabular}{l} terminal ::= {\tt [} terminal\_symbol {\tt ]} \end{tabular} \\ \begin{tabular}{lrl} terminal\_symbol & ::= & {\it (any alphanumeric character)} terminal\_symbol \\ & $|$ & \verb"\" special\_symbol terminal\_symbol \\ & $|$ & $\epsilon$ \end{tabular} \\ \begin{tabular}{l} special\_symbol ::= \verb"{" $|$ \verb"}" $|$ \verb"\" $|$ \verb"[" $|$ \verb"]" \end{tabular} \\ \begin{tabular}{l} production\_name ::= lead\_char {\it (any sequence of alphanumeric characters)} \end{tabular} \\ \begin{tabular}{l} lead\_char ::= {\it (any alphabetic character)} \end{tabular} \\ \begin{tabular}{l} action\_symbol ::= {\tt \{} action\_name optional\_args {\tt \}} \end{tabular} \\ \begin{tabular}{l} optional\_args ::= {\tt (} args {\tt )} $|$ $\epsilon$ \end{tabular}\\ \begin{tabular}{l} action\_name ::= lead\_char {\it (any sequence of alphanumeric characters)} \end{tabular} \\ \begin{tabular}{l} args ::= arg {\tt ,} args $|$ arg \end{tabular} \\ \begin{tabular}{lrl} arg & ::= & {\tt TOKEN} \\ & $|$ & {\tt WORD} \\ & $|$ & {\tt POP} \\ & $|$ & production\_name \\ & $|$ & {\it ($\;$\HOL\ string or term)} \end{tabular} \\ \begin{tabular}{lrl} prdn\_with\_choice & ::= & terminal prdn\_with\_choice \\ & $|$ & action\_symbol prdn\_with\_choice \\ & $|$ & production\_name prdn\_with\_choice \\ & $|$ & \verb"|" prdn\_with\_choice \\ & $|$ & \verb"." \end{tabular} \\ \begin{tabular}{lrl} one\_liner & ::= & action\_symbol one\_liner \\ & $|$ & production\_name one\_liner \\ & $|$ & {\tt .} \end{tabular} \end{boxed} \end{center} \normalsize hol88-2.02.19940316/Library/parser/Manual/entries-intro.tex0000640000212700021270000000032305034563601021365 0ustar cammcammThis chapter provides documentation on the single \ML\ function that is made available in \HOL\ when the \ml{parser} library is loaded. This documentation is also available online via the \ml{help} facility. hol88-2.02.19940316/Library/parser/Manual/entries.tex0000640000212700021270000000154505535604543020252 0ustar cammcamm\chapter{ML Functions in the parser Library} \input{entries-intro} \DOC{parse} \TYPE {\small\verb%parse : (* -> void)%}\egroup \SYNOPSIS Top-level function to invoke the parser-generator. \DESCRIBE The function invokes the parser-generator. The generator prompts for various input files and types. \FAILURE Fails if there is an error in the input grammar that specifies the operation of the parser to be generated. A descriptive message is produced to help pinpoint the cause of the failure. \EXAMPLE {\par\samepage\setseps\small \begin{verbatim} #parse();; Input file: foo.grm Output file: foo Opening the file foo.ml (MAIN OUTPUT) Opening the file foo_decls.ml (DECLARATIONS) Load the declarations file before the main output. See the file foo_load.ml for a sample. See the file ./Makefile.foo for a sample Makefile. Output type: * \end{verbatim} } \ENDDOC hol88-2.02.19940316/Library/parser/Manual/index.tex0000640000212700021270000000265205535604570017710 0ustar cammcamm\begin{theindex} \item {action\ symbols}, 9 \indexspace \item {\ptt CHARS}, 2, 8, 9 \item {\ptt chop\_off}, 9 \item {\ptt close\_file}, 9 \item {\ptt complete\_separator}, 9 \indexspace \item {\ptt debug\_enter}, 9 \item {\ptt debug\_off}, 5, 9 \item {\ptt debug\_on}, 5, 9 \item {\ptt debug\_return}, 9 \item debugging, 5 \item {\ptt deterimine\_lst}, 9 \item {\ptt do\_return}, 9 \item {\ptt do\_return\_1}, 9 \indexspace \item {\ptt e\_w\_s\_ok}, 9 \item {\ptt e\_w\_s}, 9 \item {\ptt eat\_terminal}, 9 \item {\ptt EOF}, 2, 7 \item error\ messages, 5, 6, 10 \indexspace \item {\ptt FIRST\_CHARS}, 2, 8, 9 \item {\ptt FIRST\_CHARS} , 8 \indexspace \item {\ptt get\_word}, 9 \item {\ptt get\_word1}, 9 \item {\ptt get\_word2}, 9 \item {\ptt gnt}, 9 \indexspace \item {\ptt IGNORE}, 8, 15, 16 \indexspace \item {\ptt MAIN\_LOOP}, 2, 3, 7--9 \indexspace \item {\ptt open\_file}, 9 \indexspace \item {\ptt parse}, 2, 13, 19 \item {\ptt PARSE\_file}, 3, 8, 9 \item {\ptt PARSE\_text}, 3, 5, 9, 13 \item {\ptt POP}, 7, 8, 10 \item {\ptt pop}, 9 \item {\ptt push}, 9 \indexspace \item {\ptt read\_char}, 9 \item {\ptt read\_input}, 9 \indexspace \item {\ptt TOKEN}, 8--10 \item {\ptt TOKEN\_1}, 9 \indexspace \item {\ptt USEFUL}, 8, 15, 16 \indexspace \item {\ptt WORD}, 8 \item {\ptt write\_string}, 9 \end{theindex} hol88-2.02.19940316/Library/parser/Manual/references.tex0000640000212700021270000000045305034563603020712 0ustar cammcamm\begin{thebibliography}{99} \bibitem{shapiro} % OK L. Sterling and E. Shapiro, {\it The Art of Prolog: Advanced Programming Techniques}, {\small MIT} Press, 1986. \bibitem{fischer} % OK C.N. Fischer and R.J. LeBlanc, Jr., {\it Crafting a Compiler}, Benjamin/Cummings, 1988. \end{thebibliography} hol88-2.02.19940316/Library/parser/Manual/theorems.tex0000640000212700021270000000003605535604543020421 0ustar cammcamm\chapter{Pre-proved Theorems} hol88-2.02.19940316/Library/parser/Manual/title.tex0000640000212700021270000000354705034563604017722 0ustar cammcamm% ===================================================================== % % Standard titlepage for string library % % ===================================================================== % \begin{titlepage} \setcounter{page}{1} % titlepage IS page 1 ! % --------------------------------------------------------------------- % % Name of the library. % % --------------------------------------------------------------------- % \mbox{} \vskip20mm \begin{center} {\Huge\bf The HOL parser Library} \end{center} % --------------------------------------------------------------------- % % Name of the author % % --------------------------------------------------------------------- % \vskip15mm \begin{center} \large\bf J.\ P.\ Van\ Tassel \end{center} % --------------------------------------------------------------------- % % Address of the author % % --------------------------------------------------------------------- % \vfill \begin{center} \bf University of Cambridge, Computer Laboratory\\ New Museums Site, Pembroke Street\\ Cambridge, {\small\bf CB}2 3{\small\bf QG}, England. \end{center} % --------------------------------------------------------------------- % % Date. % % --------------------------------------------------------------------- % \vskip5mm \begin{center} \bf July 1991 \end{center} \end{titlepage} % --------------------------------------------------------------------- % % To kick a blank page with no header (back of title page is blank). % % --------------------------------------------------------------------- % \thispagestyle{empty} \mbox{} % --------------------------------------------------------------------- % % Copyright notice (if desired). % % --------------------------------------------------------------------- % \vfill \begin{center} \copyright\ J.\ P.\ Van\ Tassel\ 1991 \end{center} \newpage hol88-2.02.19940316/Library/parser/general.ml0000640000212700021270000001401605030344007016570 0ustar cammcamm letref FIRST_CHARS = []:string list and CHARS = []:string list and DEBUG = false and IGNORE = []:(string#string)list and USEFUL = []:(string#string)list;; let push item lst = (item . lst);; let pop lst = if null lst then failwith `can't pop null list` else (hd lst,tl lst);; let write_string str file = if file = `nil` then tty_write str else write(file,str);; let read_char file = if file = `nil` then tty_read() else (read file);; let close_file file = if file = `nil` then () else close file;; let open_file direction filename = if filename = `nil` then `nil` else if mem direction [`in` ; `input` ; `i`] then openi filename else if mem direction [`out`; `output`; `o`] then openw filename else failwith (concat `can't open ` (concat filename (concat ` in direction ` direction)));; letrec e_w_s file chr whitespace = if mem chr whitespace then e_w_s file (read_char file) whitespace else if chr = `nil` then failwith `unexpected eof` else chr;; letrec e_w_s_ok file chr whitespace = if mem chr whitespace then e_w_s_ok file (read_char file) whitespace else if chr = `nil` then `nil` else chr;; let determine_lst ch follow white = if follow = white then mem ch white else not (mem ch follow);; letrec get_word2 ch lst file white seps ignore useful = if ch = `nil` then (lst,`nil`) else if can (assoc ch) seps then (lst,ch) else if can (assoc ch) ignore then (lst,ch) else if can (assoc ch) useful then (lst,ch) else if mem ch white then (lst,e_w_s_ok file (read_char file) white) else get_word2 (read_char file) (append lst [ch]) file white seps ignore useful;; letrec get_word1 ch lst file follow white = if ch = `nil` then (lst,`nil`) else if not (mem ch follow) then (lst,e_w_s_ok file ch white) else get_word1 (read_char file) (append lst [ch]) file follow white;; let complete_separator thing file white seps ignore useful = if can (assoc thing) seps then let follow = snd (assoc thing seps) in if null follow then (thing,e_w_s_ok file (read_char file) white) else let (wrd,sep) = get_word1 (read_char file) [thing] file follow white in (implode wrd,sep) else let (wrd,sep) = get_word2 (read_char file) [thing] file white seps ignore useful in (implode wrd,sep);; let get_word file white last seps sep ignore useful = if mem last white then failwith `Generated Parser Error, please report it.` else if not (mem sep white) then (last,sep) else if last = `nil` then (`nil`,`nil`) else if can (assoc last) useful then (last,read_char file) else if can (assoc last) ignore then (last,read_char file) else complete_separator last file white seps ignore useful;; letrec useful_stuff ch finish file ch_lst = if ch = finish then (implode ch_lst,finish) if ch = `nil` then failwith `Unexpected EOF` else useful_stuff (read_char file) finish file (append ch_lst [ch]);; letrec ignore_stuff ch finish file white = if ch = finish then e_w_s_ok file (read_char file) white else if ch = `nil` then failwith `unexpected EOF` else ignore_stuff (read_char file) finish file white;; letrec read_input file lst white seps prev ignore useful = let (WORD,sep) = get_word file white prev seps (hd white) ignore useful in if can (assoc WORD) ignore then read_input file lst white seps (ignore_stuff sep (snd (assoc WORD ignore)) file white) ignore useful else let lst = append lst [WORD] in if WORD = `nil` then (close_file file; lst) else if can (assoc WORD) useful then let block,final = useful_stuff sep (snd (assoc WORD useful)) file [] in read_input file (append lst [block;final]) white seps (e_w_s_ok file (read_char file) white) ignore useful else read_input file lst white seps sep ignore useful;; let gnt lst white WORD = if WORD = `nil` then if null lst then (`nil`,[]) else failwith `Unexpected end of term.` else if WORD = white then (hd lst,tl lst) else (WORD,lst);; let eat_terminal token WORD lst prdn = if WORD = token then if WORD = `nil` then if null lst then (`nil`,[]) else failwith `Unexpected end of term.` else (hd lst,tl lst) else fail;; letrec chop_off ctr pop_list result_list = if ctr = 0 then (result_list,pop_list) else chop_off (ctr-1) ((hd result_list) . pop_list) (tl result_list);; let debug_return state prdn = if DEBUG then write_string (state ^ ` prdn "` ^ prdn ^`".\L`) `nil` else ();; let do_return_1 res_list white prdn thing lst expect = if thing = white then (debug_return `EXITING` prdn; (hd res_list, tl res_list, (hd lst), (tl lst))) else if thing = expect then (debug_return `EXITING` prdn; (hd res_list, tl res_list, thing, lst)) else (debug_return `FAILING` prdn; fail);; let do_return res_list white prdn prev lst expect = if expect = `nil` then (debug_return `EXITING` prdn; (hd res_list, tl res_list, prev, lst)) else do_return_1 res_list white prdn prev lst expect;; let debug_enter(prdn,expect,wrd) = if DEBUG then write_string (`ENTERING prdn "`^prdn^ `": Curr. Token = "`^wrd^ `"; Expected = "`^expect^`".\L`) `nil` else ();; let debug_on() = let D = DEBUG in DEBUG := true;D and debug_off() = let D = DEBUG in DEBUG := false;D;; hol88-2.02.19940316/Library/parser/parser.ml0000640000212700021270000020105305030344105016445 0ustar cammcamm% ===================================================================== % % FILE NAME : parser.ml % % USES FILES : N/A % % DESCRIPTION : This file sets up the parser-generator. It uses % % one big section so that we only export the top- % % level function (parse) for use by users. % % % % AUTHOR : J. Van Tassel % % % % % % ORGANIZATION : University of Cambridge % % Hardware Verification Group % % ADDRESS : Computer Laboratory % % New Museums Site % % Pembroke Street % % Cambridge CB2 3QG % % England % % PHONE : +44-223-334729 % % % % DATE : Tue Mar 13 1990 % % VERSION : 1 % % REVISION HISTORY : Tue Nov 3 1990 Cleaned up and made ready for the % % release of HOL 1.12 % % ===================================================================== % % ********************************************************************* % % Set add to the help search path to provide on-line help for the one % % function exported to the rest of the world. % % ********************************************************************* % let path = library_pathname() ^ `/parser/help/` in set_help_search_path (path . help_search_path());; begin_section parser;; % ********************************************************************* % % We start with some basic functions used by the rest of the generator. % % ********************************************************************* % % ===================================================================== % % EXPECTED: Holds a list of tokens expected on return from individual % % productions and action symbols. % % ===================================================================== % letref EXPECTED = []:string list;; % ===================================================================== % % pg_failwith: Enhanced failwith for reporting encountered during the % % parsing of an input grammar. % % ===================================================================== % let pg_failwith symb prdn reason = EXPECTED := []; failwith (concat `\L\L ERROR: symbol "` (concat symb (concat `" encountered in the wrong place.\L` (concat ` -- Production: ` (concat prdn (concat `\L -- Diagnostic: ` (concat reason `\L`)))))));; % ===================================================================== % % escaped: Determine if we have escaped to something that's not an % % "escapable" character. % % ===================================================================== % let escaped ch prdn = if mem ch [` `;` `;`\L`] then let nch = if ch = ` ` then `` else if ch = ` ` then `` else `` in pg_failwith nch prdn `escaped to whitespace` else if mem ch [`}`;`{`;`]`;`[`] then ch else if ch = `\\` then `\\\\` else pg_failwith ch prdn `escaped to non-special symbol`;; % ===================================================================== % % Suite of I/O functions that tie together terminal and file I/O. The % % string `nil` denotes terminal I/0. % % ===================================================================== % let write_string str file = if file = `nil` then tty_write str else write(file,str);; let read_char file = if file = `nil` then tty_read() else (read file);; letrec split_filename path lst first = if null (tl lst) then if first then (hd lst,`./`) else (hd lst,concatl path) else split_filename (append path [(hd lst);`/`]) (tl lst) false;; let close_file file = if file = `nil` then () else close file;; letrec bad_read (ch) = if ch = ascii(10) then failwith `bad file name` else bad_read (tty_read());; letrec terminal_read_1 (ch) = if ch = ascii(10) then [] else if mem ch [` ` ; ` `] then bad_read (tty_read()) else (ch . terminal_read_1 (tty_read ()));; let terminal_read () = implode (terminal_read_1 (tty_read ()));; % ===================================================================== % % make_Makefile: Build a skeleton Makefile for the generated parser. % % ===================================================================== % let make_Makefile filename file path = let decs = (concat filename `_decls`) in let outf = openw (concatl [path;`Makefile.`;file]) in write_string `# Generated parser Makefile\L\L` outf; write_string `# Version of HOL to be used:\L` outf; write_string `HOL=../../hol\L\L` outf; write_string `# General definitions for all generated parsers:\L` outf; write_string (`GENERAL=`^(library_pathname())^`/parser/general\L\L`) outf; write_string `# Insert entries for user-defined stuff here:\L` outf; write_string `# Remember to insert the appropriate ` outf; write_string `dependencies and "load"'s below.\L\L` outf; write_string `# Now compile the declarations:\L` outf; write_string (concatl [file;`_decls_ml.o: `;decs;`.ml\L`]) outf; write_string ` echo 'set_flag(\`abort_when_fail\`,true);;'\\\L` outf; write_string `\T 'loadf \`$(GENERAL)\`;;'\\\L` outf; write_string (concatl [`\T 'compilet \``;filename;`_decls\`;;'\\\L`]) outf; write_string `\T 'quit();;' | $(HOL)\L\L` outf; write_string `# Finally do the actual functions\L` outf; write_string (file^`_ml.o: `^filename^`.ml `^file^`_decls_ml.o\L`) outf; write_string ` echo 'set_flag(\`abort_when_fail\`,true);;'\\\L` outf; write_string `\T 'loadf \`$(GENERAL)\`;;'\\\L` outf; write_string (concatl [`\T 'loadf \``;decs;`\`;;'\\\L`]) outf; write_string (concatl [`\T 'compilet \``;filename;`\`;;'\\\L`]) outf; write_string ` 'quit();;' | $(HOL)\L\L` outf; write_string (concatl [`all: `;file;`_ml.o\L`]) outf; write_string (concatl [` @echo '===> Parser "`;file;`" built.'\L\L`]) outf; close outf;; % ===================================================================== % % make_makefile: Build a skeleton load file for the generated parser. % % ===================================================================== % let make_makefile filename = let (makefile,decs,main) = ((concat filename `_load.ml`), (concat filename `_decls`), filename) in let outf = openw makefile in write_string `% Generated parser load file\L\L` outf; write_string ` First load some basic definitions: %\L` outf; write_string (`loadf \``^(library_pathname())^`/parser/general\`;;\L\L`) outf; write_string `% Insert any other files you want loaded here: %\L\L` outf; write_string `% Now load the declarations: %\L` outf; write_string (concat `loadf \`` (concat decs `\`;;\L\L`)) outf; write_string `% Finally load in the function definitions: %\L` outf; write_string (concat `loadf \`` (concat main `\`;;\L`)) outf; close outf;; let open_file direction filename = if filename = `nil` then (`nil`,`nil`) else if mem direction [`in` ; `input` ; `i`] then ((openi filename),`nil`) else if mem direction [`out`; `output`; `o`] then let first_char = if (hd (explode filename)) = `/` then [`/`] else [] in let (file,path) = split_filename first_char (words2 `/` filename) true in write_string `Opening the file ` `nil`; write_string (concat filename `.ml (MAIN OUTPUT)\L`) `nil`; write_string `Opening the file ` `nil`; write_string (concat filename `_decls.ml (DECLARATIONS)\L`) `nil`; write_string `Load the declarations file before the main output.\L` `nil`; make_makefile filename; write_string (concat `See the file ` (concat filename `_load.ml for a sample.\L`)) `nil`; make_Makefile filename file path; write_string (concatl [`See the file `;path;`Makefile.`;file; ` for a sample Makefile.\L`]) `nil`; (openw (concat filename `.ml`),openw (concat filename `_decls.ml`)) else failwith (concat `can't open ` (concat filename (concat ` in direction ` direction)));; % ===================================================================== % % Various ways of eating white space to suit different purposes later % % on in the generator. % % ===================================================================== % letrec eat_white_space file chr = if mem chr [` ` ; `\T` ; `\L` ] then eat_white_space file (read_char file) else chr;; letrec e_w_s file chr = if mem chr [` ` ; `\T` ; `\L` ] then e_w_s file (read_char file) else if chr = `nil` then failwith `unexpected eof` else chr;; letrec e_w_s_ok file chr = if mem chr [` ` ; `\T` ; `\L` ] then e_w_s file (read_char file) else if chr = `nil` then `nil` else chr;; % ===================================================================== % % The mechanism to read in a source file containing an input grammar is % % contained in the following functions. % % ===================================================================== % % ------------------------------------------------------------------- % % write_comments: Write out the rest of a comment after it has been % % started. % % ------------------------------------------------------------------- % letrec write_comments ch in_file out_file prdn = if ch = `nil` then pg_failwith `EOF` prdn `Runnaway comment? EOF encountered before end of comment.` else if ch = `%` then (write_string ch out_file ; write_string `\L` out_file ; e_w_s_ok in_file (read_char in_file)) else (write_string ch out_file ; write_comments (read_char in_file) in_file out_file prdn);; % ------------------------------------------------------------------- % % get_word1: Helping function for get_word below to finish reading in % % a token from the input grammar. % % ------------------------------------------------------------------- % letrec get_word1 in_file lst chr out_file prdn flag = if mem chr [` ` ; `\L` ; ` `] then (lst, e_w_s in_file (read_char in_file)) else if chr = `.` then if flag = `terminal` then get_word1 in_file (append lst [chr]) (read_char in_file) out_file prdn flag else (lst,chr) else if mem chr [`nil`; `[` ; `(` ; `{` ; `}` ; `|` ;`[`;`]`] then (lst,chr) else if chr = `%` then (write_string (concat `\L` chr) out_file; (lst, write_comments (read_char in_file) in_file out_file prdn)) else if chr = `-` then if flag = `terminal` then get_word1 in_file (append lst [chr]) (read_char in_file) out_file prdn flag else (lst,chr) else if chr = `\\` then if flag = `terminal` then let nch = escaped (read_char in_file) prdn in get_word1 in_file (append lst [nch]) (read_char in_file) out_file prdn flag else pg_failwith `\\` prdn `escapes can only be done in terminals.` else get_word1 in_file (append lst [chr]) (read_char in_file) out_file prdn flag;; % ------------------------------------------------------------------- % % first_test: Is the current character legal? % % ------------------------------------------------------------------- % let first_test flag ch = if flag = `first` then mem ch (append (words `a b c d e f g h i j k l m n o p q r s t u v w x y z`) (words `A B C D E F G H I J K L M N O P Q R S T U V W X Y Z`)) else true;; % ------------------------------------------------------------------- % % get_word: Read in a token from the input grammar. % % ------------------------------------------------------------------- % letrec get_word in_file ch out_file prdn flag = if ch = `nil` then (`nil`,`nil`) else if ch = `%` then (write_string (concat `\L` ch) out_file; get_word in_file (write_comments (read_char in_file) in_file out_file prdn) out_file prdn flag) else if ch = `\\` then if flag = `terminal` then let nch = escaped (read_char in_file) prdn in let (wrd,next_ch) = get_word1 in_file [`\\`;nch] (read_char in_file) out_file prdn flag in (implode wrd,next_ch) else pg_failwith `\\` prdn `escapes can only be done in terminals.` else (if first_test flag ch then let (wrd,next_ch) = get_word1 in_file [ch] (read_char in_file) out_file prdn flag in (implode wrd,next_ch) else pg_failwith ch prdn `not appropriate first character`);; % ------------------------------------------------------------------- % % get_inits1: Finish reading in a list of either FIRST_CHARS or CHARS % % ------------------------------------------------------------------- % letrec get_inits1 ch lst file = if ch = `\`` then (lst,e_w_s file ` `) else if mem ch [`\L`;`\T`] then get_inits1 (read_char file) (append lst [` `]) file else get_inits1 (read_char file) (append lst [ch]) file;; % ------------------------------------------------------------------- % % get_inits: Read in a list of either FIRST_CHARS or CHARS. % % ------------------------------------------------------------------- % let get_inits file ch prdn = if ch = `\`` then let (lst,nch) = get_inits1 (e_w_s file ` `) [] file in if nch = `.` then if null lst then pg_failwith (concat prdn ` list`) prdn (concat `can't have empty list of ` prdn) else implode lst else pg_failwith nch prdn `improperly terminated string intialiser` else pg_failwith ch prdn `improperly started string initaliser`;; % ------------------------------------------------------------------- % % get_inits_specials1: Finish reading in a list of either USEFUL or % % IGNORE. % % ------------------------------------------------------------------- % letrec get_inits1_specials ch lst file = if ch = `]` then (append lst [`]`],e_w_s file ` `) else get_inits1_specials (read_char file) (append lst [ch]) file;; % ------------------------------------------------------------------- % % get_inits_specials: Read in a list of either USEFUL or IGNORE. % % ------------------------------------------------------------------- % let get_inits_specials file ch prdn = if ch = `[` then let (lst,nch) = get_inits1_specials (e_w_s file ` `) [`[`] file in if nch = `.` then implode lst else pg_failwith nch prdn `improperly terminated specials list` else pg_failwith ch prdn `improperly started specials list`;; % ===================================================================== % % Define some functions to make various boiler-plate statements. % % ===================================================================== % % ------------------------------------------------------------------- % % separator: Determine what the look-ahead charater is. It is used % % during the generation of function definitions and calls. % % ------------------------------------------------------------------- % let separator prev = if prev = `sep` then `whitespace` else if prev = `EOF` then `\`nil\`` else prev;; % ------------------------------------------------------------------- % % MK_word: Generate a call to gnt (get next token). % % ------------------------------------------------------------------- % let MK_word prev = [`let`; `(WORD,lst)`;`=`;`gnt lst whitespace`;(separator prev);`in`];; % ------------------------------------------------------------------- % % MK_start: Generate the code to make a list of characters from the % % current token. % % ------------------------------------------------------------------- % let MK_start prev = append (MK_word prev) [`let`;`TOKENS`;`=`;`explode WORD`;`in`];; % ********************************************************************* % % We now give the code for retrieving a terminal symbol from the input % % grammar. % % ********************************************************************* % % ===================================================================== % % EOF: A way of generating escaped backquotes as well as the EOF symbol.% % ===================================================================== % let EOF word = if word = `EOF` then `nil` else if word = `\`` then `\\\`` else word;; % ===================================================================== % % write_conditional: Generate the code for testing a word against a % % particular string. % % ===================================================================== % let write_conditional word = [(`WORD` . (`=` . [(concatl [`\``;(EOF word);`\``])]))];; % ===================================================================== % % write_if: Generate the "if" test for different situations. % % ===================================================================== % let write_if level word = if level = `if` then append [[`if`]] (append (write_conditional word) [[`then`;`(`]]) else append [[`?`];[`if`]] (append (write_conditional word) [[`then`;`(`]]);; % ===================================================================== % % finish_terminal: Test to see that a terminal symbol was terminated % % properly. % % ===================================================================== % letrec finish_terminal ch prdn_name = if ch = `]` then [] else pg_failwith ch prdn_name `improperly terminated terminal symbol.`;; % ===================================================================== % % epsilon_start: Start each branch of the production. If we're at the % % beginning, parenthesize only, otherwise put in a fail % % trap. % % ===================================================================== % let epsilon_start level = if level = `if` then [[`(`]] else [[`?`];[`(`]];; % ===================================================================== % % get_terminal_2: Eat up the characters in a terminal symbol. % % ===================================================================== % letrec get_terminal_2 ch in_file prdn_name = if ch = `\\` then (escaped (read_char in_file) prdn_name) . (get_terminal_2 (read_char in_file) in_file prdn_name) else if ch = `]` then [] else if mem ch [` `;`\T`; `\L`] then finish_terminal (e_w_s in_file (read_char in_file)) prdn_name else ch . get_terminal_2 (read_char in_file) in_file prdn_name ;; % ===================================================================== % % is_EOF: Make sure we know about the special symbol `EOF`. % % ===================================================================== % let is_EOF termnal = if termnal = `EOF` then `EOF` else `sep`;; % ===================================================================== % % get_terminal_1: If we are in a terminal symbol, check to see if it's % % empty. Get the rest of it if it's not. % % ===================================================================== % let get_terminal_1 ch in_file prdn_name level pfail = if ch = `]` then (epsilon_start level, e_w_s in_file (read_char in_file), `WORD`,false) else let termnal = concatl (get_terminal_2 ch in_file prdn_name) in (write_if level termnal, e_w_s in_file (read_char in_file),is_EOF termnal,true) ;; % ===================================================================== % % get_terminal: Check to see if we are starting a terminal symbol. Get % % it from the input grammar if so. % % ===================================================================== % let get_terminal level ch in_file prdn_name prev_fail = if ch = `[` then get_terminal_1 (e_w_s in_file (read_char in_file)) in_file prdn_name level prev_fail else if level = `if` then ([[`(`]] , ch, `WORD`, false) else (epsilon_start level, ch, `WORD`, false);; % ********************************************************************* % % We now describe the functions that parse action symbols from the % % input grammar and generate the appropriate function calls. % % % % A note on methodology: % % % % We need to parse an action symbol that looks like act(arg1,..,argn), % % where each argn is either a reserved symbol (system function) or the % % name of some other production in the grammar. The code corresponding % % to each of these possibilites can best be described by the sequence: % % % % A. Simple calls to other productions. % % Evaluate the function and pass the result to the action. % % B. POP % % Take a result off the intermediate results list and pass it as an % % argument to the action in question. % % C. TOKEN % % Check the current input token to see if it meets the constraints % % of CHARS and FIRST_CHARS, then pass it as an argument to the % % action. % % D. Pass the current input token to the action directly. % % % % We need to generate two code segments to do this properly. One holds % % all the POP calls. The other contains the more ordinary calls. The % % two code segments will be joined together after we are finished with % % parsing all the arguments. The POP calls appear first to make sure % % that we get any old data before generating new results. % % ********************************************************************* % % ===================================================================== % % system_function: Check to make sure we are not using a function name % % that conflicts with one already used by all parsers. % % ===================================================================== % let system_function_args next_wd = mem next_wd [`PARSE_text`;`PARSE_file`;`TOKEN_1`;`push`;`pop`; `write_string`;`read_char`;`close_file`;`open_file`;`e_w_s`; `e_w_s_ok`;`determine_lst`;`get_word`;`get_word1`; `get_word2`;`complete_separator`;`read_input`; `gnt`;`eat_terminal`;`chop_off`;`do_return`;`do_return_1`; `debug_enter`;`debug_on`;`debug_off`;`debug_return`];; % ===================================================================== % % prdn_errors: Check that we are using names that are legal. % % ===================================================================== % let prdn_errors_args prdn_name next_wd = if system_function_args next_wd then pg_failwith next_wd prdn_name (concatl [`"`;next_wd;`" is a system function.`]) else if next_wd = `type` then pg_failwith `type` prdn_name `"type" is a reserved word in HOL.` else if next_wd = `MAIN_LOOP` then pg_failwith `MAIN_LOOP` prdn_name `"MAIN_LOOP" may not be called.` else ();; % ===================================================================== % % tmp_var: Generate temporary variable names given a running counter. % % ===================================================================== % let tmp_var word number = if number = (0-1) then word else if word = `` then `` else if word = `nil` then `` else concatl (word . (`_` . [(string_of_int number)]));; % ===================================================================== % % HOL_term: Are we starting something from HOL (` or ")? % % ===================================================================== % let HOL_term str = mem (hd (explode str)) [`\``;`"`];; % ===================================================================== % % top_or_middle: Generate a call to push something onto the intermedi- % % ate results list. % % ===================================================================== % let top_or_middle new_name = (`result_list` . (`=` . (`push` . (new_name . (`result_list` . [])))));; % ===================================================================== % % get_args_prdn: Make sure that productions don't have arguments. % % ===================================================================== % let get_args_prdn ch file prdn_name prev = if ch = `(` then pg_failwith ch prdn_name `arguments not allowed to non-terminals.` else (concatl [`lst whitespace `;(separator prev); ` result_list FIRST_CHARS CHARS`], ch);; % ===================================================================== % % finish_arg: Make sure that each argument ends with either a comma or % % a parenthesis. % % ===================================================================== % let finish_arg ch prdn call = if mem ch [`,`;`)`] then []:(string list) else pg_failwith ch prdn (concatl [`strange terminator for an argument to `; call;`.`]);; % ===================================================================== % % get_argn1: Helping function for get_arg_name to finish reading in a % % particular argument name. % % ===================================================================== % letrec get_argn1 ch file prdn call flag hol_flag = if mem ch [`,`;`)`] then [] else if mem ch [` `;`\T`;`\L`] then finish_arg (e_w_s file (read_char file)) prdn call else if hol_flag then ch . get_argn1 (read_char file) file prdn call `any` hol_flag else if ch = `-` then pg_failwith ch prdn (concatl [`use underscores rather than dashes`]) else (if first_test flag ch then ch . get_argn1 (read_char file) file prdn call `any` hol_flag else pg_failwith ch prdn `not an appropriate first character`);; % ===================================================================== % % get_arg_name: Begin reading in an argument name. % % ===================================================================== % let get_arg_name ch file prdn call start = if ch = `,` then pg_failwith ch prdn (concatl [`empty argument to `;call;`.`]) else if ch = `)` then if start then pg_failwith ch prdn (concatl [call;` must have at least one argument.`]) else (`nil`,`)`) else let wrd = get_argn1 (e_w_s file ch) file prdn call `any` (if mem ch [`\``;`"`] then true else false) in (implode wrd,e_w_s file (read_char file));; % ===================================================================== % % add_new_calls: Set things up for code generation for the action's % % arguments depending on wether or not we're using a % % system function. % % ===================================================================== % let add_new_calls tmp_calls argn calls pops = if mem argn [`POP`;`TOKEN`;`WORD`] then (append pops tmp_calls,calls) else (pops,append calls tmp_calls);; % ===================================================================== % % require_start: Decide if we need to check TOKENS. % % ===================================================================== % let require_start prev tmp_name call = let tmp_calls = if prev = `WORD` then [] else MK_start prev in if call = `WORD` then (append tmp_calls [`let`;tmp_name;`= WORD`;`NOMARK`;`in`],`sep`) else (append tmp_calls [`let`;tmp_name;`= TOKEN TOKENS`; `FIRST_CHARS`;`CHARS`;`(hd lst)`;`MARK`;`in`], `sep`);; % ===================================================================== % % neet_to_use_pops: Generate the code to pop things off of the results % % list if needed. % % ===================================================================== % let need_to_use_pops pop_size = if pop_size = 0 then [] else [`let`;`(result_list,pop_list) = chop_off`;(string_of_int pop_size); `[] result_list`;`in`];; % ===================================================================== % % add_EXPECTED: Add something to the EXPECTED list as required. % % ===================================================================== % let add_EXPECTED thing flag = if flag then EXPECTED := append EXPECTED [thing] else EXPECTED;; % ===================================================================== % % pop_or_reg: Generate a call to pop something or a regular function % % call as required. % % ===================================================================== % let pop_or_reg call prev t_par = if call = `POP` then ([`) = (pop pop_list)`],prev,`pop_list`,t_par) else (add_EXPECTED `\`nil\`` (not t_par); ([`, prev, lst) = `;call;` lst whitespace `;(separator prev); ` result_list FIRST_CHARS CHARS`;`MARK`], `prev`,`result_list`,false));; % ===================================================================== % % mk_lets: Generate the appropriate "let" statement. % % ===================================================================== % let mk_lets call gen_num prev t_par = if call = `nil` then ([],``,gen_num,prev,t_par) else if mem call [`WORD`;`TOKEN`] then let tmp_name = (tmp_var call gen_num) in add_EXPECTED `\`nil\`` (not t_par); let (new_call,nprev) = require_start prev tmp_name call in (new_call,tmp_name,gen_num+1,nprev,false) else if HOL_term call then ([],call,gen_num,prev,t_par) else let tmp_name = (tmp_var call gen_num) and (pop_call,nprev,result_list,ntp) = pop_or_reg call prev t_par in (append [`let`;(concat `(` tmp_name);`,`;result_list] (append pop_call [`in`]), tmp_name,gen_num+1,nprev,ntp);; % ===================================================================== % % comma: Add a comma to an argument if we need to. % % ===================================================================== % let comma start arg = if start then arg else concat `,` arg;; % ===================================================================== % % failed_arg: Make sure we are not doing something improper by calling % % a function that we shouldn't be. % % ===================================================================== % let failed_arg argn = mem argn [`TOKEN_1`;`PARSE`;`MAIN_LOOP`];; % ===================================================================== % % preprocess_args: Go through the argument list putting together the % % various sequences of calls. % % ===================================================================== % letrec preprocess_args ch calls pops args file prdn gen_num prev call start pop_ctr t_par = if ch = `}` then if start then pg_failwith ch prdn (concatl [`bad argument to `;call;`.`]) else (append pops calls,e_w_s file (read_char file),gen_num, append args [`)`],pop_ctr,prev,t_par) else if ch = `)` then if start then pg_failwith ch prdn (concatl [call;` must have some arguments.`]) else (append pops calls,e_w_s file (read_char file),gen_num, append args [`)`],pop_ctr,prev,t_par) else let (argn,nch) = get_arg_name ch file prdn call start in if failed_arg argn then pg_failwith argn prdn (concatl [`"`;argn; `" is not allowed as an argument.`]) else (prdn_errors_args prdn argn; let (tmp_calls,narg,ngen_num,nprev,ntp) = mk_lets argn gen_num prev t_par and npop_ctr = if argn = `POP` then pop_ctr+1 else pop_ctr in let (npops,ncalls) = add_new_calls tmp_calls argn calls pops in preprocess_args nch ncalls npops (append args [(comma start narg)]) file prdn ngen_num nprev call false npop_ctr ntp);; % ===================================================================== % % get_args_act: Parse out the arguments to an action, and put the calls % % together so that they may be glued into the output. % % ===================================================================== % let get_args_act ch file call letrefs gen_num prdn prev t_par = if ch = `(` then let (lrefs,nch,ngen_num,args,pop_size,nprev,ntp) = preprocess_args (e_w_s file (read_char file)) [] [] [`(`] file prdn gen_num prev call true 0 t_par in (append letrefs (append [(need_to_use_pops pop_size)] [lrefs]), call . args,ngen_num,nch,nprev,ntp) else if ch = `}` then (letrefs,[(call^`()`)],gen_num,(e_w_s file (read_char file)),prev,t_par) else pg_failwith ch prdn (concatl [`can't understand symbol "`;ch; `" after the action "`;call;`".`]);; % ********************************************************************* % % We now describe functions that implement a restricted ML pretty % % printer. This part of the generator is not, strictly speaking, % % required. BUT, it did make debugging easier. % % ********************************************************************* % % ===================================================================== % % write_tabs: Write out a certain number of blanks. % % ===================================================================== % letrec write_tabs tabs file = if tabs = 0 then () else (write_string ` ` file ; write_tabs (tabs-1) file);; % ===================================================================== % % then_if: Increment the tab count if the previous token was "else" % % ===================================================================== % let then_if t pp = if pp = `else` then (t + 4) else t;; % ===================================================================== % % pop_EXPECTED: Pop something off the EXPECTED list to fill in a blank. % % ===================================================================== % let pop_EXPECTED () = if null EXPECTED then failwith `bad match in EXPECTED` else let tmp = hd EXPECTED in EXPECTED := tl EXPECTED; tmp;; % ===================================================================== % % write_final: Write a fragment to the named file in a nice (?) format % % ===================================================================== % letrec write_final file lst tabs pch = if null lst then (tabs,pch) else (let word = (hd lst) in if word = `` then write_final file (tl lst) tabs pch else if word = `;;` then (write_string `;;` file; write_string (ascii 10) file; write_string (ascii 10) file; write_final file (tl lst) 0 `st`) else if word = `NOMARK` then (pop_EXPECTED(); write_final file (tl lst) tabs pch) else if word = `MARK` then (write_string (concat ` ` (pop_EXPECTED ())) file; write_final file (tl lst) tabs pch) else if word = `?` then (write_string `\L` file; write_tabs 2 file; write_string `?` file; write_final file (tl lst) 4 `let`) else if word = `.` then (if pch = `st` then (write_string word file; write_final file (tl lst) (tabs+4) `let`) else (write_string word file; write_final file (tl lst) tabs pch)) else if mem word [`( `; ` ( ` ; `(`] then (if (pch = `then`) then (write_string (ascii 10) file; write_tabs (then_if tabs pch) file; write_string `(` file; write_final file (tl lst) ((then_if tabs pch)+1) `(`) else ((if tabs > 5 then write_string `` file else (write_string (ascii 10) file; write_tabs tabs file)); write_string `(` file; write_final file (tl lst) (tabs+1) `(`)) else if word = `)` then (write_string `)` file; write_final file (tl lst) (tabs-1) `)`) else if word = `if` then (if pch = `if` then (write_string (ascii 10) file; write_tabs (tabs+4) file; write_string word file; write_final file (tl lst) (tabs+4) `if`) else if pch = `(` then (write_string `if` file; write_final file (tl lst) (tabs+4) `if`) else (write_string (ascii 10) file; write_tabs tabs file; write_string word file; write_final file (tl lst) (tabs+4) `if`)) else if word = `else` then (write_string (ascii 10) file; write_tabs (tabs-4) file; write_string `else\L` file; write_tabs tabs file; write_final file (tl lst) tabs `else`) else if mem word [`in`;`then`] then (write_string (concat ` ` word) file; write_final file (tl lst) tabs `then`) else if mem word [`let`;`letrec`] then (if pch = `st` then (write_string word file; write_final file (tl lst) (tabs+4) `let`) else if pch = `(` then (write_string word file; write_final file (tl lst) tabs `let`) else if pch = `else` then (write_string (ascii 10) file; write_tabs (tabs+4) file; write_string word file; write_final file (tl lst) (tabs+4) `let`) else (write_string (ascii 10) file; write_tabs tabs file; write_string word file; write_final file (tl lst) tabs `let`)) else if word = `;` then (write_string `;\L` file; write_tabs (tabs-1) file; write_final file (tl lst) tabs pch) else (if pch = `then` then (write_string (ascii 10) file; write_tabs tabs file; write_string word file; write_final file (tl lst) tabs ``) else if pch = `(` then (write_string word file; write_final file (tl lst) tabs ``) else if pch = `st` then (write_string word file; write_final file (tl lst) tabs pch) else (write_string ` ` file; write_string (hd lst) file; write_final file (tl lst) tabs pch)));; % ===================================================================== % % write_final_all: Write each code fragment to the output stream. % % ===================================================================== % letrec write_final_all lst file tabs pch = if null lst then () else let (tabs',pch') = write_final file (hd lst) tabs pch in write_final_all (tl lst) file tabs' pch';; % ********************************************************************* % % We now describe the functions that go through individual productions % % in the input grammar, and generate ML code for them. % % ********************************************************************* % % ===================================================================== % % eat_arrow: Eat an arrow (the name says it all). % % ===================================================================== % letrec eat_arrow prdn_name ch in_file n = if n = 2 then if ch = `>` then (e_w_s in_file ` `) else pg_failwith ch prdn_name `strange ending for an arrow.` else if ch = `-` then eat_arrow prdn_name (read_char in_file) in_file (n+1) else failwith pg_failwith ch prdn_name `strange character in arrow.`;; % ===================================================================== % % unwind_parens: Construct enough parentheses to match the open ones. % % ===================================================================== % letrec unwind_parens par = if par = 0 then [] else (`)` . (unwind_parens (par-1)));; % ===================================================================== % % finish_arm: Put the code for a given arm of a production together. % % ===================================================================== % let finish_arm whole letrefs return failed parens next_thing = (append whole (append letrefs (append [return] (append [parens] (append failed next_thing)))));; % ===================================================================== % % new_letrefs: Generate a new "let" statement. % % ===================================================================== % let new_letrefs new_name next_wd args flag = [[next_wd;args;(if flag then `MARK` else ``);`in`;`let`]; (top_or_middle new_name);[`in`]];; % ===================================================================== % % NT_letrefs: Make a "let" statement for non-terminal symbols. % % ===================================================================== % let NT_letrefs new_name next_wd args = append [[`let`;(concat `(` new_name);`,`; `result_list`;`, prev, lst) =`]] (new_letrefs new_name next_wd args true);; % ===================================================================== % % ACTION_letrefs: Make a "let" statement after returning from an action % % symbol. % % ===================================================================== % let ACTION_letrefs new_name next_wd args = append [[`let` ; new_name ; `=`]] (new_letrefs new_name next_wd args false);; % ===================================================================== % % MK_failed: If we need to fail here, generate the code. % % ===================================================================== % let MK_failed failcond prdn msg update_list = if failcond then [[`else`];[`fail`]] else [[]];; % ===================================================================== % % MK_return: generate a call to the "do_return" function. % % ===================================================================== % let MK_return prev flag prdn = [(`do_return result_list whitespace \``^prdn^`\` `^separator prev^` lst ` ^(if flag then `expected` else `\`nil\``))];; % ===================================================================== % % system_function: Are we using a system function? % % ===================================================================== % let system_function next_wd = mem next_wd [`TOKEN`;`PARSE_text`;`PARSE_file`;`TOKEN_1`;`push`;`pop`; `write_string`;`read_char`;`close_file`;`open_file`;`e_w_s`; `e_w_s_ok`;`determine_lst`;`get_word`;`get_word1`; `get_word2`;`complete_separator`;`read_input`; `gnt`;`eat_terminal`;`chop_off`;`do_return`;`do_return_1`; `debug_enter`;`debug_on`;`debug_off`;`debug_return`];; % ===================================================================== % % terminal_errors: Different kinds of errors at the end of terminals. % % ===================================================================== % let terminal_errors prdn_name next_wd next_ch = if next_wd = `]` then pg_failwith next_wd prdn_name `can't have imbedded epsilons.` else if not (next_ch = `]`) then pg_failwith next_ch prdn_name (concatl [`improper ending to terminal_sybol "`; next_wd;`" (\``;next_ch;`\`).`]) else ();; % ===================================================================== % % prdn_errors: Different errors that can occur when trying to parse a % % production name. % % ===================================================================== % let prdn_errors prdn_name next_wd = if system_function next_wd then pg_failwith next_wd prdn_name (concatl [`"`;next_wd;`" is a system function.`]) else if next_wd = `type` then pg_failwith `type` prdn_name `"type" is a reserved word in HOL.` else if next_wd = `WORD` then pg_failwith `WORD` prdn_name `"WORD" is a reserved word.` else if next_wd = `TOKEN` then pg_failwith `TOKEN` prdn_name `calls to "TOKEN" may not be non-terminals.` else if next_wd = `MAIN_LOOP` then pg_failwith `MAIN_LOOP` prdn_name `"MAIN_LOOP" may not be called.` else if next_wd = `-->` then pg_failwith `-->` prdn_name (concatl [`no terminating \`.\` in the production "`; prdn_name;`".`]) else ();; % ===================================================================== % % action_errors: The different things you CAN'T have as action symbol % % names. % % ===================================================================== % let action_errors prdn_name act_name = if mem act_name [`TOKEN`;`TOKEN_1`;`PARSE_file`;`PARSE_text`;`MAIN_LOOP`; `push`;`pop`;`write_string`;`read_char`;`close_file`; `open_file`;`e_w_s`;`e_w_s_ok`;`determine_lst`;`get_word`; `get_word1`;`get_word2`;`complete_separator`;`read_input`; `gnt`;`eat_terminal`;`chop_off`;`do_return`; `do_return_1`;`debug_enter`;`debug_on`;`debug_off`; `debug_return`;`WORD`] then pg_failwith act_name prdn_name (concatl [`can't use "`;act_name; `" as the name of an action.`]) else ();; % ===================================================================== % % final_trap: Generate an ending "fail" if required. % % ===================================================================== % let final_trap flag prdn = if flag then [[`?`];[`fail`];[`;;`]] else [[`;;`]];; % ===================================================================== % % get_rest_of_prdn: Here it is, the one you've all been waiting for. % % We parse in a given productions generating the ML % % code that implements it. % % ===================================================================== % letrec get_rest_of_prdn prdn_name letrefs whole ch in_file par tmp_num failcond out_file prev t_par = if ch = `.` then (add_EXPECTED `expected` (not t_par); finish_arm whole letrefs (MK_return prev t_par prdn_name) (MK_failed failcond prdn_name `` true) (unwind_parens par) (final_trap failcond prdn_name)) else if ch = `|` then let (condition,next_ch,nprev,nfailcond) = (get_terminal `else` (e_w_s in_file ` `) in_file prdn_name failcond) in add_EXPECTED `expected` (not t_par); get_rest_of_prdn prdn_name [[``]] (finish_arm whole letrefs (MK_return prev t_par prdn_name) (MK_failed failcond prdn_name `` false) (unwind_parens par) condition) next_ch in_file 1 0 nfailcond out_file nprev true else if ch = `{` then let (act_name,next_ch) = get_word in_file (e_w_s in_file ` `) out_file prdn_name `first` in action_errors prdn_name act_name; let (lrefs,call,t_num,nnext_ch,nprev,ntp) = get_args_act next_ch in_file act_name letrefs tmp_num prdn_name prev t_par in get_rest_of_prdn prdn_name (append lrefs (ACTION_letrefs (tmp_var `tmp` t_num) (concatl call) ``)) whole nnext_ch in_file par t_num failcond out_file nprev ntp else if ch = `[` then let (next_wd,next_ch) = get_word in_file (e_w_s in_file (read_char in_file)) out_file prdn_name `terminal` in terminal_errors prdn_name next_wd next_ch; let nxt = EOF next_wd in add_EXPECTED (`\``^nxt^`\``) (not t_par); get_rest_of_prdn prdn_name (append letrefs [(if prev = `WORD` then [] else MK_word prev); [`let`;`(WORD,lst)`;`=`;`eat_terminal`; (concatl [`\``;nxt;`\``]);`WORD`;`lst`; (concatl [`\``;prdn_name;`\``])]; [`in`]; [`let`;`TOKENS`;`=`;`explode WORD`;`in`]]) whole (e_w_s in_file (read_char in_file)) in_file par tmp_num failcond out_file `WORD` true else let (next_wd , next_ch) = get_word in_file ch out_file prdn_name `first` in prdn_errors prdn_name next_wd; let (args , nnext_ch) = get_args_prdn next_ch in_file prdn_name prev and new_name = (tmp_var next_wd tmp_num) in add_EXPECTED `\`nil\`` (not t_par); get_rest_of_prdn prdn_name (append letrefs (NT_letrefs new_name next_wd args)) whole nnext_ch in_file par (tmp_num+1) failcond out_file `prev` false;; % ===================================================================== % % process: Drives get_rest_of_prdn by initialising some variables and % % getting the code for the first terminal symbol if it exists. % % ===================================================================== % let process in_file prdn_name ch out_file = let (args,next_ch) = get_args_prdn ch in_file prdn_name `prev` in let nnext_ch = eat_arrow prdn_name next_ch in_file 0 in let (condition,nnnext_ch,nprev,failcond) = get_terminal `if` nnext_ch in_file prdn_name false in EXPECTED := []; get_rest_of_prdn prdn_name [] condition nnnext_ch in_file 1 0 failcond out_file nprev true;; % ===================================================================== % % MK_lambda: Start out the lambda expression for a given production. % % ===================================================================== % let MK_lambda wrd call_list = append [[wrd;`:=`;`\L`; ` \\lst `;`whitespace `;`prev `; `result_list `;`FIRST_CHARS `;`CHARS `; `expected`]; [`.`]] (append [(MK_start `prev`)] (append [[(`debug_enter(\``^wrd^`\`,expected,WORD)`);`;`]] call_list));; % ===================================================================== % % write_decs: Output the dummy declaration for a given production. % % ===================================================================== % let write_decs wrd out_file out_type = write_string `letref ` out_file; write_string wrd out_file; write_string `\L (lst:string list) (whitespace:string)` out_file; write_string `(prev:string)\L` out_file; write_string ` (result_list:` out_file; write_string out_type out_file; write_string ` list)\L` out_file; write_string ` (FIRST_CHARS:string list) (CHARS:string list) ` out_file; write_string `(expected:string) =\L` out_file; write_string ` (fail:` out_file; write_string out_type out_file; write_string `,fail:` out_file; write_string out_type out_file; write_string ` list,fail:string,fail:string list);;\L\L` out_file;; % ===================================================================== % % make_main_wrapper: Generate the functions PARSE_file and PARSE_text % % when the production MAIN_LOOP is encountered. % % ===================================================================== % let make_main_wrapper out_file = write_string `\L\L Generating PARSE_file and PARSE_text ` `nil`; write_string `(MAIN_LOOP used).\L\L` `nil`; write_string `let PARSE_file (in_file,whitespace,separators) =\L` out_file; write_string ` let white = if null whitespace then\L` out_file; write_string ` [\` \`;\`\\T\`;\`\\L\`]\L` out_file; write_string ` else\L` out_file; write_string ` whitespace and\L` out_file; write_string ` inf = open_file \`in\` in_file in\L` out_file; write_string ` let WORD = e_w_s inf (hd white) white in\L` out_file; write_string ` let lst = read_input inf [] white separators ` out_file; write_string `WORD IGNORE USEFUL in\L` out_file; write_string ` let (WORD,lst) = (hd lst,tl lst) in\L` out_file; write_string ` let result = fst (MAIN_LOOP lst (hd white) ` out_file; write_string `WORD []\L` out_file; write_string ` FIRST_CHARS CHARS` out_file; write_string ` \`nil\`) in\L` out_file; write_string ` result\L` out_file; write_string ` ? fail;;\L\L` out_file; write_string `let PARSE_text (text,whitespace,separators) =\L` out_file; write_string ` let outf = open_file \`out\` ` out_file; write_string `\`/tmp/.000HOL\` in\L` out_file; write_string ` write_string text outf;\L` out_file; write_string ` close_file outf;\L` out_file; write_string ` let result = PARSE_file (\`/tmp/.000HOL\`,` out_file; write_string `whitespace,separators) in\L` out_file; write_string ` unlink \`/tmp/.000HOL\`; result;;\L\L` out_file;; % ===================================================================== % % emit_firsts: Output the code for CHARS or FIRST_CHARS. % % ===================================================================== % let emit_firsts wrd firsts file = if can implode (words firsts) then write_string (concatl [wrd;` := words \``;firsts;`\`;;\L\L`]) file else pg_failwith firsts wrd (concatl [wrd;` must be a list of single characters.`]);; % ===================================================================== % % emit_specials: Output the code for IGNORE or USEFUL. % % ===================================================================== % let emit_specials wrd specials file = write_string (concatl [wrd;` := `;specials;`;;\L\L`]) file;; % ===================================================================== % % token_failwith: Error message used while generating the tokeniser. % % ===================================================================== % let token_failwith missing = failwith (concat `\L\L ERROR in tokeniser generator.\L` (concat ` -- Problem: no definition of ` (concat missing `.\L`)));; % ===================================================================== % % make_tokeniser: Generate the functions TOKEN and TOKEN_1 to check the % % vailidity of an input token against CHARS and % % FIRST_CHARS. % % ===================================================================== % let make_tokeniser out_file firsts chars = if not firsts then if chars then token_failwith `FIRST_CHARS` out_file else close_file out_file else if not chars then if firsts then token_failwith `CHARS` out_file else close_file out_file else (write_string `letrec TOKEN_1 TOKENS CHARS =\L` out_file; write_string ` if null TOKENS then ()\L` out_file; write_string ` else if mem (hd TOKENS) CHARS then\L` out_file; write_string ` TOKEN_1 (tl TOKENS) CHARS\L` out_file; write_string ` else\L` out_file; write_string ` fail;;\L\L` out_file; write_string `let TOKEN TOKENS FIRST_CHARS CHARS next expected =\L` out_file; write_string ` if mem (hd TOKENS) FIRST_CHARS then\L` out_file; write_string ` (TOKEN_1 (tl TOKENS) CHARS;\L` out_file; write_string ` let wrd = implode TOKENS in\L` out_file; write_string ` if expected = \`nil\` then\L` out_file; write_string ` wrd\L` out_file; write_string ` else if expected = next then\L` out_file; write_string ` wrd\L` out_file; write_string ` else fail)\L` out_file; write_string ` else\L` out_file; write_string ` fail\L` out_file; write_string ` ? fail;;\L\L` out_file; close_file out_file);; % ===================================================================== % % decls_fail: Convenient wrapper for pg_failwith used in decls_errors. % % ===================================================================== % let decls_fail wrd = pg_failwith wrd wrd (concatl [`multiple definitions of "`;wrd; `" are not allowed.`]);; % ===================================================================== % % decls_errors: Make sure everything is defined as far as CHARS and % % FIRST_CHARS are concerned. % % ===================================================================== % let decls_errors wrd firsts chars = if wrd = `FIRST_CHARS` then if firsts then decls_fail wrd else (true,chars) else (if chars then decls_fail wrd else (firsts,true));; % ===================================================================== % % make_productions: Overall driver for deciding if we're dealing with % % a declaration or a production. The appropriate % % function is called, and the code for it is gener- % % ated. % % ===================================================================== % letrec make_productions in_file out_file out_decs out_type firsts chars = let (wrd , ch) = get_word in_file (eat_white_space in_file ` `) out_file `UNKNOWN (starting a new one)` `first` in if ch = `nil` then (close_file in_file ; close_file out_file; make_tokeniser out_decs firsts chars) else if wrd = `type` then pg_failwith wrd wrd `"type" is a reserved word in HOL.` else if mem wrd [`TOKEN`;`PARSE`] then pg_failwith wrd wrd (concatl [`can't use "`;wrd;`" as a production name.`]) else if wrd = `TOKEN_1` then pg_failwith `TOKEN_1` `TOKEN_1` `"TOKEN_1" is a system function.` else if mem wrd [`FIRST_CHARS`;`CHARS`] then let (nfirsts,nchars) = decls_errors wrd firsts chars in emit_firsts wrd (get_inits in_file ch wrd) out_decs; make_productions in_file out_file out_decs out_type nfirsts nchars else if mem wrd [`USEFUL`;`IGNORE`] then (emit_specials wrd (get_inits_specials in_file ch wrd) out_decs; make_productions in_file out_file out_decs out_type firsts chars) else (write_decs wrd out_decs out_type; write_final_all (MK_lambda wrd (process in_file wrd ch out_file)) out_file 0 `st`; if wrd = `MAIN_LOOP` then make_main_wrapper out_file else (); make_productions in_file out_file out_decs out_type firsts chars);; % ===================================================================== % % get_ty: Make sure the user gave us some input for the output type of % % the generated parser. % % ===================================================================== % letrec get_ty lst flag = let ch = read_char `nil` in if ch = `\L` then if flag then failwith `Must have a type` else implode lst else get_ty (append lst [ch]) false;; % ===================================================================== % % parse: Top-level function for driving the generator. It is the only % % one exported from the section. % % ===================================================================== % let parse () = tty_write `Input file: `; let in_file = terminal_read() in tty_write `Output file: `; let inf = (fst (open_file `in` in_file)) and out_file = terminal_read() in let (outf,outf_decs) = open_file `out` out_file in tty_write `Output type: `; let out_type = get_ty [] true in make_productions inf outf outf_decs out_type false false;; parse;; end_section parser;; let parse = it;; hol88-2.02.19940316/Library/parser/READ-ME0000640000212700021270000000277205034050312015561 0ustar cammcamm+ ===================================================================== + | | | LIBRARY : parser | | | | DESCRIPTION : A parser-generator for the HOL system. | | | | AUTHOR : J.P. Van Tassel | | DATE : 90.07.15 | | | | MODIFIED : | | DATE : | + ===================================================================== + + --------------------------------------------------------------------- + | | | FILES: | | | + --------------------------------------------------------------------- + parser.ml defines the functions that make up the parser- generator, and exports the top level one. general.ml defines a suite of functions used by all generated parsers. + --------------------------------------------------------------------- + | | | TO REBUILD THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) edit the pathnames in the Makefile (if necessary) 2) type "make clean" 3) type "make all" + --------------------------------------------------------------------- + | | | TO USE THE LIBRARY: | | | + --------------------------------------------------------------------- + 1) EITHER copy the files *_ml.o in this library into your current working directory, OR put the pathname of this library on the internal hol search path. 2) To load the library, load the file `parser`. hol88-2.02.19940316/Library/parser/Makefile0000640000212700021270000000347504727144730016305 0ustar cammcamm# ===================================================================== # # MAKEFILE FOR THE HOL LIBRARY: parser # # ===================================================================== # ===================================================================== # MAIN ENTRIES: # # make all : create theories and compile code # # make clean : remove only compiled code # # make clobber : remove both theories and compiled code # # --------------------------------------------------------------------- # # MACROS: # # Hol : the pathname of the version of hol used # # Obj : the default filename extension for compiled lisp files, # for franz it is o, for common lisp it depends on the # implementation # ===================================================================== Hol=../../hol Obj=o # ===================================================================== # Cleaning functions. # ===================================================================== clean: rm -f *_ml.o *_ml.l *.$(Obj) @echo "===> library parser: all object code deleted" clobber: rm -f *_ml.o *_ml.l *.$(Obj) @echo "===> library parser: all object code deleted" # ===================================================================== # Entries for individual files. # ===================================================================== general_ml.o: general.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `general`;;'\ 'quit();;' | ${Hol} parser_ml.o: parser.ml echo 'set_flag(`abort_when_fail`,true);;'\ 'compilet `parser`;;' \ 'quit();;' | ${Hol} # ===================================================================== # Main entry # ===================================================================== all: general_ml.o parser_ml.o @echo "===> library parser rebuilt" hol88-2.02.19940316/Library/prettyp/0000750000212700021270000000000005304705066015043 5ustar cammcammhol88-2.02.19940316/Library/prettyp/PP_printer/0000750000212700021270000000000005533117215017122 5ustar cammcammhol88-2.02.19940316/Library/prettyp/PP_printer/PP_printer.ml0000640000212700021270000001200105071607743021540 0ustar cammcamm%=============================================================================% % % % A General-Purpose % % Pretty-Printer % % for the HOL System % % % %-----------------------------------------------------------------------------% % % % Filename: PP_printer.ml (Main pretty-printing program) % % Version: 1.1 % % Author: Richard J. Boulton % % Date: 5th August 1991 % % % % Special instructions: none % % % %-----------------------------------------------------------------------------% % % % Load sub-files in the following order: % % % % extents.ml % % strings.ml % % ptree.ml % % treematch.ml % % boxes.ml % % treetobox.ml % % boxtostring.ml % % print.ml % % utils.ml % % % %-----------------------------------------------------------------------------% % % % Changes history: % % % % Version 0.0 (pre-release), 23rd March 1990 % % % % Changes to the file `print.ml': % % % % The function `insert_strings' (used by `pp') has been modified to % % interface in a better way to the standard HOL pretty-printer. It now % % uses `print_break' instead of line-feeds. % % % % The function `output_strings' has been modified to take a file handle % % as argument instead of a file name. % % % % A function `pp_write' has been added to pretty-print to a file given % % the appropriate file handle. % % % % Version 1.0, 11th December 1990 % % % % Pretty-printing box structure extended to allow sub-tree addresses to % % be stored in the structure. This enables one to determine what part of % % the print-tree was used to generate a sub-box (when applicable). % % % % Version 1.1, 5th August 1991 % % % %=============================================================================% %-----------------------------------------------------------------------------% % Load the compiled code into ml. % %-----------------------------------------------------------------------------% let path st = library_pathname() ^ `/prettyp/PP_printer/` ^ st and flag = get_flag_value `print_lib` in map (\st. load(path st, flag)) [`extents`; `strings`; `ptree`; `treematch`; `boxes`; `treetobox`; `boxtostring`; `print`; `utils`];; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/boxes.ml0000640000212700021270000005021605071607743020610 0ustar cammcamm% boxes.ml % %-----------------------------------------------------------------------------% % Datatype for boxes of text. % % A box looks like this: % % % % <-io-->@__________________ % % ______| | | % % | | height % % | _________| | % % |_______________| | % % <------fo-------> % % <----------width----------> % % % % `N_box' (null box) is a box with dimensions of length zero. % % `A_box ((width,s),_)' (atomic box) is a box of height 1, width the length % % of the string s (so width is redundant, but useful for efficiency), % % io = 0 and fo = width. % % `L_box ((width,separation,pb1,pb2),_)' (linear box) is a box of height 1, % % io = 0 and fo = width. separation is the number of spaces between the % % back of pb1 and the front of pb2. A linear box is a special case of a % % compound box. The advantage of using a linear box when possible is % % that it takes up less memory. % % `C_box (((io,width,fo),height,(x,y),pb1,pb2),_)' (compound box) is a box % % made from two other boxes, pb1 and pb2. The dimensions of the compound % % box are included. (x,y) are the horizontal (to the right) and vertical % % (downwards) offset of pb2 within the compound box. The offsets are % % measured between the origins of the boxes (labelled by @ in the % % diagram). The offsets of pb1 are (0,0). % rectype * print_box = N_box | A_box of (nat # string) # * | L_box of (nat # nat # * print_box # * print_box) # * | C_box of ((nat # nat # nat) # nat # (int # nat) # * print_box # * print_box) # *;; % Functions to extract the dimensions of a box. % let print_box_io pb = % : (* print_box -> int) % case pb of N_box . 0 | (A_box _) . 0 | (L_box _) . 0 | (C_box (((io,_,_),_),_)) . (Int io);; let print_box_width pb = % : (* print_box -> int) % case pb of N_box . 0 | (A_box ((width,_),_)) . (Int width) | (L_box ((width,_),_)) . (Int width) | (C_box (((_,width,_),_),_)) . (Int width);; let print_box_fo pb = % : (* print_box -> int) % case pb of N_box . 0 | (A_box ((width,_),_)) . (Int width) | (L_box ((width,_),_)) . (Int width) | (C_box (((_,_,fo),_),_)) . (Int fo);; let print_box_height pb = % : (* print_box -> int) % case pb of N_box . 0 | (A_box _) . 1 | (L_box _) . 1 | (C_box ((_,height,_),_)) . (Int height);; let print_box_sizes pb = % : (* print_box -> (int # int # int) # int) % case pb of N_box . ((0,0,0),0) | (A_box ((w,_),_)) . (let w' = Int w in ((0,w',w'),1)) | (L_box ((w,_),_)) . (let w' = Int w in ((0,w',w'),1)) | (C_box (((io,w,fo),h,_),_)) . ((Int io,Int w,Int fo),Int h);; % Function for changing the `label' of a print_box. % let replace_box_label v pb = % : (* -> * print_box -> * print_box) % case pb of N_box . pb | (A_box (x,_)) . (A_box (x,v)) | (L_box (x,_)) . (L_box (x,v)) | (C_box (x,_)) . (C_box (x,v));; % Datatype for indentation values. % % `Abs' is absolute indentation (relative to first sub-box). % % `Inc' is incremental indentation (relative to previous sub-box). % type print_indent = Abs of int | Inc of int;; % Datatype for boxes ready to be built. % % The boxes are just waiting to be told what horizontal space is available % % to them before taking on their final form. % % The sub-boxes can be composed horizontally (H), vertically (V), % % horizontal/vertically (HV), or horizontal-or-vertically (HoV). % % Each sub-box is represented by an object of type % % (int -> int -> * print_box). This is a function which when given the % % current output width and the current indentation from the left margin, % % yields a box. % % The first sub-box is fixed. All the others carry offset information with % % them. % type * unbuilt_box = UB_H of (int -> int -> * print_box) # (nat # (int -> int -> * print_box)) list | UB_V of (int -> int -> * print_box) # ((print_indent # nat) # (int -> int -> * print_box)) list | UB_HV of (int -> int -> * print_box) # ((nat # print_indent # nat) # (int -> int -> * print_box)) list | UB_HoV of (int -> int -> * print_box) # ((nat # print_indent # nat) # (int -> int -> * print_box)) list;; begin_section boxes;; % Function for joining two boxes together. % % `x' and `y' have rather strange definitions which allow the one function % % to be used for joining boxes both horizontally and vertically. Note that % % `join_boxes' does not work properly with boxes of zero height. % % The intermediate values `lo' and `ro' are illustrated (both with positive % % values) in the diagram below: % % % % _______ <-ro-> % % ____| _____|_____ % % |______|_| ___| % % |__________| % % % % % % The composition of the two boxes looks like this: % % % % _____________ % % ____| | % % | ___| % % |______________| % % % let join_boxes x y pb1 pb2 v = % : (int -> int -> * print_box -> * print_box -> * -> * print_box) % let ((io1,w1,fo1),h1) = print_box_sizes pb1 and ((io2,w2,fo2),h2) = print_box_sizes pb2 in let lo = x - io2 and ro = (w2 - io2) - (w1 - x) in let io = if (lo < 0) then (io1 - lo) else io1 and w = if (lo < 0) then if (ro < 0) then (w1 - lo) else w2 else if (ro < 0) then w1 else (w2 + lo) and fo = if (lo < 0) then fo2 else (fo2 + lo) and h = h1 + h2 + y and x2 = x - io1 and y2 = h1 + y in if (h = 1) then L_box ((Nat w,Nat (x2 - w1),pb1,pb2),v) else C_box (((Nat io,Nat w,Nat fo),Nat h,(x2,Nat y2),pb1,pb2),v);; % Function to join boxes horizontally with separation `dx'. % % Composition with an `N_box' leaves the other box unchanged. % % Composing two boxes horizontally: % % % % |dx| % % _______ % % ____| _____|_____ % % |______|__| ___| | -y % % |__________| % % <----x----> % % % let join_H_boxes dx pb1 pb2 v = % : (nat -> * print_box -> * print_box -> * -> * print_box) % case (pb1,pb2) of (N_box,_) . pb2 | (_,N_box) . pb1 | (_) . (join_boxes ((print_box_fo pb1) + (Int dx)) (-1) pb1 pb2 v);; % Function to join boxes vertically with separation `dh' % % and indentation `di'. % % Composition with an `N_box' leaves the other box unchanged. % % Composing two boxes vertically: % % % % _______ % % ____| __| % % |_________| % % _______ | y = dh % % _____| __| % % |__________| % % <---x---> % % % let join_V_boxes di dh pb1 pb2 v = % : (int -> nat -> * print_box -> * print_box -> * -> * print_box) % case (pb1,pb2) of (N_box,_) . pb2 | (_,N_box) . pb1 | (_) . (join_boxes ((print_box_io pb1) + di) (Int dh) pb1 pb2 v);; % Function to build a horizontal (H) box. % % The sub-function `gaps' is used to compute the total separation between % % the sub-boxes. To this is added the number of sub-boxes (less the first). % % The available width (m) is then reduced by this total to give the new % % available width (m'). This is an attempt to guess how much space to leave % % on the line for the remainder of the sub-boxes. The effective width of % % each sub-box is assumed to be one. In fact it could be any value, even % % negative. The heuristic seems to work well in practice though, probably % % because most horizontal boxes that are large enough to spread over more % % than one line are of the form parenthesis - large block - parenthesis, or % % in place of the parentheses, some other single character. % % As each sub-box is built, the gap between it and the previous sub-box % % plus one is added back on to the available width, and the indentation % % from the left margin is changed by the genuine amount. In fact, the % % indentation is computed each time from the original indentation, the % % effective width of the box built so far, and the effective width of the % % latest sub-box. % let build_H_box m i v box boxl = % : (int -> int -> * -> (int -> int -> * print_box) -> % % (nat # (int -> int -> * print_box)) list -> * print_box) % letrec f pb m' boxl' = % : (* print_box -> int -> % % (nat # (int -> int -> * print_box)) list -> * print_box) % if (null boxl') then pb else let (dx,pbfn) = hd boxl' in let m'' = m' + 1 + (Int dx) and i' = i + ((print_box_fo pb) - (print_box_io pb)) + (Int dx) in f (join_H_boxes dx pb (pbfn m'' i') v) m'' (tl boxl') and gaps boxl' = % : ((nat # (int -> int -> * print_box)) list -> int) % itlist (\x n. (Int (fst x)) + n) boxl' 0 in let m' = m - ((gaps boxl) + (length boxl)) in f (box m' i) m' boxl;; % Function to build a vertical (V) box. % % The sub-boxes are composed vertically. The indentation from the left % % margin is modified as each sub-box is added. % let build_V_box (m:int) i v box boxl = % : (int -> int -> * -> (int -> int -> * print_box) -> % % ((print_indent # nat) # (int -> int -> * print_box)) list -> % % * print_box) % letrec f pb i' boxl' = % : (* print_box -> int -> % % ((print_indent # nat) # (int -> int -> * print_box)) list -> % % * print_box) % if (null boxl') then pb else let ((pi,dh),pbfn) = hd boxl' in let di = case pi of (Abs n) . n | (Inc n) . (n + i' - i) in f (join_V_boxes di dh pb (pbfn m (i + di)) v) (i + di) (tl boxl') in f (box m i) i boxl;; % Function to build a horizontal/vertical (HV) box. % % The sub-function `fH' generates a list of boxes to be composed vertically % % where each box has been made up by composing one or more of the original % % sub-boxes horizontally. The list generated is in reverse order and the % % indentations for the vertical composition are offsets from the first % % box. Note that the function used with `itlist' reverses its arguments. % % Consideration of the call to `itlist' should reveal the rather delicate % % nature of the composition occurring. The order in which the composition % % is done is crucially linked with whether the indentations are absolute or % % relative. % % The sub-function builds horizontal boxes until they are too big, and then % % adds them to a list of boxes built so far. When trying to add a sub-box % % to the current horizontal box, the function evaluates by how much the % % offset from the left margin (i') will be increased if a line-break is not % % used. If this is less than or equal to the increase that will occur with % % a line-break, the sub-box is added to the horizontal box regardless. % % The function uses two criteria for determining when to break. If the new % % box is wider than the available space, a break must occur. There must % % also be a break if the right-hand edge of the box exceeds the right-hand % % margin. The two criteria are not necessarily the same because the % % indentation may force the box further to the right. Since the indentation % % can also be negative, it could pull the box to the left, giving a false % % result. For this reason negative indentations are taken to be zero. % % The vertical composition parameters of the first sub-box of a horizontal % % box are remembered when it is started, so that they become the parameters % % for the composite horizontal box. % let build_HV_box m i v box boxl = % : (int -> int -> * -> (int -> int -> * print_box) -> % % ((nat # print_indent # nat) # (int -> int -> * print_box)) list -> % % * print_box) % letrec fH newboxl newbox i' boxl' = % : ((int # nat # * print_box) list -> % % (int # nat # * print_box) -> int -> % % ((nat # print_indent # nat) # (int -> int -> * print_box)) list -> % % (int # nat # * print_box) list) % if (null boxl') then newbox.newboxl else let ((dx,pi,dh),pbfn) = hd boxl' and (newdi,newdh,pb) = newbox in let di = case pi of (Abs n) . n | (Inc n) . (n + i' - i) and no_break_indent = (Int dx) + (print_box_fo pb) - (print_box_io pb) in if ((di - (i' - i)) < no_break_indent) then let newb = pbfn m (i + di) in let newhb = join_H_boxes dx pb newb v in if (((print_box_width newhb) > m) or ((print_box_width newhb) - (print_box_io newhb) > (m - max [i';0]))) then fH (newbox.newboxl) (di,dh,newb) (i + di) (tl boxl') else fH newboxl (newdi,newdh,newhb) i' (tl boxl') else let newhb = join_H_boxes dx pb (pbfn m (i' + no_break_indent)) v in fH newboxl (newdi,newdh,newhb) i' (tl boxl') in let newboxl = fH [] (0,Nat 0,box m i) i boxl in itlist (\(di,dh,pb2) pb1. join_V_boxes di dh pb1 pb2 v) newboxl N_box;; % Function to build a horizontal-or-vertical (HoV) box. % % The sub-function `f' computes the indentations for each box and builds % % the sub-boxes under the assumption that each will go on a new line. % % The body of the main function composes the boxes horizontally. If the % % resulting box is too big (see comments for `build_HV_box'), the boxes are % % composed vertically. The narrower of the two compositions is then used. % % See comments for `build_HV_box' regarding use of `itlist' for composing. % let build_HoV_box m i v box boxl = % : (int -> int -> * -> (int -> int -> * print_box) -> % % ((nat # print_indent # nat) # (int -> int -> * print_box)) list -> % % * print_box) % letrec f newboxl i' boxl' = % : ((nat # int # nat # * print_box) list -> int -> % % ((nat # print_indent # nat) # (int -> int -> * print_box)) list -> % % (nat # int # nat # * print_box) list) % if (null boxl') then newboxl else let ((dx,pi,dh),pbfn) = hd boxl' in let di = case pi of (Abs n) . n | (Inc n) . (n + i' - i) in f ((dx,di,dh,pbfn m (i + di)).newboxl) (i + di) (tl boxl') in let newb = box m i and newboxl = f [] i boxl in let newhb = itlist (\(dx,di,dh,pb2) pb1. join_H_boxes dx pb1 pb2 v) newboxl newb in let hw = print_box_width newhb and hio = print_box_io newhb in if ((hw > m) or (hw - hio > (m - max [i;0]))) then let newvb = itlist (\(dx,di,dh,pb2) pb1. join_V_boxes di dh pb1 pb2 v) newboxl newb in let vw = print_box_width newvb and vio = print_box_io newvb in if ((hw > vw) or (hw - hio > vw - vio)) then newvb else newhb else newhb;; % Function for building a box. % % The value v is used as the `label' for all sub-boxes constructed. % let build_print_box m i v unbox = % : (int -> int -> * -> * unbuilt_box -> * print_box) % case unbox of (UB_H (box,boxl)) . (build_H_box m i v box boxl) | (UB_V (box,boxl)) . (build_V_box m i v box boxl) | (UB_HV (box,boxl)) . (build_HV_box m i v box boxl) | (UB_HoV (box,boxl)) . (build_HoV_box m i v box boxl);; build_print_box;; end_section boxes;; let build_print_box = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/boxtostring.ml0000640000212700021270000001221405071607744022047 0ustar cammcamm% boxtostring.ml % %-----------------------------------------------------------------------------% begin_section boxtostring;; % Function to join two strings with specified x-coordinates into one string % % The function fails if the strings are overlapping. % let join_strings (s1,x1) (s2,x2) = % : (string # int -> string # int -> string # int) % if (x1 = x2) then if ((s1 = ``) or (s2 = ``)) then (s1 ^ s2,x1) else failwith `join_strings -- overlapping strings` else if (x1 < x2) then let sep = x2 - (x1 + length (explode s1)) in if (sep < 0) then failwith `join_strings -- overlapping strings` else (s1 ^ (string_copies ` ` sep) ^ s2,x1) else let sep = x1 - (x2 + length (explode s2)) in if (sep < 0) then failwith `join_strings -- overlapping strings` else (s2 ^ (string_copies ` ` sep) ^ s1,x2);; % Function to merge two lists of strings with x and y-coordinates. % % The two input lists should be in increasing order of y coordinate and % % contain at most one string for each value of y. The resulting list has % % the same properties. % letrec merge_string_lists sl1 sl2 = % : ((string # int # int) list -> (string # int # int) list -> % % (string # int # int) list) % if (null sl1) then sl2 else if (null sl2) then sl1 else let (s1,x1,y1) = hd sl1 and (s2,x2,y2) = hd sl2 in (if (y1 = y2) then (let (s,x) = join_strings (s1,x1) (s2,x2) in (s,x,y1).(merge_string_lists (tl sl1) (tl sl2))) if (y1 < y2) then (hd sl1).(merge_string_lists (tl sl1) sl2) if (y1 > y2) then (hd sl2).(merge_string_lists sl1 (tl sl2)) else fail);; % Function to convert a box of text into a list of strings. % % The x,y coordinates of the origin of the box must be specified. % % The `labels' in the box are discarded. % letrec stringify_print_box x y pb = % : (int -> int -> * print_box -> (string # int # int) list) % case pb of (N_box) . [] | (A_box ((_,s),_)) . [s,x,y] | (L_box ((_,sep,pb1,pb2),_)) . (merge_string_lists (stringify_print_box x y pb1) (stringify_print_box (x + (print_box_width pb1) + (Int sep)) y pb2)) | (C_box ((_,_,(x2,y2),pb1,pb2),_)) . (merge_string_lists (stringify_print_box x y pb1) (stringify_print_box (x + x2) (y + (Int y2)) pb2));; % Function to convert a list of strings (with coordinates) into a list of % % strings suitable for use as output. % % The y coordinates of the top and bottom of the block of text must be % % specified. If any of the strings in the input list are out of the text % % region specified, an error occurs. This error will only reach top-level % % if debugging is set to true. Otherwise, the string `*error*' is inserted % % in the text produced. % letrec fill_in_strings debug t b sl = % : (bool -> int -> int -> (string # int # int) list -> string list) % if ((t = b) or (t > b)) then if (null sl) then [] else if debug then failwith `fill_in_strings -- string below specified region` else [`*error*`] else if (null sl) then (``).(fill_in_strings debug (t+1) b sl) else let (s,x,y) = hd sl in if (x < 0) then if debug then failwith (`fill_in_strings -- ` ^ `string to the left of specified region`) else fill_in_strings debug t b ((`*error*`,0,y).(tl sl)) else if (y < t) then if debug then failwith (`fill_in_strings -- ` ^ `string above specified region`) else (`*error*`).(fill_in_strings debug t b (tl sl)) else if (y = t) then ((string_copies ` ` x) ^ s). (fill_in_strings debug (t+1) b (tl sl)) else (``).(fill_in_strings debug (t+1) b sl);; % Function to convert a box of text into a list of strings suitable for % % output. % % An indentation from the left margin must be specified. The `debug' % % argument determines whether or not errors reach top-level. % % The `labels' in the box are discarded. % let print_box_to_strings debug i pb = % : (bool -> int -> * print_box -> string list) % fill_in_strings debug 0 (print_box_height pb) (stringify_print_box i 0 pb);; print_box_to_strings;; end_section boxtostring;; let print_box_to_strings = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/extents.ml0000640000212700021270000000447705071607744021173 0ustar cammcamm% extents.ml % %-----------------------------------------------------------------------------% % General-purpose extentions to ML required by the pretty-printer. % % Function to find the maximum element of a list of integers. % % Fails if given a null list. % let max l = % : (int list -> int) % letrec max_fun m l = % : (int -> int list -> int) % if (null l) then m else if ((hd l) > m) then max_fun (hd l) (tl l) else max_fun m (tl l) in if (null l) then failwith `max -- null list given` else max_fun (hd l) (tl l);; % Function to find the minimum element of a list of integers. % % Fails if given a null list. % let min l = % : (int list -> int) % letrec min_fun m l = % : (int -> int list -> int) % if (null l) then m else if ((hd l) < m) then min_fun (hd l) (tl l) else min_fun m (tl l) in if (null l) then failwith `min -- null list given` else min_fun (hd l) (tl l);; % Function to replace the values associated with a list of keys in an % % association list. If a key is not in the association list it is added. % % If a key occurs more than once, only one remains (unless the key occurs % % more than once in the changes). The order of the keys is changed. % letrec change_assocl assocl changes = % : ((* # **) list -> (* # **) list -> (* # **) list) % if (null assocl) then changes else if (can (assoc (fst (hd assocl))) changes) then (change_assocl (tl assocl) changes) else (hd assocl).(change_assocl (tl assocl) changes);; % Abstract datatype for natural numbers (where zero is taken to be natural) % abstype nat = int with Nat n = if (n < 0) then failwith `Nat -- number cannot be negative` else abs_nat n and Int n = rep_nat n and print_nat n = print_int (rep_nat n);; % Directive to print natural numbers as if they were integers. % top_print print_nat;; % Function to find the current display width. % let get_margin (():void) = % : (void -> int) % let old = set_margin 0 in let new = set_margin old in old;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/print.ml0000640000212700021270000000660505071607745020631 0ustar cammcamm% print.ml % %-----------------------------------------------------------------------------% begin_section print;; % Function to write a list of strings to the terminal. % % Each string is followed by a line-feed. % let display_strings sl = % : (string list -> void) % do (map (\s. tty_write (s ^ `\L`)) sl);; % Function to write a list of strings to a file. % % Each string is followed by a line-feed. % % The first argument is a file handle. % let output_strings port sl = % : (string -> string list -> void) % do (map (\s. write (port,(s ^ `\L`))) sl);; % Function to insert a list of strings into % % the standard HOL pretty-printer buffer. % % All except the last string are followed by a line break. % let insert_strings sl = % : (string list -> void) % letrec print_strings sl' = % : (string list -> void) % if (null sl') then () else if (null (tl sl')) then print_string (hd sl') else do (print_string (hd sl'); print_break (0,0); print_strings (tl sl')) in do (print_begin 0; print_strings sl; print_end ());; % Function to pretty-print a parse-tree to the terminal. % % If a `DEBUG' parameter is present in the parameter list, the `debug' % % argument to `print_box_to_strings' is set to true. % let pretty_print m i prf context params pt = % : (int -> int -> print_rule_function -> string -> (string # int) list -> % % print_tree -> void) % (display_strings o (print_box_to_strings (can (assoc `DEBUG`) params) i)) (print_tree_to_box m i prf context params pt);; % Function to pretty-print a parse-tree to a file. % % If a `DEBUG' parameter is present in the parameter list, the `debug' % % argument to `print_box_to_strings' is set to true. % % % % The first argument to pp_write is a file handle. % let pp_write port m i prf context params pt = % : (string -> int -> int -> print_rule_function -> % % string -> (string # int) list -> print_tree -> void) % ((output_strings port) o (print_box_to_strings (can (assoc `DEBUG`) params) i)) (print_tree_to_box m i prf context params pt);; % Function to pretty-print a parse-tree, inserting the output into the % % standard HOL pretty-printer buffer. % % If a `DEBUG' parameter is present in the parameter list, the `debug' % % argument to `print_box_to_strings' is set to true. % % The width of the display is obtained from the parameter set by the HOL % % function `set_margin'. The initial indentation is taken to be zero. % let pp prf context params pt = % : (print_rule_function -> string -> (string # int) list -> print_tree -> % % void) % (insert_strings o (print_box_to_strings (can (assoc `DEBUG`) params) 0)) (print_tree_to_box (get_margin ()) 0 prf context params pt);; (pretty_print,pp_write,pp);; end_section print;; let (pretty_print,pp_write,pp) = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/ptree.ml0000640000212700021270000000153605071607745020612 0ustar cammcamm% ptree.ml % %-----------------------------------------------------------------------------% % Datatype for parse-trees used by pretty-printer. % % A node can have any number of children. Leaf nodes are nodes with no % % children. % rectype print_tree = Print_node of string # print_tree list;; % Function to extract name of root node of a parse-tree. % let print_tree_name pt = % : (print_tree -> string) % case pt of (Print_node (s,_)) . s;; % Function to extract the children of the root node of a parse-tree. % let print_tree_children pt = % : (print_tree -> print_tree list) % case pt of (Print_node (_,l)) . l;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/strings.ml0000640000212700021270000000751505071607745021167 0ustar cammcamm% strings.ml % %-----------------------------------------------------------------------------% % String functions. % % Function to obtain a sub-string of a string s. The first i characters are % % discarded, and the next l characters are taken as the sub-string. The % % function fails if the string is not long enough to meet the requirements. % let substr i l s = % : (int -> int -> string -> string) % letrec substr' i' l' sl sl' = % : (int -> int -> string list -> string list -> string list) % if (i' > 0) then if (null sl) then failwith `substr -- string too short` else substr' (i'-1) l' (tl sl) sl' else if (l' > 0) then if (null sl) then failwith `substr -- string too short` else substr' i' (l'-1) (tl sl) ((hd sl).sl') else rev sl' in implode (substr' i l (explode s) []);; % Function to find the number of characters in a string. % let strlen s = % : (string -> int) % length (explode s);; % Function to compute the length of the longest sequence of characters from % % some set which begins a string. % let num_of_leading_chars chars s = % : (string list -> string -> int) % letrec num_of_leading n chars sl = % : (int -> string list -> string list -> int) % if (null sl) then n else if (mem (hd sl) chars) then num_of_leading (n+1) chars (tl sl) else n in num_of_leading 0 chars (explode s);; % Function to remove characters from the beginning of a string. Characters % % are removed until a character is encountered which does not occur in the % % set of specified characters. % let trim_leading_chars chars s = % : (string list -> string -> string) % letrec trim chars sl = % : (string list -> string list -> string list) % if (null sl) then [] else if (mem (hd sl) chars) then trim chars (tl sl) else sl in (implode o (trim chars) o explode) s;; % Function to remove characters from the end of a string. Characters are % % removed until a character is encountered which does not occur in the set % % of specified characters. % let trim_trailing_chars chars s = % : (string list -> string -> string) % letrec trim chars sl = % : (string list -> string list -> string List) % if (null sl) then [] else let rest = trim chars (tl sl) in if ((null rest) & (mem (hd sl) chars)) then [] else (hd sl).rest in (implode o (trim chars) o explode) s;; % Function to remove characters from the beginning and end of a string in % % the manner of `trim_leading_chars' and `trim_trailing_chars'. % let trim_enclosing_chars chars s = % : (string list -> string -> string) % trim_trailing_chars chars (trim_leading_chars chars s);; % Function to test containment of string s2 in string s1. % letrec string_contains s1 s2 = % : (string -> string -> bool) % if ((strlen s2) > (strlen s1)) then false else if ((substr 0 (strlen s2) s1) = s2) then true else string_contains ((implode o tl o explode) s1) s2;; % Function to test containment of string s within the strings sl. % letrec strings_contain sl s = % : (string list -> string -> bool) % itlist (\x y. (string_contains x s) or y) sl false;; % Function to make a string which is n copies of the string s. % letrec string_copies s n = % : (string -> int -> string) % if (n < 1) then `` else s ^ (string_copies s (n - 1));; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/treematch.ml0000640000212700021270000007720005071607746021451 0ustar cammcamm% treematch.ml % %-----------------------------------------------------------------------------% % Matching patterns to parse-trees. % % Datatype for sub-tree addresses. % type address = No_address | Address of int list;; % Datatype for different kinds of object which can be bound during a match. % type metavar_binding = Bound_name of string # address | Bound_names of (string # address) list | Bound_child of print_tree # address | Bound_children of (print_tree # address) list;; % Abbreviation for datatype of bindings of metavariables to objects. % lettype print_binding = (string # metavar_binding) list;; % Abbreviation for datatype of tests on pretty-printing environment. % lettype print_test = (string # int) list -> print_binding -> bool;; % Datatype for bound on number of times a looping match should be attempted % % The bound is either a natural number or the default value. % type loop_limit = Default | Val of nat;; % Datatype of patterns for matching trees. % rectype print_patt_tree = Const_name of string # child_metavar list | Var_name of string # child_metavar list | Wild_name of child_metavar list | Var_child of string | Wild_child | Link_child of (loop_limit # loop_limit) # string list | Print_label of string # print_patt_tree | Print_link of ((loop_limit # loop_limit) # string list) # print_patt_tree | Print_loop of print_patt_tree # print_patt_tree and child_metavar = Var_children of string | Wild_children | Patt_child of print_patt_tree;; % Abbreviation for datatype of pretty-printing language patterns. % lettype print_pattern = string # print_patt_tree # print_test;; % Datatype for `loop-link' information. % % A looping pattern should contain a link which marks the sub-tree to be % % tested on the next time round the loop. It also specifies the number of % % times the loop should go round, and any metavariables which should match % % to the same object on each time round the loop. This datatype represents % % the alternatives of having this information, and not having found a link. % type print_loop_link = No_link | Link of ((loop_limit # loop_limit) # string list) # (print_tree # int list);; % Function to extract the object bound to a specified metavariable from a % % binding. The function fails if the metavariable is not found in the % % binding. % let lookup_metavar pbind mvar = % : (print_binding -> string -> metavar_binding) % ((snd (assoc mvar pbind)):metavar_binding) ? failwith (`lookup_metavar -- Metavariable \``^mvar^`' not found in binding`);; begin_section treematch;; % Function to test whether the values of two metavar bindings are equal. % let eq_metavar_bind mbind1 mbind2 = case (mbind1,mbind2) of (Bound_name (s1,_),Bound_name (s2,_)) . (s1 = s2) | (Bound_names sl1,Bound_names sl2) . (map fst sl1 = map fst sl2) | (Bound_child (pt1,_),Bound_child (pt2,_)) . (pt1 = pt2) | (Bound_children ptl1,Bound_children ptl2) . (map fst ptl1 = map fst ptl2) | (_) . false;; % Function to replace the addresses in a metavar binding with No_address. % let no_address_meta mbind = case mbind of (Bound_name (s,_)) . (Bound_name (s,No_address)) | (Bound_names sl) . (Bound_names (map (\(s,_). (s,No_address)) sl)) | (Bound_child (pt,_)) . (Bound_child (pt,No_address)) | (Bound_children ptl) . (Bound_children (map (\(pt,_). (pt,No_address)) ptl));; % Function to replace the value associated with a given key in an % % association list. If the key is not present, no change is made to the % % association list. If the key occurs more than once, only the first % % occurrence is changed. % letrec replace assocl (key,new) = % : ((* # **) list -> (* # **) -> (* # **) list) % if (null assocl) then [] else if (key = (fst (hd assocl))) then (key,new).(tl assocl) else (hd assocl).(replace (tl assocl) (key,new));; % Function to replace the values associated with a list of keys in an % % association list. The replacement is done in the manner of `replace'. % letrec replacel assocl changes = % : ((* # **) list -> (* # **) list -> (* # **) list) % if (null changes) then assocl else replacel (replace assocl (hd changes)) (tl changes);; % Function to merge two bindings. % % Fails if a metavariable occurs in both bindings, but bound to different % % objects. If objects are the same, only one copy is retained and the % % sub-term addresses are thrown away because they are no longer valid. % let print_merge pb1 (pb2:print_binding) = % : (print_binding -> print_binding -> print_binding) % letrec print_merge' l pb1 pb2 = if (null pb1) then if (null l) then pb2 else filter (\(s,_). not (mem s l)) pb2 else ((let (s,meta) = hd pb1 in let p = assoc s pb2 in if (eq_metavar_bind (snd p) meta) then (s,no_address_meta meta). (print_merge' (s.l) (tl pb1) pb2) else failwith `print_merge`) ??[`assoc`] (hd pb1).(print_merge' l (tl pb1) pb2) ) in print_merge' [] pb1 pb2;; % Function to merge a binding from a looping match with another binding. % % Assumes that all bound items in looppb are lists. If a metavariable % % occurs in both bindings, the single item or list obtained from the second % % binding is appended to the end of the list from the loop binding. Any % % metavariable occurring in only one of the bindings is included in the new % % binding unchanged. The function fails if the bound items have % % inconsistent types. % letrec print_loop_merge looppb (pb:print_binding) = % : (print_binding -> print_binding -> print_binding) % if (null looppb) then pb else ((let (loopm,loopb) = hd looppb in let newb = case (loopb,snd (assoc loopm pb)) of (Bound_names sl1,Bound_name s2) . (Bound_names (sl1 @ [s2])) | (Bound_names sl1,Bound_names sl2) . (Bound_names (sl1 @ sl2)) | (Bound_children ptl1,Bound_child pt2) . (Bound_children (ptl1 @ [pt2])) | (Bound_children ptl1,Bound_children ptl2) . (Bound_children (ptl1 @ ptl2)) | (_) . failwith `print_loop_merge -- inconsistent bindings` in print_loop_merge (tl looppb) (replace pb (loopm,newb))) ??[`assoc`] (hd looppb).(print_loop_merge (tl looppb) pb) );; % Function to convert all single bound items in a binding to lists of one % % element. This is used to make the bound items from a looping match which % % only matched once into lists. % letrec raise_binding (pb:print_binding) = % : (print_binding -> print_binding) % if (null pb) then [] else let (m,b) = hd pb in (m,case b of (Bound_name s) . (Bound_names [s]) | (Bound_names _) . b | (Bound_child pt) . (Bound_children [pt]) | (Bound_children _) . b ).(raise_binding (tl pb));; % Function to merge two bindings generated by the same looping match. % % One binding should be the result from previous times round the loop, and % % the other should be from the current time round the loop. The number and % % ordering of the metavariables should thus be the same in both bindings, % % so for efficiency, this is assumed. If this is not the case, the function % % fails. The bound lists or single items from the two bindings are appended % % into a single list. The types of the items must be consistent. If not the % % function fails. % letrec raise_bindings pb1 (pb2:print_binding) = % : (print_binding -> print_binding -> print_binding) % if (null pb1) then if (null pb2) then [] else failwith `raise_bindings -- inconsistent bindings` else if (null pb2) then failwith `raise_bindings -- inconsistent bindings` else let (m1,b1) = (hd pb1) and (m2,b2) = (hd pb2) in if (m1 = m2) then (m1,case (b1,b2) of (Bound_name s1,Bound_name s2) . (Bound_names (s1.[s2])) | (Bound_name s1,Bound_names sl2) . (Bound_names (s1.sl2)) | (Bound_names sl1,Bound_name s2) . (Bound_names (sl1 @ [s2])) | (Bound_names sl1,Bound_names sl2) . (Bound_names (sl1 @ sl2)) | (Bound_child pt1,Bound_child pt2) . (Bound_children (pt1.[pt2])) | (Bound_child pt1,Bound_children ptl2) . (Bound_children (pt1.ptl2)) | (Bound_children ptl1,Bound_child pt2) . (Bound_children (ptl1 @ [pt2])) | (Bound_children ptl1,Bound_children ptl2) . (Bound_children (ptl1 @ ptl2)) | (_) . failwith `raise_bindings -- ` ^ `inconsistent bindings` ).(raise_bindings (tl pb1) (tl pb2)) else failwith `raise_bindings -- inconsistent bindings`;; % Function to re-order two bindings of the same length and with the same % % bound metavariables so that the metavariables appear in the same order in % % both. The function fails if the number or names of the metavariables from % % the two bindings are not the same. The second binding is re-ordered and % % returned as result. % letrec correspond_bindings (right:print_binding) (wrong:print_binding) = % : (print_binding -> print_binding -> print_binding) % if (null right) then if (null wrong) then [] else failwith `correspond_bindings -- inconsistent bindings` else ( ((assoc (fst (hd right)) wrong). (correspond_bindings (tl right) (filter (\x. not ((fst x) = (fst (hd right)))) wrong))) ?? [`assoc`] failwith `correspond_bindings -- inconsistent bindings` );; % This function is a safe but less efficient version of `raise_bindings'. % % `raise_bindings' is tried first for efficiency, but if it fails, the % % first binding is re-ordered, then `raise_bindings' is tried again. % let raise_bindings_safe wrong right = % : (print_binding -> print_binding -> print_binding) % ( (raise_bindings wrong right) ?? [`raise_bindings -- inconsistent bindings`] (raise_bindings (correspond_bindings right wrong) right) );; % Function to extract names of metavariables and loop-link occurring within % % a tree pattern. The pair of string lists returned as part of the result % % are the names of the metavariables. The first list is of metavariables % % which match to node-names. The second is of metavariables which match to % % sub-trees. The sub-tree in the link information is a null tree, because % % since we are not doing matching, no real tree can be obtained. % letrec extract_info_from_patt ptpatt = % : (print_patt_tree -> ((string list # string list) # print_loop_link)) % let merge_links link1 link2 = % : (print_loop_link -> print_loop_link -> print_loop_link) % case (link1,link2) of (No_link,_) . link2 | (_,No_link) . link1 | (_) . failwith (`extract_info_from_patt -- ` ^ `more than one \`link' for loop`) in case ptpatt of (Const_name (_,cml)) . (let (vars,linkl) = split (map extract_info_from_child cml) in let (nmsl,cmsl) = split vars in ((itlist union nmsl [], itlist union cmsl []), itlist merge_links linkl No_link)) | (Var_name (s,cml)) . (let (vars,linkl) = split (map extract_info_from_child cml) in let (nmsl,cmsl) = split vars in ((itlist union nmsl [s], itlist union cmsl []), itlist merge_links linkl No_link)) | (Wild_name cml) . (let (vars,linkl) = split (map extract_info_from_child cml) in let (nmsl,cmsl) = split vars in ((itlist union nmsl [], itlist union cmsl []), itlist merge_links linkl No_link)) | (Var_child s) . (([],[s]),No_link) | (Wild_child) . (([],[]),No_link) | (Link_child link) . (([],[]),Link (link,(Print_node (``,[]),[]))) | (Print_label (s,ptpatt1)) . (let ((nms,cms),link) = extract_info_from_patt ptpatt1 in ((nms,union [s] cms),link)) | (Print_link (link1,ptpatt1)) . (let ((nms,cms),link2) = extract_info_from_patt ptpatt1 in ((nms,cms), merge_links (Link (link1,(Print_node (``,[]),[]))) link2)) | (Print_loop (ptpatt1,ptpatt2)) . (let ((nms1,cms1),_) = extract_info_from_patt ptpatt1 and ((nms2,cms2),link) = extract_info_from_patt ptpatt2 in ((union nms1 nms2, union cms1 cms2),link)) % Function to extract names of metavariables and loop-link occurring within % % a child (sub-tree). % and extract_info_from_child cm = % : (child_metavar -> ((string list # string list) # print_loop_link)) % case cm of (Var_children s) . (([],[s]),No_link) | (Wild_children) . (([],[]),No_link) | (Patt_child ptpatt) . (extract_info_from_patt ptpatt);; % Function to obtain a dummy binding and the minimum number of times a loop % % should go round from a tree pattern. Fails if pattern does not contain a % % loop-link. This function is for use when a loop matches zero times. % let zero_loop_info ptpatt = % : (print_patt_tree -> (print_binding # loop_limit)) % let ((nms,cms),link) = extract_info_from_patt ptpatt in case link of (No_link) . failwith `zero_loop_info -- no \`link' for loop` | (Link (((min,_),_),_)) . (((map (\s. (s,Bound_names [])) nms) @ (map (\s. (s,Bound_children [])) cms)),min);; % Function to add sub-tree addresses to a list of trees. % let new_addresses address (ptl:print_tree list) = % : (int list -> print_tree list -> (print_tree # int list) list) % letrec new_addresses' n ptl = if (null ptl) then [] else (hd ptl,n.address).(new_addresses' (n + 1) (tl ptl)) in new_addresses' 1 ptl;; % Function to split a list into three parts. % % The list l is broken so that the first of the three lists contains nh % % elements, the third list contains nt elements, and the second list % % contains the elements in between. The function fails if there are % % insufficient elements to do this. % let split_list (nh,nt) l = % : ((int # int) -> * list -> (* list # * list # * list)) % letrec get_head n lh lt = % : (int -> * list -> * list -> (* list # * list)) % if ((n < 0) or (n = 0)) then (lh,lt) else if (null lt) then failwith `split_list -- insufficient elements in list` else get_head (n - 1) (lh @ [hd lt]) (tl lt) in let (h,r) = get_head nh [] l and nm = (length l) - (nh + nt) in if (nm < 0) then failwith `split_list -- insufficient elements in list` else (h,get_head nm [] r);; % Function to match a tree pattern to a tree. % letrec print_tree_match' ptpatt (pt,address) = % : (print_patt_tree -> (print_tree # int list) -> % % (print_binding # print_loop_link)) % % Function to match a looping pattern to a tree. % % The arguments to the sub-function are as follows: % % % % ptpatt: looping pattern % % min: minimum number of times to loop % % n: number of successful loops % % fixedpb: binding of `fixed' metavariables on first time round loop % % pbind: binding obtained so far % % ptadd': parse-tree to be matched on this time round loop % % and its address relative to root % % On the first call to the sub-function, the minimum number of times to % % loop is not known, so it is set to the default value. The number of % % successful loops is zero. The bindings are both empty, and the tree to % % be matched is the whole tree to be matched by the looping pattern. % % `traps' is set to the specific exceptions which correspond to failures % % to match rather than errors. A match is attempted between the pattern % % and the tree. If successful, a binding and a loop-link is obtained. % % The loop-link is examined. If there was no link found, an error is % % raised. If the maximum number of times to loop is the default (which % % is any number of times), the minimum number of times to loop, the list % % of variables to be `fixed', and the new sub-tree to be matched are % % extracted. The minimum number of loops and the fix list are the same % % every time round the loop, so they are only really required on the % % first. The same information is extracted if the maximum number of % % times to loop is not the default, unless the number of successful % % loops so far is greater than or equal to the maximum, when a match % % failure is raised. % % Assuming no match failure has occurred so far, the binding obtained % % from the match and the binding of fixed values are merged. If the % % objects bound to the fixed variables on this time around the loop are % % not the same as those for the first time, a match failure is raised. % % On the first time round the loop, `fixedpb' is null, so the merge % % succeeds trivially. % % If still without a match failure, the function now behaves differently % % on the first time round the loop than on subsequent times. On the % % first time, the minimum number of times to loop is updated. The % % number of successful matches is incremented. The binding obtained is % % filtered for variables in the `fix' list and is used as the new % % `fixedpb'. The binding obtained is `raised' so that the bound items % % are all lists. On subsequent times round the loop, the minimum looping % % value and `fixedpb' are not updated (except that on the second time % % round, sub-tree addresses are thrown away because they are no longer % % valid.), and the new binding is merged with the previous binding in % % such a way that bound lists are appended. % % If any match failure is raised, it is trapped. If it is the first time % % round the loop, a special function is used to obtain a dummy binding % % and the minimum number of times to loop. The loop has matched zero % % times, so all metavariables are bound to empty lists. Whatever the % % value of n, the function checks to see if the minimum number of times % % to loop has been attained. This is trivially so if the minimum number % % is the default of zero. If the minimum number has not been attained a % % match failure is raised (which is not in `traps', so will not be % % trapped by previous function calls). % let loop_match ptpatt ptadd = % : (print_patt_tree -> (print_tree # int list) -> % % (print_binding # print_binding # print_tree)) % letrec loop_match' ptpatt min n fixedpb pbind ptadd' = % : (print_patt_tree -> loop_limit -> nat -> print_binding -> % % print_binding -> (print_tree # int list) -> % % (print_binding # print_binding # print_tree)) % let traps = [`print_tree_match`;`print_merge`] in (let (mainpb,link) = print_tree_match' ptpatt ptadd' in let (min',fixl,newptadd) = case link of (No_link) . failwith (`print_tree_match -- ` ^ `no \`link' for loop`) | (Link (((min,Default),fixl),newptadd)) . (min,fixl,newptadd) | (Link (((min,Val max),fixl),newptadd)) . (if ((Int n) < (Int max)) then (min,fixl,newptadd) else failwith `print_tree_match`) and newpb = print_merge mainpb fixedpb in if ((Int n) = 0) then loop_match' ptpatt min' (Nat ((Int n) + 1)) (filter (\p. mem (fst p) fixl) mainpb) (raise_binding newpb) newptadd if ((Int n) = 1) then loop_match' ptpatt min (Nat ((Int n) + 1)) (map (I # no_address_meta) fixedpb) (raise_bindings_safe pbind newpb) newptadd else loop_match' ptpatt min (Nat ((Int n) + 1)) fixedpb (raise_bindings_safe pbind newpb) newptadd ) ?? traps (let (pb,min') = if ((Int n) = 0) then zero_loop_info ptpatt else (pbind,min) in case min' of (Default) . (pb,fixedpb,ptadd') | (Val m) . (if ((Int m) > (Int n)) then failwith `print_loop_match` else (pb,fixedpb,ptadd'))) in loop_match' ptpatt Default (Nat 0) [] [] ptadd in case ptpatt % Constant node-name with children. % of (Const_name (s,cml)) . (if (s = (print_tree_name pt)) then children_match cml (new_addresses address (print_tree_children pt)) else failwith `print_tree_match`) % Variable node-name with children (node-name to be bound). % % Sub-tree addresses are built up backwards, so have to be reversed % % before being stored. % | (Var_name (s,cml)) . (let (pbind,link) = children_match cml (new_addresses address (print_tree_children pt)) in (print_merge [s,Bound_name (print_tree_name pt,Address (rev address))] pbind, link)) % Variable node-name with children (no binding of node-name). % | (Wild_name cml) . (children_match cml (new_addresses address (print_tree_children pt))) % Variable child (to be bound). % | (Var_child s) . ([s,Bound_child (pt,Address (rev address))],No_link) % Variable child (not to be bound). % | (Wild_child) . ([],No_link) % Loop-link on leaf of pattern tree. % | (Link_child x) . ([],Link (x,(pt,address))) % Labelling of sub-tree of pattern tree. % % Metavariable named is bound to tree matched by sub-tree of pattern. % | (Print_label (label,ptpatt1)) . (let (pbind,link) = print_tree_match' ptpatt1 (pt,address) in (print_merge [label,Bound_child (pt,Address (rev address))] pbind, link)) % Loop-link not on leaf of pattern tree. % % Any loop-link from the sub-tree of the pattern is discarded. % | (Print_link (x,ptpatt1)) . (let (pbind,_) = print_tree_match' ptpatt1 (pt,address) in (pbind,Link (x,(pt,address)))) % Looping pattern. % % First sub-pattern is the looping part. No link is obtained from % % this. The sub-tree produced is used for the second part of the % % match. Any `fixed' variables are removed from the binding obtained % % from the loop. The `fixed' binding is merged with the binding from % % the non-looping part in such a way that the match fails if `fixed' % % variables are not bound to the same object in both. The bindings % % resulting from these two operations are merged so that non-fixed % % variables from the looping part which also occur in the non-looping % % part become bound to a list formed by appending the bound objects % % from the two bindings. Note that if a loop matches zero times, % % `fixedpb' is a null list. This means that any metavariable `fixed' % % in the loop will cease to be treated as `fixed'. % | (Print_loop (ptpatt1,ptpatt2)) . (let (pbind1,fixedpb,ptadd1) = loop_match ptpatt1 (pt,address) in let (pbind2,link) = print_tree_match' ptpatt2 ptadd1 in (print_loop_merge (filter (\x. not (can (assoc (fst x)) fixedpb)) pbind1) (print_merge fixedpb pbind2), link)) % Function to match patterns for children to a list of sub-trees. % and children_match ml ptaddl = % : (child_metavar list -> (print_tree # int list) list -> % % (print_binding # print_loop_link)) % % Function to associate each `child_metavar' to a list of trees. % % Each `Patt_child' has to be associated with exactly one tree. % % `Var_children' and `Wild_children' can be associated with zero or more % % trees. The first `Var_children' or `Wild_children' encountered becomes % % associated with all the `slack' in the list of trees, leaving one tree % % for each remaining `child_metavar'. So, having more than one % % `Var_children' or `Wild_children' is pointless, as all but the first % % will behave like a `Patt_child'. % % If there are insufficient trees to associate one with each % % `Patt_child', the match fails. If there are no `Var_children' or % % `Wild_children' to take up the `slack', then the number of % % `Patt_child's must be the same as the number of trees, or else the % % match fails. % letrec correspond ml' ptaddl' = % : (child_metavar list -> (print_tree # int list) list -> % % (child_metavar # (print_tree list)) list) % if (null ml') then if (null ptaddl') then [] else failwith `print_tree_match` else case (hd ml') of (Var_children _) . ( (let (_,l,r) = split_list (0,length (tl ml')) ptaddl' in ((hd ml'),l).(correspond (tl ml') r)) ? failwith `print_tree_match` ) | (Wild_children) . ( (let (_,l,r) = split_list (0,length (tl ml')) ptaddl' in ((hd ml'),l).(correspond (tl ml') r)) ? failwith `print_tree_match` ) | (Patt_child _) . (if (null ptaddl') then failwith `print_tree_match` else ((hd ml'),[hd ptaddl']). (correspond (tl ml') (tl ptaddl')) ) % Function to match a `child_metavar' to a list of trees. % and child_match m ptaddl' = % : (child_metavar -> (print_tree # int list) list -> % % (print_binding # print_loop_link)) % case (m,ptaddl') of (Var_children s,_) . ([s,Bound_children (map (I # (Address o rev)) ptaddl')],No_link) | (Wild_children,_) . ([],No_link) | (Patt_child ptpatt',[ptadd']) . (print_tree_match' ptpatt' ptadd') | (_) . failwith (`print_tree_match -- ` ^ `inconsistent arguments to child_match`) % Function to match a list of (`child_metavar'/tree list) pairs. % % The bindings are merged so that metavariables occurring in more than % % one have to match to the same object in each of those bindings. If % % more than one loop-link is present, an error occurs. % and merge l = % : ((child_metavar # ((print_tree # int list) list)) list -> % % (print_binding # print_loop_link)) % if (null l) then ([],No_link) else let (pbind1,link1) = uncurry child_match (hd l) and (pbind2,link2) = merge (tl l) in (print_merge pbind1 pbind2, case (link1,link2) of (No_link,_) . link2 | (_,No_link) . link1 | (_) . failwith (`print_tree_match -- ` ^ `more than one \`link' for loop`)) in merge (correspond ml ptaddl);; % Address of root of tree is an empty list. % let print_tree_match ptpatt pt = print_tree_match' ptpatt (pt,[]);; % Function to make context available in parameter list. % let add_context context params = % : (string -> (string # int) list -> (string # int) list) % ((`CONTEXT_` ^ context),0).params;; % Function to match a pretty-printing pattern to a tree under a % % pretty-printing environment. % % If the context of the pattern is the null string or matches the context % % of the environment, then an attempt is made to match the tree. If a % % loop-link appears at top-level, it is not used within a loop, so an error % % occurs. A test is applied to the result of the match. % let print_pattern_match (ppatt:print_pattern) context params pt = % : (print_pattern -> string -> (string # int) list -> print_tree -> % % print_binding) % if (((fst ppatt) = ``) or ((fst ppatt) = context)) then let (result,link) = print_tree_match (fst (snd ppatt)) pt in if (link = No_link) then if ((snd (snd ppatt)) (add_context context params) result) then result else failwith `print_pattern_match` else failwith (`print_pattern_match -- ` ^ `\`link' used outside a loop`) else failwith `print_pattern_match`;; (add_context,print_pattern_match);; end_section treematch;; let (add_context,print_pattern_match) = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/treetobox.ml0000640000212700021270000005003405071607747021505 0ustar cammcamm% treetobox.ml % %-----------------------------------------------------------------------------% % Abbreviation for datatype of special metavariable assignments. % lettype print_special = string # ((string # int) list -> print_binding -> metavar_binding);; % Abbreviation for datatype of pretty-printer integer expressions. % lettype print_int_exp = (string # int) list -> print_binding -> int;; % Datatypes for formats, objects, and box specifications. % rectype print_box_spec = H_box of (nat # print_object) list | V_box of ((print_indent # nat) # print_object) list | HV_box of ((nat # print_indent # nat) # print_object) list | HoV_box of ((nat # print_indent # nat) # print_object) list and print_format = PF_empty | PF of print_box_spec | PF_branch of print_test # print_format # print_format and print_object = PO_constant of string | PO_leaf of string # (string -> string) | PO_subcall of (string # ((print_tree # address) list -> (print_tree # address) list)) # (string # print_int_exp) list | PO_context_subcall of string # (string # ((print_tree # address) list -> (print_tree # address) list)) # (string # print_int_exp) list | PO_format of print_format | PO_expand of print_box_spec;; % Useful abbreviations for composite type constructors. % let PF_H = PF o H_box and PF_V = PF o V_box and PF_HV = PF o HV_box and PF_HoV = PF o HoV_box;; % Abbreviation for type of pretty-printing rules. % lettype print_rule = print_pattern # print_special list # print_format;; % Abbreviation for type of pretty-printing rules as functions. % lettype print_rule_function = string -> (string # int) list -> print_tree -> (print_binding # print_format);; % Function to create extra bindings from special assignments using % % pretty-printing environment supplied. % let print_special_fun context params pbind (pspecials:print_special list) = % : (string -> (string # int) list -> print_binding -> % % print_special list -> print_binding) % map (\(s,f). s,(f (add_context context params) pbind)) pspecials;; % Function to convert a list of pretty-printing rules into a function. % % The function tries each rule in turn until one matches the tree. Special % % assignments are then computed and used as replacements or additions to % % the binding. The new binding is returned along with the format from the % % rule. % letrec print_rule_fun (prl:print_rule list) context params pt = % : (print_rule list -> string -> (string # int) list -> print_tree -> % % (print_binding # print_format)) % % : (print_rule list -> print_rule_function) % if (null prl) then failwith `print_rule_fun` else let traps = [`print_pattern_match`;`print_tree_match`; `print_merge`;`print_loop_match`] in ( (let pbind = print_pattern_match (fst (hd prl)) context params pt in (change_assocl pbind (print_special_fun context params pbind (fst (snd (hd prl)))), snd (snd (hd prl)))) ?? traps (print_rule_fun (tl prl) context params pt) );; % Infix function for composing two print-rule functions so that first the % % rules of one function are tried, and if none match, rules of the second % % function are tried. % ml_curried_infix `then_try`;; let then_try prf1 prf2 = % : (print_rule_function -> print_rule_function -> print_rule_function) % (\context params pt. ( (prf1 context params pt) ?? [`print_rule_fun`] (prf2 context params pt) )) : print_rule_function;; % Print-rules for pretty-printing the structure of a tree. % % These rules are used by default if no other rules match. % let raw_tree_rules = % : (print_rule list) % [(``,Var_name (`n`,[Var_children `cl`;Patt_child (Var_child `c`)]), (\x y. true)),[], (PF_HV [(Nat 0,Abs 0,Nat 0), PO_leaf (`n`,(\s.s)); (Nat 0,Abs 3,Nat 0), PO_format (PF_H [Nat 0, PO_constant `(`; Nat 0, PO_format (PF_HoV [(Nat 0,Abs 0,Nat 0), PO_expand (H_box [Nat 0, PO_subcall ((`cl`,(\l.l)),[]); Nat 0, PO_constant `,`]); (Nat 0,Abs 0,Nat 0), PO_subcall ((`c`,(\l.l)),[])]); Nat 0, PO_constant `)`])]); (``,Var_name (`n`,[]),(\x y. true)),[], (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]) ] : print_rule list;; let raw_tree_rules_fun = % : (print_rule_function) % print_rule_fun raw_tree_rules;; begin_section treetobox;; % Function to expand a binding into a list of bindings so that a % % metavariable bound to a list in the original binding is bound to one % % element of the list in each of the resulting bindings. % % The number of bindings produced is equal to the length of the longest % % list bound to a metavariable in the original binding. Items other than % % lists become duplicated, one copy going in each list. If a metavariable % % is bound to a list shorter than the longest list, the bindings for which % % there are no values left get the metavariable bound to an empty list. % % When an attempt is made to print such a metavariable, the result is an % % empty box (i.e. no output). % % The sub-function `split_binding' takes a binding and a Boolean value % % initialised to false. The binding is duplicated. For any bound list in % % the original, the first binding gets the head of the list, and the second % % binding gets the tail. If the list is empty, both copies get the empty % % list. If a list is split, the Boolean passed back is true, otherwise the % % value from the recursive call is passed back. The result is that if any % % list is split into head and tail, the final Boolean returned is true. % % The first binding produced by `split_binding' is put into the list of % % bindings to be returned by `expand_binding'. The other is either split % % again or discarded. It is split again if the Boolean returned from the % % call to `split_binding' is true. Note that when there is no more to do, % % `newpb' is discarded as well as `restpb' because in such a case `newpb' % % is an unwanted binding in which all bound lists are empty. % letrec expand_binding pb = % : (print_binding -> print_binding list) % letrec split_binding b pb' = % : (bool -> print_binding -> (print_binding # print_binding # bool)) % if (null pb') then ([],[],b) else let (pbhead,pbtail,flag) = split_binding b (tl pb') and (m,mb) = hd pb' in let (h,t,f) = case mb of (Bound_name _) . ((m,mb),(m,mb),flag) | (Bound_names sl) . (if (null sl) then ((m,mb),(m,mb),flag) else ((m,Bound_name (hd sl)), (m,Bound_names (tl sl)),true)) | (Bound_child _) . ((m,mb),(m,mb),flag) | (Bound_children ptl) . (if (null ptl) then ((m,mb),(m,mb),flag) else ((m,Bound_child (hd ptl)), (m,Bound_children (tl ptl)),true)) in ((h.pbhead),(t.pbtail),f) in let (newpb,restpb,more_to_do) = split_binding false pb in if more_to_do then newpb.(expand_binding restpb) else [];; % Functions to obtain list of metavariables which are in scope within an % % expansion box. % letrec extract_expanded_from_spec pbs = % : (print_box_spec -> string list) % let pol = case pbs of (H_box x) . (map snd x) | (V_box x) . (map snd x) | (HV_box x) . (map snd x) | (HoV_box x) . (map snd x) in itlist union (map extract_expanded_from_object pol) [] and extract_expanded_from_object po = % : (print_object -> string list) % case po of (PO_constant _) . [] | (PO_leaf (metavar,_)) . [metavar] | (PO_subcall ((metavar,_),_)) . [metavar] | (PO_context_subcall (_,(metavar,_),_)) . [metavar] | (PO_format _) . [] | (PO_expand pbs) . (extract_expanded_from_spec pbs);; % Functions for converting a parse-tree into a box of text. % % If the rules supplied fail to match, default rules are used. If the % % debugging option is specified in the parameters, errors are allowed to % % pass up to top-level. Otherwise `*error*' is placed in the text if an % % error occurs. % letrec print_tree_to_box m i prf context params pt = % : (int -> int -> print_rule_function -> string -> (string # int) list -> % % print_tree -> address print_box) % let print_tree_to_box' m i prf context params pt = % : (int -> int -> print_rule_function -> string -> % % (string # int) list -> print_tree -> address print_box) % let (pbind,pf) = ( (prf context params pt) ?? [`print_rule_fun`] (raw_tree_rules_fun context params pt) ) in print_format_fun m i prf context params pbind pf in if (can (assoc `DEBUG`) params) then print_tree_to_box' m i prf context params pt else ( (print_tree_to_box' m i prf context params pt) ? (A_box ((Nat 7,`*error*`),No_address)) ) % The result of a call to `print_object_fun' is a list of functions which % % given available space information produce boxes. One object may yield % % several such functions. The sub-function `f' below pairs each function % % with the box parameters of the object from which it was obtained. This is % % done for all objects in the box, and the list of lists is flattened. If % % the resulting list is empty, an exception is raised to be trapped later. % % Otherwise the box parameters for the first item in the list are discarded % % because the first item in a box of text has a fixed position at the % % beginning of the box. % and print_box_spec_fun m i prf context params pbind pbind' expanded pbs = % : (int -> int -> print_rule_function -> string -> % % (string # int) list -> print_binding -> print_binding -> bool -> % % print_box_spec -> address print_box) % let f pof xpol = % : ((print_object -> (int -> int -> address print_box) list) -> % % (* # print_object) list -> % % (int -> int -> address print_box) # % % (* # (int -> int -> address print_box)) list) % let xpbfnl = flat (map (\(x,po). map (\pbfn. (x,pbfn)) (pof po)) xpol) in if (null xpbfnl) then failwith `print_box_spec_fun` else (snd (hd xpbfnl),tl xpbfnl) and pof = print_object_fun prf context params pbind pbind' expanded % Empty sub-tree addresses (Address []) are inserted as the `labels' of % % each sub-box. The `label' at the root of the generated box will later % % be replaced by a relative address. This technique is a bit wasteful, % % since unnecessary garbage is generated. However, it greatly simplifies % % the box-building programs. % in build_print_box m i (Address []) (case pbs of (H_box xpol) . (UB_H (f pof xpol)) | (V_box xpol) . (UB_V (f pof xpol)) | (HV_box xpol) . (UB_HV (f pof xpol)) | (HoV_box xpol) . (UB_HoV (f pof xpol))) % Expansion does not continue into nested formats. It only continues into % % nested expansion-boxes. So `print_box_spec_fun' is called below with the % % `expanded' argument set to false, and the binding-to-use reset to the % % original binding. If the call fails, an empty box of text is returned. % % For the branching case, the current context is made available in the list % % of parameters to the test which determines the format to use. % and print_format_fun m i prf context params pbind pf = % : (int -> int -> print_rule_function -> string -> (string # int) list -> % % print_binding -> print_format -> address print_box) % case pf of (PF_empty) . N_box | (PF pbs) . ( (print_box_spec_fun m i prf context params pbind pbind false pbs) ?? [`print_box_spec_fun`] N_box ) | (PF_branch (ptest,pf1,pf2)) . (if (ptest (add_context context params) pbind) then (print_format_fun m i prf context params pbind pf1) else (print_format_fun m i prf context params pbind pf2)) % For the object given, `print_object_fun' produces a list of partially % % processed objects. This allows for expansion of objects. `pbind' is the % % original binding. `pbind'' is the subset of that binding currently in % % use. `expanded' is a Boolean indicating whether processing is occurring % % within an expansion box. % % For `subcalls', a list of names/functions are provided as changes to the % % parameter list. Each function is applied to the pretty-printing % % environment to yield an integer. The resulting list of pairs are then % % used as parameter replacements. Note that the binding supplied to the % % functions is the original binding, not the subset currently in use. Note % % also that when the context is being changed, the functions receive the % % current context, not the new one. % % When an expansion-box is encountered, expansion only takes place if it is % % not already. Expansion takes place by obtaining a list of bindings from % % a subset of the original binding. The subset is chosen by finding the % % names of the metavariables which are used within the expansion-box and % % nested expansion-boxes. % and print_object_fun prf context params pbind pbind' expanded po = % : (print_rule_function -> string -> (string # int) list -> % % print_binding -> print_binding -> bool -> print_object -> % % (int -> int -> address print_box) list) % case po % Constants do not have a sub-tree address associated with them. % of (PO_constant s) . [\m i. A_box ((Nat (strlen s),s),No_address)] % The address of a leaf-node (name) comes directly from the binding. % | (PO_leaf (metavar,string_fun)) . (case (lookup_metavar pbind' metavar) of (Bound_name (s,add)) . [\m i. let s' = string_fun s in A_box ((Nat (strlen s'),s'),add)] | (Bound_names sl) . (map (\(s,add) m i. let s' = string_fun s in A_box ((Nat (strlen s'),s'),add)) sl) | (_) . failwith (`print_tree_to_box -- ` ^ `type of metavariable \`` ^ metavar ^ `' in pattern does n't match type in format`)) % The address for a subcall comes from the binding. It is an address % % relative to the root of the tree given to the parent call. The % % address is inserted at the root of the box to be returned. This box % % is obtained from the recursive call and contains addresses relative % % to the root of the tree bound to the metavar. So, only the % % outermost boxes of a format of a print rule have a non-empty % % address. The intermediate boxes have empty addresses. Thus, in the % % resulting box structure, the relative addressing takes place in % % jumps corresponding to calls to the pretty-printer. % | (PO_subcall ((metavar,list_fun),param_changes)) . (let ptaddl = case (lookup_metavar pbind' metavar) of (Bound_child ptadd) . [ptadd] | (Bound_children ptaddl) . ptaddl | (_) . failwith (`print_tree_to_box -- ` ^ `type of metavariable \`` ^ metavar ^ `' in pattern ` ^ `does n't match type in format`) in map (\(pt,address) m i. replace_box_label address (print_tree_to_box m i prf context (change_assocl params (map (\(s,f). s,(f (add_context context params) pbind)) param_changes)) pt)) (list_fun ptaddl)) | (PO_context_subcall (new_context,(metavar,list_fun),param_changes)) . (let ptaddl = case (lookup_metavar pbind' metavar) of (Bound_child ptadd) . [ptadd] | (Bound_children ptaddl) . ptaddl | (_) . failwith (`print_tree_to_box -- ` ^ `type of metavariable \`` ^ metavar ^ `' in pattern ` ^ `does n't match type in format`) in map (\(pt,address) m i. replace_box_label address (print_tree_to_box m i prf new_context (change_assocl params (map (\(s,f). s,(f (add_context context params) pbind)) param_changes)) pt)) (list_fun ptaddl)) | (PO_format pf) . [\m i. print_format_fun m i prf context params pbind pf] | (PO_expand pbs) . (if expanded then [\m i. print_box_spec_fun m i prf context params pbind pbind' true pbs] else map (\pb m i. print_box_spec_fun m i prf context params pbind pb true pbs) (expand_binding (filter (\x. mem (fst x) (extract_expanded_from_spec pbs)) pbind)));; print_tree_to_box;; end_section treetobox;; let print_tree_to_box = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_printer/utils.ml0000640000212700021270000001730405071607751020630 0ustar cammcamm% utils.ml % %-----------------------------------------------------------------------------% % Function to test for the containment of the binding of a metavariable % % in a list of strings. Function is an infix. % % Fails if metavariable not found in binding, or is not bound to a name. % ml_curried_infix `is_a_member_of`;; let is_a_member_of metavar sl = % : (string -> string list -> print_test) % (\params pbind. mem (case (lookup_metavar pbind metavar) of (Bound_name (s,_)) . s | (_) . failwith (`is_a_member_of -- used on metavar \`` ^ metavar ^ `' which is not bound to a name`)) sl) : print_test;; % Function to obtain the value of a parameter from a pretty-printing % % environment. Fails if named parameter does not exist. % let bound_number s = % : (string -> ((string # int) list -> print_binding -> int)) % (\params (pbind:print_binding). ((snd (assoc s params)):int) ? failwith (`bound_number -- \``^s^`' not in parameters`));; % Functions to obtain the values bound to metavariables from a % % pretty-printing environment. % % The functions fail if the specified metavariable does not exist, or if it % % is bound to an object of the wrong type. % % The functions throw away sub-tree address information. % let bound_name meta = % : (string -> ((string # int) list -> print_binding -> string)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_name -- \``^meta^`' not a metavariable`)) of (Bound_name (s,_)) . s | (_) . failwith (`bound_name -- metavar \``^meta^`' not bound to a name`));; let bound_names meta = % : (string -> ((string # int) list -> print_binding -> string list)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_names -- \``^meta^`' not a metavariable`)) of (Bound_names sl) . (map fst sl) | (_) . failwith (`bound_names -- metavar \``^meta^`' not bound to names`));; let bound_child meta = % : (string -> ((string # int) list -> print_binding -> print_tree)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_child -- \``^meta^`' not a metavariable`)) of (Bound_child (pt,_)) . pt | (_) . failwith (`bound_child -- metavar \`` ^ meta ^ `' not bound to a child`));; let bound_children meta = % : (string -> ((string # int) list -> print_binding -> print_tree list)) % (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`bound_children -- \``^meta^`' not a metavariable`)) of (Bound_children ptl) . (map fst ptl) | (_) . failwith (`bound_children -- metavar \`` ^ meta ^ `' not bound to children`));; % Function to obtain the `context' from a pretty-printing environment. % % The is held as a parameter called `CONTEXT_', bound to % % any integer. If such a parameter does not exist, the function fails. % let bound_context = % : ((string # int) list -> print_binding -> string) % (\(params:(string # int) list) (pbind:print_binding). ( ((\s. substr 8 ((strlen s) - 8) s) (fst (find (\p. (substr 0 8 (fst p)) = `CONTEXT_`) params))) ? failwith `bound_context` ));; % Functions for constructing new functions which access the pretty-printing % % environment. % let apply0 f = % : (* -> ((string # int) list -> print_binding -> *)) % (\(params:(string # int) list) (pbind:print_binding). f);; let apply1 f val = % : ((* -> **) -> ((string # int) list -> print_binding -> *) -> % % ((string # int) list -> print_binding -> **)) % (\(params:(string # int) list) (pbind:print_binding). f (val params pbind));; let apply2 f val1 val2 = % : ((* -> ** -> **) -> % % ((string # int) list -> print_binding -> *) -> % % ((string # int) list -> print_binding -> **) -> % % ((string # int) list -> print_binding -> ***)) % (\(params:(string # int) list) (pbind:print_binding). f (val1 params pbind) (val2 params pbind));; % Functions for making new values suitable for binding to metavariables, % % from existing bound metavariables and transformation functions. % % The functions fail if the specified metavariable does not exist or is % % bound to an object of the wrong type. % % new_name retains sub-tree address information. % let new_name f meta = % : ((string -> string) -> string -> % % ((string # int) list -> print_binding -> metavar_binding)) % let bound_name_add meta = (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`new_name -- \``^meta^`' not a metavariable`)) of (Bound_name x) . x | (_) . failwith (`new_name -- metavar \``^meta^`' not bound to a name`)) in apply1 (Bound_name o (f # I)) (bound_name_add meta);; % In new_names, sub-tree address information has to be kept with the names % % because the manipulation function might re-order the names. % let new_names f meta = % : (((string # address) list -> (string # address) list) -> string -> % % ((string # int) list -> print_binding -> metavar_binding)) % let bound_names_add meta = (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`new_names -- \``^meta^`' not a metavariable`)) of (Bound_names xl) . xl | (_) . failwith (`new_names -- metavar \``^meta^`' not bound to names`)) in apply1 (Bound_names o f) (bound_names_add meta);; % new_child retains sub-tree address information. % let new_child f meta = % : ((print_tree -> print_tree) -> string -> % % ((string # int) list -> print_binding -> metavar_binding)) % let bound_child_add meta = (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`new_child -- \``^meta^`' not a metavariable`)) of (Bound_child x) . x | (_) . failwith (`new_child -- metavar \`` ^ meta ^ `' not bound to a child`)) in apply1 (Bound_child o (f # I)) (bound_child_add meta);; % In new_children, sub-tree address information has to be kept with the % % trees because the manipulation function might re-order the trees. % let new_children f meta = % : (((print_tree # address) list -> (print_tree # address) list) -> % % string -> ((string # int) list -> print_binding -> metavar_binding)) % let bound_children_add meta = (\(params:(string # int) list) pbind. case ((lookup_metavar pbind meta) ? failwith (`new_children -- \``^meta^`' not a metavariable`)) of (Bound_children xl) . xl | (_) . failwith (`new_children -- metavar \`` ^ meta ^ `' not bound to children`)) in apply1 (Bound_children o f) (bound_children_add meta);; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/0000750000212700021270000000000005533117216016734 5ustar cammcammhol88-2.02.19940316/Library/prettyp/PP_parser/PP_parser.ml0000640000212700021270000000757505071610115021171 0ustar cammcamm%=============================================================================% % % % A General-Purpose % % Pretty-Printer % % for the HOL System % % % %-----------------------------------------------------------------------------% % % % Filename: PP_parser.ml (Compiler for pretty-printing language) % % Version: 1.1 % % Author: Richard J. Boulton % % Date: 5th August 1991 % % % % Special instructions: Requires PP_printer.ml to be pre-loaded. % % % %-----------------------------------------------------------------------------% % % % Load sub-files in the following order: % % % % pp_lang1_pp.ml % % pp_lang2_pp.ml % % lex.ml % % syntax.ml % % convert.ml % % generate.ml % % PP_to_ML.ml % % % %-----------------------------------------------------------------------------% % % % Changes history: % % % % Version 0.0 (pre-release), 23rd March 1990 % % % % No changes. % % % % Version 1.0, 11th December 1990 % % % % No changes. % % % % Version 1.1, 5th August 1991 % % % %=============================================================================% %-----------------------------------------------------------------------------% % Load the compiled code into ml. % %-----------------------------------------------------------------------------% let path st = library_pathname() ^ `/prettyp/PP_parser/` ^ st and flag = get_flag_value `print_lib` in map (\st. load(path st, flag)) [`pp_lang1_pp`; `pp_lang2_pp`; `lex`; `syntax`; `convert`; `generate`; `PP_to_ML`];; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/PP_to_ML.ml0000640000212700021270000000347305071610115020700 0ustar cammcamm% PP_to_ML.ml % %-----------------------------------------------------------------------------% % Main pretty-printer compiling function. % % If first argument is true, the output is appended to the output file. % % Input filename must end in `.pp', but the `.pp' may be omitted from the % % argument to this function. If output argument is a null string, the input % % filename is used with the `.pp' replaced by `_pp.ml'. % let PP_to_ML app input output = % : (bool -> string -> string -> void) % let input' = if (((substr ((strlen input) - 3) 3 input) = `.pp`) ? false) then (substr 0 ((strlen input) - 3) input) else input in let infile = openi (input' ^ `.pp`) and output' = if (output = ``) then (input' ^ `_pp.ml`) else output in let outfile = if app then append_openw output' else openw output' in do (write (outfile,(`% ` ^ output' ^ (string_copies ` ` (76-(strlen output'))) ^ `%`)); write (outfile,`\L`); write (outfile,(`%` ^ (string_copies `-` 77) ^ `%`)); write (outfile,`\L`); write (outfile,`\L`); generate_ML write outfile (fst (convert_PP (read_PP read infile,[]))); write (outfile,`\L`); write (outfile,(`%` ^ (string_copies `-` 77) ^ `%`)); write (outfile,`\L`); close outfile; close infile );; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/convert.ml0000640000212700021270000016015405071610117020751 0ustar cammcamm% convert.ml % %-----------------------------------------------------------------------------% begin_section convert;; % Error handler. % % This uses the pretty-printer to print the parse-tree on which the % % conversion failed. % let construction_error pt s = % : (print_tree -> string -> ?) % tty_write (`Error: `^s^` ...`^`\L`); pretty_print (get_margin ()) 0 (pp_lang1_rules_fun then_try pp_lang2_rules_fun) `` [] pt; tty_write (`... parse failed.`^`\L`); failwith `construction_error`;; % Function to convert a string into the string which if enclosed within ML % % string quotes and read into ML, would yield the original string as value. % % A backslash is inserted before occurrences of backquote and also before % % occurrences of backslash itself. % let indirect_string s = % : (string -> string) % letrec indirect_string' sl = % : (string list -> string list) % if (null sl) then [] else if ((hd sl) = `\``) then `\\`.`\``.(indirect_string' (tl sl)) else if ((hd sl) = `\\`) then `\\`.`\\`.(indirect_string' (tl sl)) else (hd sl).(indirect_string' (tl sl)) in (implode o indirect_string' o explode) s;; % The following functions are all of the same type. They output a value of % % the same type as their argument. This consists of a pair. The first % % element of the pair is a parse-tree. On input it is a parse-tree for the % % pretty-printing language. On output it is a parse-tree for the % % corresponding ML data structure. % % The second element of the pair is an association list of names to % % parse-trees. In most cases the information in the parse-tree for the % % pretty-printing language is precisely the information required for the ML % % parse-tree, no more, no less. However, this is not always the case, and % % the association list allows sub-trees to be moved up or down the tree, so % % that information can be moved around. % % The conversion functions which do not make sub-calls return an empty % % association list (unless they generate something themselves). If they % % were to bounce the association list they are given, back up the tree, the % % association list could grow enormously due to repetitions. This is % % because other functions append together the association lists they get % % from their sub-calls, and pass the appended list back up to their caller. % let convert_NUM (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`NUM`,ptl)) . (Print_node (`INTCONST`,ptl), []) | (_) . failwith `convert_NUM`;; let convert_NEG (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`NEG`,[pt1])) . (let (pt1',sptl1) = convert_NUM (pt1,sptl) in (Print_node (`UNOP`,[Print_node (`-`,[]); pt1']), sptl1)) | (_) . failwith `convert_NEG`;; % `convert_ML_FUN' processes the list of strings representing a block of ML % % code that is to be copied from the source file to the destination file. % % The text is to appear neatly in the generated ML code. When there is only % % one line in the text block, the conversion is easy. Space is trimmed from % % the beginning and the end of the string. % % If the block extends over more than one line, the first line must be % % blank, so that the vertical alignment of the text in the source file can % % be deduced. If this condition is satisfied, the first line is discarded, % % and trailing blanks are removed from all of the other lines. Any blank % % lines will now be empty strings. The smallest number of leading blanks in % % those strings which are not empty is computed, and this amount of space % % is removed from the beginning of all the strings which are not blank. % % This process retains the vertical alignment of the text, but removes dead % % space to the left of the block. % let convert_ML_FUN (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % let destruct ptl = % : (print_tree list -> string list) % map (\pt. case pt of (Print_node (s,[])) . s | (_) . failwith `convert_ML_FUN`) ptl and construct sl = % : (string list -> print_tree list) % map (\s. Print_node (s,[])) sl and convert sl = % : (string list -> string list) % if ((length sl) = 1) then [trim_enclosing_chars [` `] (hd sl)] else if ((trim_enclosing_chars [` `] (hd sl)) = ``) then let sl' = map (trim_trailing_chars [` `]) (tl sl) in let dead_space = min (map (num_of_leading_chars [` `]) (filter (\s. not (s = ``)) sl')) in map (\s. if (s = ``) then s else substr dead_space ((strlen s) - dead_space) s) sl' else construction_error pt (`the \`{' of a multi-line ML code block must not be ` ^ `followed by anything on the same line`) in case pt of (Print_node (`ML_FUN`,ptl)) . (if (null ptl) then failwith `convert_ML_FUN` else (Print_node (`ML_FUN`,(construct o convert o destruct) ptl), [])) | (_) . failwith `convert_ML_FUN`;; let convert_ID_to_VAR (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`ID`,ptl)) . (Print_node (`VAR`,ptl), []) | (_) . failwith `convert_ID_to_VAR`;; % The string constant in the next function has to be modified for inclusion % % in ML code. Back-quotes (ML string quotes) have to be preceded by a % % backslash, and any occurrences of backslash itself have to be doubled-up. % let convert_ID_to_TOKCONST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`ID`,[Print_node (s,[])])) . (Print_node (`TOKCONST`,[Print_node (indirect_string s,[])]), []) | (_) . failwith `convert_ID_to_TOKCONST`;; let convert_METAVAR (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`NAME_META`,[pt1])) . (convert_ID_to_TOKCONST (pt1,sptl)) | (Print_node (`CHILD_META`,[pt1])) . (convert_ID_to_TOKCONST (pt1,sptl)) | (Print_node (`CHILDREN_META`,[pt1])) . (convert_ID_to_TOKCONST (pt1,sptl)) | (Print_node (`NAME_META`,[])) . (Print_node (``,[]), []) | (Print_node (`CHILD_META`,[])) . (Print_node (``,[]), []) | (Print_node (`CHILDREN_META`,[])) . (Print_node (``,[]), []) | (_) . failwith `convert_METAVAR`;; let convert_METAVAR_to_TOKCONST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`NAME_META`,[pt1])) . (convert_ID_to_TOKCONST (pt1,sptl)) | (Print_node (`CHILD_META`,[pt1])) . (convert_ID_to_TOKCONST (pt1,sptl)) | (Print_node (`CHILDREN_META`,[pt1])) . (convert_ID_to_TOKCONST (pt1,sptl)) | (Print_node (`NAME_META`,[])) . (construction_error pt `illegal use of an un-named metavariable`) | (Print_node (`CHILD_META`,[])) . (construction_error pt `illegal use of an un-named metavariable`) | (Print_node (`CHILDREN_META`,[])) . (construction_error pt `illegal use of an un-named metavariable`) | (_) . failwith `convert_METAVAR_to_TOKCONST`;; letrec convert_METAVAR_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`METAVAR_LIST`,[pt1])) . (let (pt1',sptl1) = convert_METAVAR_to_TOKCONST (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`METAVAR_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_METAVAR_to_TOKCONST (pt1,sptl) and (pt2',sptl2) = convert_METAVAR_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_METAVAR_LIST`) | (_) . failwith `convert_METAVAR_LIST`;; let convert_MIN (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`MIN`,[pt1])) . (let (pt1',sptl1) = convert_NUM (pt1,sptl) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Val`,[])]); Print_node (`APPN`, [Print_node (`VAR`,[Print_node (`Nat`,[])]); pt1']) ]), sptl1)) | (_) . failwith `convert_MIN`;; let convert_MAX (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`MAX`,[pt1])) . (let (pt1',sptl1) = convert_NUM (pt1,sptl) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Val`,[])]); Print_node (`APPN`, [Print_node (`VAR`,[Print_node (`Nat`,[])]); pt1']) ]), sptl1)) | (_) . failwith `convert_MAX`;; let convert_LOOP_RANGE (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % let default = Print_node (`CON0`,[Print_node (`Default`,[])]) in let (pta,ptb,sptl') = case pt of (Print_node (`LOOP_RANGE`,[pt1])) . (case pt1 of (Print_node (`MIN`,_)) . (let (pt1',sptl1) = convert_MIN (pt1,sptl) in (pt1',default,sptl1)) | (Print_node (`MAX`,_)) . (let (pt1',sptl1) = convert_MAX (pt1,sptl) in (default,pt1',sptl1)) | (_) . failwith `convert_LOOP_RANGE`) | (Print_node (`LOOP_RANGE`,[pt1;pt2])) . (let (pt1',sptl1) = convert_MIN (pt1,sptl) and (pt2',sptl2) = convert_MAX (pt2,sptl) in (pt1',pt2',(sptl1 @ sptl2))) | (_) . failwith `convert_LOOP_RANGE` in (Print_node (`DUPL`,[pta;ptb]), sptl');; let convert_LOOP_LINK (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % let default_list = Print_node (`LIST`,[]) and default_range = Print_node (`DUPL`,[Print_node (`CON0`,[Print_node (`Default`,[])]); Print_node (`CON0`,[Print_node (`Default`,[])])]) in let (pta,ptb,sptl') = case pt of (Print_node (`LOOP_LINK`,[])) . (default_range,default_list,[]) | (Print_node (`LOOP_LINK`,[pt1])) . (case pt1 of (Print_node (`LOOP_RANGE`,_)) . (let (pt1',sptl1) = convert_LOOP_RANGE (pt1,sptl) in (pt1',default_list,sptl1)) | (Print_node (`METAVAR_LIST`,_)) . (let (pt1',sptl1) = convert_METAVAR_LIST (pt1,sptl) in (default_range,pt1',sptl1)) | (_) . failwith `convert_LOOP_LINK`) | (Print_node (`LOOP_LINK`,[pt1;pt2])) . (let (pt1',sptl1) = convert_LOOP_RANGE (pt1,sptl) and (pt2',sptl2) = convert_METAVAR_LIST (pt2,sptl) in (pt1',pt2',(sptl1 @ sptl2))) | (_) . failwith `convert_LOOP_LINK` in (Print_node (`DUPL`,[pta;ptb]), sptl');; let convert_LABEL (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`LABEL`,[pt1])) . (convert_METAVAR_to_TOKCONST (pt1,sptl)) | (_) . failwith `convert_LABEL`;; % `convert_NODE_NAME' receives the message `CHILD_LIST' from % % `convert_PATT_TREE' and removes it from the list to be passed on. The % % message contains the list of sub-trees of the node being named. % let convert_NODE_NAME (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % let child_list = snd (assoc `CHILD_LIST` sptl) and sptl' = filter (\x. not ((fst x) = `CHILD_LIST`)) sptl in case pt of (Print_node (`NODE_NAME`,[Print_node (`ID`,[pt1])])) . (let (pt1',sptl1) = convert_ID_to_TOKCONST (Print_node (`ID`,[pt1]),sptl') in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Const_name`,[])]); Print_node (`DUPL`,[pt1';child_list]) ]), sptl1)) | (Print_node (`NODE_NAME`,[pt1])) . (let (pt1',sptl1) = convert_METAVAR (pt1,sptl') in if (pt1' = (Print_node (``,[]))) then (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Wild_name`,[])]); child_list ]), sptl1) else (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Var_name`,[])]); Print_node (`DUPL`,[pt1';child_list]) ]), sptl1)) | (_) . failwith `convert_NODE_NAME`;; letrec convert_CHILD (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`CHILD`,[Print_node (`PATT_TREE`,ptl)])) . (let (pt1',sptl1) = convert_PATT_TREE (Print_node (`PATT_TREE`,ptl),sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`Patt_child`,[])]); pt1' ]), sptl1)) | (Print_node (`CHILD`,[pt1])) . (let (pt1',sptl1) = convert_METAVAR (pt1,sptl) in if (pt1' = (Print_node (``,[]))) then (Print_node (`CON0`,[Print_node (`Wild_children`,[])]), sptl1) else (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Var_children`,[])]); pt1' ]), sptl1)) | (_) . failwith `convert_CHILD` and convert_CHILD_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`CHILD_LIST`,[pt1])) . (let (pt1',sptl1) = convert_CHILD (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`CHILD_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_CHILD (pt1,sptl) and (pt2',sptl2) = convert_CHILD_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_CHILD_LIST`) | (_) . failwith `convert_CHILD_LIST` % `convert_PATT_TREE' sends a `CHILD_LIST' message to `convert_NODE_NAME' % % containing the sub-trees (children) of the node. It only does this for % % `NODE_NAME' parse-trees. % and convert_PATT_TREE (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`PATT_TREE`,[pt1])) . (case pt1 of (Print_node (`NODE_NAME`,_)) . (let child_list = (`CHILD_LIST`,Print_node (`LIST`,[])) in convert_NODE_NAME (pt1,(child_list.sptl))) | (Print_node (`CHILD_META`,_)) . (let (pt1',sptl1) = convert_METAVAR (pt1,sptl) in if (pt1' = (Print_node (``,[]))) then (Print_node (`CON0`,[Print_node (`Wild_child`,[])]), sptl1) else (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Var_child`,[])]); pt1' ]), sptl1)) | (Print_node (`LOOP_LINK`,_)) . (let (pt1',sptl1) = convert_LOOP_LINK (pt1,sptl) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Link_child`,[])]); pt1' ]), sptl1)) | (Print_node (`LOOP`,_)) . (let (pt1',sptl1) = convert_LOOP (pt1,sptl) and pt2' = Print_node (`CON0`,[Print_node (`Wild_child`,[])]) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Print_loop`,[])]); Print_node (`DUPL`,[pt1';pt2']) ]), sptl1)) | (_) . failwith `convert_PATT_TREE`) | (Print_node (`PATT_TREE`,[pt1;pt2])) . (case pt1 of (Print_node (`NODE_NAME`,_)) . (let (pt2',sptl2) = convert_CHILD_LIST (pt2,sptl) in let (pt1',sptl1) = convert_NODE_NAME (pt1,((`CHILD_LIST`,pt2').sptl)) in (pt1',(sptl1 @ sptl2))) | (Print_node (`LABEL`,_)) . (let (pt1',sptl1) = convert_LABEL (pt1,sptl) and (pt2',sptl2) = convert_PATT_TREE (pt2,sptl) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Print_label`,[])]); Print_node (`DUPL`,[pt1';pt2']) ]), sptl1 @ sptl2)) | (Print_node (`LOOP_LINK`,_)) . (let (pt1',sptl1) = convert_LOOP_LINK (pt1,sptl) and (pt2',sptl2) = convert_PATT_TREE (pt2,sptl) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Print_link`,[])]); Print_node (`DUPL`,[pt1';pt2']) ]), sptl1 @ sptl2)) | (Print_node (`LOOP`,_)) . (let (pt1',sptl1) = convert_LOOP (pt1,sptl) and (pt2',sptl2) = convert_PATT_TREE (pt2,sptl) in (Print_node (`APPN`, [Print_node (`CON`,[Print_node (`Print_loop`,[])]); Print_node (`DUPL`,[pt1';pt2']) ]), sptl1 @ sptl2)) | (_) . failwith `convert_PATT_TREE`) | (_) . failwith `convert_PATT_TREE` and convert_LOOP (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`LOOP`,[pt1])) . (convert_PATT_TREE (pt1,sptl)) | (_) . failwith `convert_LOOP`;; % The string constant in the next function has to be modified for inclusion % % in ML code. Back-quotes (ML string quotes) have to be preceded by a % % backslash, and any occurrences of backslash itself have to be doubled-up. % let convert_STRING (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`STRING`,[Print_node (s,[])])) . (Print_node (`TOKCONST`,[Print_node (indirect_string s,[])]), []) | (_) . failwith `convert_STRING`;; % `convert_TEST' may require access to an abbreviation. If it does, it % % checks the message list for the appropriate abbreviation. % let convert_TEST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`TEST`,[pt1])) . (case pt1 of (Print_node (`ID`,[Print_node (s,[])])) . (let pt1' = ( (snd (assoc (`ABBREV_` ^ s) sptl)) ? construction_error pt (`undefined abbreviation \`` ^ s ^ `'`) ) in (pt1',[])) | (_) . (convert_ML_FUN (pt1,sptl))) | (_) . failwith `convert_TEST`;; let convert_PATTERN (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`PATTERN`,[pt1;pt2])) . (let (pt1',sptl1) = convert_STRING (pt1,sptl) and (pt2',sptl2) = convert_PATT_TREE (pt2,sptl) in (Print_node (`DUPL`,[pt1'; Print_node (`DUPL`,[pt2'; Print_node (`ML_FUN`,[Print_node (`\\x y. true`,[])]) ]) ]), sptl1 @ sptl2)) | (Print_node (`PATTERN`,[pt1;pt2;pt3])) . (let (pt1',sptl1) = convert_STRING (pt1,sptl) and (pt2',sptl2) = convert_PATT_TREE (pt2,sptl) and (pt3',sptl3) = convert_TEST (pt3,sptl) in (Print_node (`DUPL`,[pt1'; Print_node (`DUPL`,[pt2';pt3'])]), sptl1 @ sptl2 @ sptl3)) | (_) . failwith `convert_PATTERN`;; % `convert_TRANSFORM' may require access to an abbreviation. If it does, it % % checks the message list for the appropriate abbreviation. % let convert_TRANSFORM (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`TRANSFORM`,[pt1])) . (case pt1 of (Print_node (`ID`,[Print_node (s,[])])) . (let pt1' = ( (snd (assoc (`ABBREV_` ^ s) sptl)) ? construction_error pt (`undefined abbreviation \`` ^ s ^ `'`) ) in (pt1',[])) | (_) . (convert_ML_FUN (pt1,sptl))) | (_) . failwith `convert_TRANSFORM`;; let convert_P_SPECIAL (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`P_SPECIAL`,[pt1;pt2])) . (let (pt1',sptl1) = convert_METAVAR_to_TOKCONST (pt1,sptl) and (pt2',sptl2) = convert_TRANSFORM (pt2,sptl) in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_P_SPECIAL`;; letrec convert_P_SPECIAL_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`P_SPECIAL_LIST`,[pt1])) . (let (pt1',sptl1) = convert_P_SPECIAL (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`P_SPECIAL_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_P_SPECIAL (pt1,sptl) and (pt2',sptl2) = convert_P_SPECIAL_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_P_SPECIAL_LIST`) | (_) . failwith `convert_P_SPECIAL_LIST`;; % `convert_INT_EXP' may require access to an abbreviation. If it does, it % % checks the message list for the appropriate abbreviation. % let convert_INT_EXP (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`INT_EXP`,[pt1])) . (case pt1 of (Print_node (`NUM`,_)) . (let (pt1',sptl1) = convert_NUM (pt1,sptl) in (Print_node (`APPN`,[Print_node (`ML_FUN`,[Print_node(`\\n. \\x y. n`,[])]); pt1' ]), sptl1)) | (Print_node (`NEG`,_)) . (let (pt1',sptl1) = convert_NEG (pt1,sptl) in (Print_node (`APPN`,[Print_node (`ML_FUN`,[Print_node(`\\n. \\x y. n`,[])]); pt1' ]), sptl1)) | (Print_node (`ID`,[Print_node (s,[])])) . (let pt1' = ( (snd (assoc (`ABBREV_` ^ s) sptl)) ? construction_error pt (`undefined abbreviation \`` ^ s ^ `'`) ) in (pt1',[])) | (_) . (convert_ML_FUN (pt1,sptl))) | (_) . failwith `convert_INT_EXP`;; let convert_ASSIGN (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`ASSIGN`,[pt1;pt2])) . (let (pt1',sptl1) = convert_ID_to_TOKCONST (pt1,sptl) and (pt2',sptl2) = convert_INT_EXP (pt2,sptl) in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_ASSIGN`;; letrec convert_ASSIGNMENTS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`ASSIGNMENTS`,[pt1])) . (let (pt1',sptl1) = convert_ASSIGN (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`ASSIGNMENTS`,[pt1;pt2])) . (let (pt1',sptl1) = convert_ASSIGN (pt1,sptl) and (pt2',sptl2) = convert_ASSIGNMENTS (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_ASSIGNMENTS`) | (_) . failwith `convert_ASSIGNMENTS`;; % `convert_F_SUBCALL' sends a `LEAF' message to `convert_C_SUBCALL', % % `convert_LEAF_OR_SUBCALL', and `convert_OBJECT', to tell them that the % % construct they are dealing with is a leaf rather than a subcall. The % % message is just a flag, so it contains a null tree. % let convert_F_SUBCALL (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`F_SUBCALL`,[pt1;pt2])) . (let (pt1',sptl1) = convert_TRANSFORM (pt1,sptl) and (pt2',sptl2) = convert_METAVAR_to_TOKCONST (pt2,sptl) and sptl' = case pt2 of (Print_node (`NAME_META`,_)) . [`LEAF`,Print_node (``,[])] | (_) . [] in (Print_node (`DUPL`,[pt2';pt1']), sptl' @ sptl1 @ sptl2)) | (Print_node (`F_SUBCALL`,[pt1])) . (let (pt1',sptl1) = convert_METAVAR_to_TOKCONST (pt1,sptl) and sptl' = case pt1 of (Print_node (`NAME_META`,_)) . [`LEAF`,Print_node (``,[])] | (_) . [] in (Print_node (`DUPL`,[pt1'; Print_node (`ML_FUN`,[Print_node (`I`,[])]) ]), sptl' @ sptl1)) | (_) . failwith `convert_F_SUBCALL`;; % If a context is present, `convert_C_SUBCALL' checks for a `LEAF' message. % % If `LEAF' is present, the inclusion of a context is invalid. If not, the % % context is sent as a `CONTEXT' message to `convert_OBJECT'. % let convert_C_SUBCALL (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`C_SUBCALL`,[Print_node (`STRING`,[pt']); pt1])) . (let (pt1',sptl1) = convert_F_SUBCALL (pt1,sptl) and (pt'',sptl'') = convert_STRING (Print_node (`STRING`,[pt']),sptl) in if (can (assoc `LEAF`) sptl1) then construction_error pt `invalid use of context change` else (pt1',(`CONTEXT`,pt'').(sptl'' @ sptl1))) | (Print_node (`C_SUBCALL`,[pt1])) . (convert_F_SUBCALL (pt1,sptl)) | (_) . failwith `convert_C_SUBCALL`;; % If assignments are not present, `convert_LEAF_OR_SUBCALL' uses the % % presence or absence of a `LEAF' message to determine the kind of tree to % % build. If there are assignments, and there is a `LEAF' message, the % % assignments are invalid. % let convert_LEAF_OR_SUBCALL (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`LEAF_OR_SUBCALL`,[pt1])) . (let (pt1',sptl1) = convert_C_SUBCALL (pt1,sptl) in if (can (assoc `LEAF`) sptl1) then (pt1',sptl1) else (Print_node (`DUPL`,[pt1'; Print_node (`LIST`,[])]), sptl1)) | (Print_node (`LEAF_OR_SUBCALL`,[pt1;pt2])) . (let (pt1',sptl1) = convert_C_SUBCALL (pt1,sptl) and (pt2',sptl2) = convert_ASSIGNMENTS (pt2,sptl) in if (can (assoc `LEAF`) sptl1) then construction_error pt `invalid use of assignments` else (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_LEAF_OR_SUBCALL`;; % The string constant in the next function has to be modified for inclusion % % in ML code. Back-quotes (ML string quotes) have to be preceded by a % % backslash, and any occurrences of backslash itself have to be doubled-up. % let convert_TERMINAL (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`TERMINAL`,[Print_node (s,[])])) . (Print_node (`TOKCONST`,[Print_node (indirect_string s,[])]), []) | (_) . failwith `convert_TERMINAL`;; let convert_INC (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`INC`,[pt1])) . (let (pt1',sptl1) = case pt1 of (Print_node (`NEG`,_)) . (convert_NEG (pt1,sptl)) | (_) . (convert_NUM (pt1,sptl)) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`Inc`,[])]); pt1' ]), sptl1)) | (_) . failwith `convert_INC`;; let convert_H_PARAMS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`H_PARAMS`,[pt1])) . (let (pt1',sptl1) = convert_NUM (pt1,sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`Nat`,[])]); pt1' ]), sptl1)) | (_) . failwith `convert_H_PARAMS`;; let convert_V_PARAMS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`V_PARAMS`,[pt1;pt2])) . (let (pt1',sptl1) = case pt1 of (Print_node (`INC`,_)) . (convert_INC (pt1,sptl)) | (_) . (let (pt1'',sptl1') = case pt1 of (Print_node (`NEG`,_)) . (convert_NEG (pt1,sptl)) | (_) . (convert_NUM (pt1,sptl)) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`Abs`,[])]); pt1'' ]), sptl1')) and (pt2',sptl2) = convert_H_PARAMS (Print_node (`H_PARAMS`,[pt2]),sptl) in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_V_PARAMS`;; let convert_HV_PARAMS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`HV_PARAMS`,[pt1;pt2;pt3])) . (let (pt1',sptl1) = convert_H_PARAMS (Print_node (`H_PARAMS`,[pt1]),sptl) and (pt2',sptl2) = convert_V_PARAMS (Print_node (`V_PARAMS`,[pt2;pt3]), sptl) in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_HV_PARAMS`;; let convert_HOV_PARAMS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`HOV_PARAMS`,[pt1;pt2;pt3])) . (convert_HV_PARAMS (Print_node (`HV_PARAMS`,[pt1;pt2;pt3]), sptl)) | (_) . failwith `convert_HOV_PARAMS`;; let convert_BOX (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`H_BOX`,[pt1])) . (convert_H_PARAMS (pt1,sptl)) | (Print_node (`V_BOX`,[pt1])) . (convert_V_PARAMS (pt1,sptl)) | (Print_node (`HV_BOX`,[pt1])) . (convert_HV_PARAMS (pt1,sptl)) | (Print_node (`HOV_BOX`,[pt1])) . (convert_HOV_PARAMS (pt1,sptl)) | (_) . failwith `convert_BOX`;; % If the object given to `convert_OBJECT' is a leaf or a subcall, the % % function tests for a `LEAF' message. If one is present, it is removed % % before passing the message list on. If there is no `LEAF' message, the % % function builds different trees depending on the presence or absence of a % % `CONTEXT' message. Any `CONTEXT' message is removed before passing the % % message list on. Note that there cannot be both `LEAF' and `CONTEXT' % % messages because context changes are not allowed for leaf objects. % letrec convert_OBJECT (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`OBJECT`,[pt1])) . (case pt1 of (Print_node (`TERMINAL`,_)) . (let (pt1',sptl1) = convert_TERMINAL (pt1,sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`PO_constant`,[])]); pt1' ]), sptl1)) | (Print_node (`LEAF_OR_SUBCALL`,_)) . (let (pt1',sptl1) = convert_LEAF_OR_SUBCALL (pt1,sptl) in if (can (assoc `LEAF`) sptl1) then let sptl1' = filter (\x. not (fst x = `LEAF`)) sptl1 in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`PO_leaf`,[])]); pt1' ]), sptl1') else let (context,non_context) = (`PO_context_subcall`,`PO_subcall`) and sptl1' = filter (\x. not (fst x = `CONTEXT`)) sptl1 in (Print_node (`APPN`, ( [Print_node (`CON`,[Print_node (context,[])]); Print_node (`DUPL`, [snd (assoc `CONTEXT` sptl1); pt1']) ] ?? [`assoc`] [Print_node (`CON`,[Print_node (non_context,[])]); pt1' ] )), sptl1')) | (Print_node (`FORMAT`,_)) . (let (pt1',sptl1) = convert_FORMAT (pt1,sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`PO_format`,[])]); pt1' ]), sptl1)) | (Print_node (`EXPAND`,_)) . (let (pt1',sptl1) = convert_EXPAND (pt1,sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`PO_expand`,[])]); pt1' ]), sptl1)) | (_) . failwith `convert_OBJECT`) % `convert_H_OBJECT' receives the default box parameters from % % `convert_BOX_SPEC' as a `BOX_PARAMS' message. The message is removed from % % the list before passing it on. % % `convert_V_OBJECT', `convert_HV_OBJECT', and `convert_HOV_OBJECT' behave % % similarly. % and convert_H_OBJECT (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`H_OBJECT`,[pt2])) . (let pt1' = ( (snd (assoc `BOX_PARAMS` sptl)) ? failwith `convert_H_OBJECT` ) and sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl2)) | (Print_node (`H_OBJECT`,[pt1;pt2])) . (let sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt1',sptl1) = convert_H_PARAMS (pt1,sptl') and (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_H_OBJECT` and convert_V_OBJECT (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`V_OBJECT`,[pt2])) . (let pt1' = ( (snd (assoc `BOX_PARAMS` sptl)) ? failwith `convert_V_OBJECT` ) and sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl2)) | (Print_node (`V_OBJECT`,[pt1;pt2])) . (let sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt1',sptl1) = convert_V_PARAMS (pt1,sptl') and (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_V_OBJECT` and convert_HV_OBJECT (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`HV_OBJECT`,[pt2])) . (let pt1' = ( (snd (assoc `BOX_PARAMS` sptl)) ? failwith `convert_HV_OBJECT` ) and sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl2)) | (Print_node (`HV_OBJECT`,[pt1;pt2])) . (let sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt1',sptl1) = convert_HV_PARAMS (pt1,sptl') and (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_HV_OBJECT` and convert_HOV_OBJECT (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`HOV_OBJECT`,[pt2])) . (let pt1' = ( (snd (assoc `BOX_PARAMS` sptl)) ? failwith `convert_HOV_OBJECT` ) and sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl2)) | (Print_node (`HOV_OBJECT`,[pt1;pt2])) . (let sptl' = filter (\x. not ((fst x) = `BOX_PARAMS`)) sptl in let (pt1',sptl1) = convert_HOV_PARAMS (pt1,sptl') and (pt2',sptl2) = convert_OBJECT (pt2,sptl') in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_HOV_OBJECT` and convert_H_OBJECT_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`H_OBJECT_LIST`,[pt1])) . (let (pt1',sptl1) = convert_H_OBJECT (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`H_OBJECT_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_H_OBJECT (pt1,sptl) and (pt2',sptl2) = convert_H_OBJECT_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_H_OBJECT_LIST`) | (_) . failwith `convert_H_OBJECT_LIST` and convert_V_OBJECT_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`V_OBJECT_LIST`,[pt1])) . (let (pt1',sptl1) = convert_V_OBJECT (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`V_OBJECT_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_V_OBJECT (pt1,sptl) and (pt2',sptl2) = convert_V_OBJECT_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_V_OBJECT_LIST`) | (_) . failwith `convert_V_OBJECT_LIST` and convert_HV_OBJECT_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`HV_OBJECT_LIST`,[pt1])) . (let (pt1',sptl1) = convert_HV_OBJECT (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`HV_OBJECT_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_HV_OBJECT (pt1,sptl) and (pt2',sptl2) = convert_HV_OBJECT_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_HV_OBJECT_LIST`) | (_) . failwith `convert_HV_OBJECT_LIST` and convert_HOV_OBJECT_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`HOV_OBJECT_LIST`,[pt1])) . (let (pt1',sptl1) = convert_HOV_OBJECT (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`HOV_OBJECT_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_HOV_OBJECT (pt1,sptl) and (pt2',sptl2) = convert_HOV_OBJECT_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_HOV_OBJECT_LIST`) | (_) . failwith `convert_HOV_OBJECT_LIST` % `convert_BOX_SPEC' obtains the default box parameters and sends them to % % the objects as a `BOX_PARAMS' message. % and convert_BOX_SPEC (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`BOX_SPEC`,[pt1;pt2])) . (let (pt1',sptl1) = convert_BOX (pt1,sptl) in let sptl' = (`BOX_PARAMS`,pt1').sptl in case pt1 of (Print_node (`H_BOX`,_)) . (let (pt2',sptl2) = convert_H_OBJECT_LIST (pt2,sptl') in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`H_box`,[])]); pt2' ]), sptl1 @ sptl2)) | (Print_node (`V_BOX`,_)) . (let (pt2',sptl2) = convert_V_OBJECT_LIST (pt2,sptl') in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`V_box`,[])]); pt2' ]), sptl1 @ sptl2)) | (Print_node (`HV_BOX`,_)) . (let (pt2',sptl2) = convert_HV_OBJECT_LIST (pt2,sptl') in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`HV_box`,[])]); pt2' ]), sptl1 @ sptl2)) | (Print_node (`HOV_BOX`,_)) . (let (pt2',sptl2) = convert_HOV_OBJECT_LIST (pt2,sptl') in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`HoV_box`,[])]); pt2' ]), sptl1 @ sptl2)) | (_) . failwith `convert_BOX_SPEC`) | (_) . failwith `convert_BOX_SPEC` and convert_EXPAND (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`EXPAND`,[pt1])) . (convert_BOX_SPEC (pt1,sptl)) | (_) . failwith `convert_EXPAND` and convert_FORMAT (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`FORMAT`,[])) . (Print_node (`CON0`,[Print_node (`PF_empty`,[])]), []) | (Print_node (`FORMAT`,[pt1])) . (let (pt1',sptl1) = convert_BOX_SPEC (pt1,sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`PF`,[])]); pt1' ]), sptl1)) | (Print_node (`FORMAT`,[pt1;pt2;pt3])) . (let (pt1',sptl1) = convert_TEST (pt1,sptl) and (pt2',sptl2) = convert_FORMAT (pt2,sptl) and (pt3',sptl3) = convert_FORMAT (pt3,sptl) in (Print_node (`APPN`,[Print_node (`CON`,[Print_node (`PF_branch`,[])]); Print_node (`DUPL`,[pt1'; Print_node (`DUPL`,[pt2';pt3']) ]) ]), sptl1 @ sptl2 @ sptl3)) | (_) . failwith `convert_FORMAT`;; let convert_RULE (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`RULE`,[pt1;pt2])) . (let (pt1',sptl1) = convert_PATTERN (pt1,sptl) and (pt2',sptl2) = convert_FORMAT (pt2,sptl) in (Print_node (`DUPL`, [pt1';Print_node (`DUPL`,[Print_node (`LIST`,[]);pt2'])]), sptl1 @ sptl2)) | (Print_node (`RULE`,[pt1;pt2;pt3])) . (let (pt1',sptl1) = convert_PATTERN (pt1,sptl) and (pt2',sptl2) = convert_P_SPECIAL_LIST (pt2,sptl) and (pt3',sptl3) = convert_FORMAT (pt3,sptl) in (Print_node (`DUPL`,[pt1';Print_node (`DUPL`,[pt2';pt3'])]), sptl1 @ sptl2 @ sptl3)) | (_) . failwith `convert_RULE`;; letrec convert_RULE_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`RULE_LIST`,[pt1])) . (let (pt1',sptl1) = convert_RULE (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`RULE_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_RULE (pt1,sptl) and (pt2',sptl2) = convert_RULE_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_RULE_LIST`) | (_) . failwith `convert_RULE_LIST`;; let convert_RULES (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`RULES`,[pt1])) . (convert_RULE_LIST (pt1,sptl)) | (_) . failwith `convert_RULES`;; let convert_BINDING (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`BINDING`,[pt1;pt2])) . (let (pt1',sptl1) = convert_ID_to_VAR (pt1,sptl) and (pt2',sptl2) = convert_ML_FUN (pt2,sptl) in (Print_node (`DUPL`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_BINDING`;; letrec convert_BINDING_LIST_to_LIST (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`BINDING_LIST`,[pt1])) . (let (pt1',sptl1) = convert_BINDING (pt1,sptl) in (Print_node (`LIST`,[pt1']), sptl1)) | (Print_node (`BINDING_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_BINDING (pt1,sptl) and (pt2',sptl2) = convert_BINDING_LIST_to_LIST (pt2,sptl) in case pt2' of (Print_node (`LIST`,ptl)) . (Print_node (`LIST`,(pt1'.ptl)), sptl1 @ sptl2) | (_) . failwith `convert_BINDING_LIST_to_LIST`) | (_) . failwith `convert_BINDING_LIST_to_LIST`;; % The bindings used in declarations are made into an ML `letrec', so that % % they are mutually recursive. The identifiers declared must be function % % valued, but unfortunately ML is too restrictive. It insists that the body % % of the declaration be an abstraction (after having changed arguments on % % the left of the equals sign into bound variables on the right). This % % restriction is overcome by converting the body of the declaration, say % % `body', into (\dummy0. (body dummy0)). This works provided `body' is % % function valued, and `dummy0' does not occur in `body'. To overcome this % % second problem, a function to find an unused identifier is used. % letrec convert_BINDING_LIST_to_LETREC (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % let dummy pt = % : (print_tree -> print_tree) % letrec find_unused_id sl n = % : (string list -> int -> string) % let s = `dummy` ^ (string_of_int n) in if (strings_contain sl s) then find_unused_id sl (n + 1) else s in let dummy_var = find_unused_id (case pt of (Print_node (`ML_FUN`,ptl)) . (map (\pt'. case pt' of (Print_node (s,[])) . s | (_) . failwith `convert_BINDING_LIST_to_LETREC` ) ptl) | (_) . failwith `convert_BINDING_LIST_to_LETREC`) 0 in Print_node (`ABSTR`,[Print_node (`VAR`,[Print_node (dummy_var,[])]); Print_node (`APPN`, [pt; Print_node (`VAR`,[Print_node (dummy_var,[])]) ]) ]) in case pt of (Print_node (`BINDING_LIST`,[pt1])) . (let (pt1',sptl1) = convert_BINDING (pt1,sptl) in case pt1' of (Print_node (`DUPL`,[pt1a;pt1b])) . (Print_node (`LETREC`,[pt1a;dummy pt1b]),sptl1) | (_) . failwith `convert_BINDING_LIST_to_LETREC`) | (Print_node (`BINDING_LIST`,[pt1;pt2])) . (let (pt1',sptl1) = convert_BINDING (pt1,sptl) and (pt2',sptl2) = convert_BINDING_LIST_to_LETREC (pt2,sptl) in case (pt1',pt2') of (Print_node (`DUPL`,[pt1a;pt1b]), Print_node (`LETREC`,[pt2a;pt2b])) . (Print_node (`LETREC`,[Print_node (`DUPL`,[pt1a;pt2a]); Print_node (`DUPL`,[dummy pt1b;pt2b])]), sptl1 @ sptl2) | (_) . failwith `convert_BINDING_LIST_to_LETREC`) | (_) . failwith `convert_BINDING_LIST_to_LETREC`;; let convert_DECLARS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`DECLARS`,[pt1])) . (convert_BINDING_LIST_to_LETREC (pt1,sptl)) | (_) . failwith `convert_DECLARS`;; % `convert_ABBREVS' creates a null tree. The bindings of identifiers to % % blocks of ML code which it obtains are sent as `ABBREV_...' messages. % let convert_ABBREVS (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % let convert x = case x of (Print_node (`DUPL`,[Print_node (`VAR`,[Print_node (s,[])]); pt'])) . ((`ABBREV_` ^ s),pt') | (_) . failwith `convert_ABBREVS` in case pt of (Print_node (`ABBREVS`,[pt1])) . (let (pt1',sptl1) = convert_BINDING_LIST_to_LIST (pt1,sptl) in case pt1' of (Print_node (`LIST`,ptl)) . (Print_node (``,[]), sptl1 @ (map convert ptl)) | (_) . failwith `convert_ABBREVS`) | (_) . failwith `convert_ABBREVS`;; % The result of the calls to `convert_ABBREVS' in the function below is a % % null tree and a list of messages containing the abbreviation information. % % The messages are passed to `convert_RULES', but are not passed back to % % the function which called `convert_BODY'. % let convert_BODY (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`BODY`,[pt1])) . (convert_RULES (pt1,sptl)) | (Print_node (`BODY`,[Print_node (`DECLARS`,ptl); pt2])) . (let (pt1',sptl1) = convert_DECLARS (Print_node (`DECLARS`,ptl), sptl) and (pt2',sptl2) = convert_RULES (pt2,sptl) in (Print_node (`IN`,[pt1';pt2']), sptl1 @ sptl2)) | (Print_node (`BODY`,[Print_node (`ABBREVS`,ptl); pt2])) . (let (_,sptl1) = convert_ABBREVS (Print_node (`ABBREVS`,ptl), sptl) in convert_RULES (pt2, sptl1 @ sptl)) | (Print_node (`BODY`,[pt1;pt2;pt3])) . (let (_,sptl2) = convert_ABBREVS (pt2,sptl) in let (pt1',sptl1) = convert_DECLARS (pt1,sptl) and (pt3',sptl3) = convert_RULES (pt3, sptl2 @ sptl) in (Print_node (`IN`,[pt1';pt3']), sptl1 @ sptl3)) | (_) . failwith `convert_BODY`;; let convert_PP (pt,sptl) = % : (print_tree # ((string # print_tree) list) -> % % print_tree # ((string # print_tree) list)) % case pt of (Print_node (`PP`,[pt1;pt2])) . (let (pt1',sptl1) = convert_ID_to_VAR (pt1,sptl) and (pt2',sptl2) = convert_BODY (pt2,sptl) in (Print_node (`LET`,[pt1';pt2']), sptl1 @ sptl2)) | (_) . failwith `convert_PP`;; convert_PP;; end_section convert;; let convert_PP = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/generate.ml0000640000212700021270000003313505071610121021054 0ustar cammcamm% generate.ml % %-----------------------------------------------------------------------------% begin_section generate;; % Pretty-printing rules for a subset of ML. % % These rules are used to generate ML code from a parse-tree. They appear % % as the ML data structure which represents the rules. No precedence is % % used to reduce the number of parentheses, because the output is only % % intended for code generation. % let PP_to_ML_rules = % : (print_rule list) % [ % Rule for use with ML code block rule % % Prints a node name representing some arbitrary string. % (`name`,Var_name (`n`,[]),(\x y. true)),[], (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]); % Integer constant % (``,Const_name (`INTCONST`,[Patt_child (Var_name (`n`,[]))]), (\x y. true)),[], (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]); % String constant % (``,Const_name (`TOKCONST`,[Patt_child (Var_name (`n`,[]))]), (\x y. true)),[], (PF_H [Nat 0,PO_constant `\``; Nat 0,PO_leaf (`n`,(\s.s)); Nat 0,PO_constant `\`` ]); % Variable % (``,Const_name (`VAR`,[Patt_child (Var_name (`n`,[]))]), (\x y. true)),[], (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]); % Concrete type constructor with argument % (``,Const_name (`CON`,[Patt_child (Var_name (`n`,[]))]), (\x y. true)),[], (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]); % Concrete type constructor with no argument % (``,Const_name (`CON0`,[Patt_child (Var_name (`n`,[]))]), (\x y. true)),[], (PF_H [Nat 0,PO_leaf (`n`,(\s.s))]); % Application of unary operator % (``,Const_name (`UNOP`,[Patt_child (Var_name (`n`,[])); Patt_child (Var_child `c`) ]), (\x y. true)),[], (PF_H [Nat 0,PO_constant `(`; Nat 0,PO_format (PF_HV [(Nat 0,Abs 0,Nat 0),PO_leaf (`n`,(\s.s)); (Nat 0,Abs 0,Nat 0),PO_subcall ((`c`,(\l.l)),[]) ]); Nat 0,PO_constant `)` ]); % Function application % (``,Const_name (`APPN`,[Patt_child (Var_child `c1`); Patt_child (Var_child `c2`) ]), (\x y. true)),[], (PF_H [Nat 0,PO_constant `(`; Nat 0,PO_format (PF_HV [(Nat 1,Abs 1,Nat 0), PO_subcall((`c1`,(\l.l)),[]); (Nat 1,Abs 1,Nat 0), PO_subcall((`c2`,(\l.l)),[]) ]); Nat 0,PO_constant `)` ]); % Abstraction % (``,Const_name (`ABSTR`,[Patt_child (Var_child `c1`); Patt_child (Var_child `c2`) ]), (\x y. true)),[], (PF_H [Nat 0,PO_constant `(\\`; Nat 0,PO_format (PF_HV [(Nat 1,Abs 1,Nat 0), PO_format (PF_H [(Nat 0), PO_subcall ((`c1`,(\l.l)),[]); (Nat 0),PO_constant `.` ]); (Nat 1,Abs 1,Nat 0),PO_subcall((`c2`,(\l.l)),[]) ]); Nat 0,PO_constant `)` ]); % List of at least one element % (``,Const_name (`LIST`,[Var_children `cl`;Patt_child (Var_child `c`)]), (\x y. true)),[], (PF_H [Nat 0,PO_constant `[`; Nat 0,PO_format (PF_HoV [(Nat 0,Abs 0,Nat 0), PO_expand (H_box [Nat 0,PO_subcall ((`cl`,(\l.l)),[]); Nat 0,PO_constant `;` ]); (Nat 0,Abs 0,Nat 0), PO_subcall ((`c`,(\l.l)),[]) ]); Nat 0,PO_constant `]` ]); % Empty list % (``,Const_name (`LIST`,[]),(\x y. true)),[], (PF_H [Nat 0,PO_constant `[]`]); % Tuple % (``,Print_loop (Const_name (`DUPL`,[Patt_child (Var_child `cl`); Patt_child (Link_child (((Val (Nat 1)),Default),[])) ]), Var_child `c` ),(\x y. true)),[], (PF_H [Nat 0,PO_constant `(`; Nat 0,PO_format (PF_HV [(Nat 0,Abs 0,Nat 0), PO_expand (H_box [Nat 0,PO_subcall ((`cl`,(\l.l)),[]); Nat 0,PO_constant `,` ]); (Nat 0,Abs 0,Nat 0), PO_subcall ((`c`,(\l.l)),[]) ]); Nat 0,PO_constant `)` ]); % letrec ... and ... % (``,Const_name (`LETREC`, [Patt_child (Const_name (`DUPL`, [Patt_child (Var_child `var1`); Patt_child (Print_loop (Const_name (`DUPL`, [Patt_child (Var_child `varl`); Patt_child (Link_child ((Default,Default),[])) ]), Var_child `varl` )) ])); Patt_child (Const_name (`DUPL`, [Patt_child (Var_child `body1`); Patt_child (Print_loop (Const_name (`DUPL`, [Patt_child (Var_child `bodyl`); Patt_child (Link_child ((Default,Default),[])) ]), Var_child `bodyl` )) ])) ]),(\x y. true)),[], (PF_V [(Abs 0,Nat 0), PO_format (PF_HV [(Nat 1,Inc 1,Nat 0),PO_constant `letrec`; (Nat 1,Inc 1,Nat 0), PO_format (PF_H [Nat 1,PO_subcall ((`var1`,(\l.l)),[]); Nat 1,PO_constant `=` ]); (Nat 1,Inc 1,Nat 0),PO_subcall ((`body1`,(\l.l)),[]) ]); (Abs 0,Nat 0), PO_expand (HV_box [(Nat 1,Inc 1,Nat 0),PO_constant `and`; (Nat 1,Inc 1,Nat 0), PO_expand (H_box [Nat 1,PO_subcall ((`varl`,(\l.l)),[]); Nat 1,PO_constant `=` ]); (Nat 1,Inc 1,Nat 0),PO_subcall ((`bodyl`,(\l.l)),[]) ]) ]); % letrec ... % (``,Const_name (`LETREC`,[Patt_child (Var_child `c1`); Patt_child (Var_child `c2`)]), (\x y. true)),[], (PF_HV [(Nat 1,Inc 1,Nat 0),PO_constant `letrec`; (Nat 1,Inc 1,Nat 0), PO_format (PF_H [Nat 1,PO_subcall ((`c1`,(\l.l)),[]); Nat 1,PO_constant `=` ]); (Nat 1,Inc 1,Nat 0),PO_subcall ((`c2`,(\l.l)),[]) ]); % Special block of ML code % (``,Const_name (`ML_FUN`,[Var_children `cl`]), (\x y. true)),[], (PF_H [Nat 0,PO_constant `(`; Nat 0, PO_format (PF_V [(Abs 0,Nat 0), PO_context_subcall (`name`,(`cl`,(\l.l)),[]) ]); Nat 0,PO_constant `)` ]) ] : print_rule list;; % Print-rule function for above rules. % let PP_to_ML_rules_fun = % : (print_rule_function) % print_rule_fun PP_to_ML_rules;; % Write a list of strings to an output port, following all but the last % % with a line-break. % let write_strings f port sl = % : ((string # string -> void) -> string -> string list -> void) % letrec terminate_strings sl' = % : (string list -> string list) % if (null sl') then [] else if (null (tl sl')) then [hd sl'] else ((hd sl') ^ `\L`).(terminate_strings (tl sl')) in do (map (\s. f (port,s)) (terminate_strings sl));; % Function to generate a list of strings representing ML code from an ML % % parse-tree for a print-rule. Uses the pretty-printing functions. The % % function assumes an 80-column output. It indents the text by 4 spaces, % % and leaves room for a semi-colon at the end of the text. % % Debugging is active, so that system errors are reported. This is % % controlled by the first argument to `print_box_to_strings'. % let generate_rule pt = % : (print_tree -> string list) % print_box_to_strings true 4 (print_tree_to_box 78 4 PP_to_ML_rules_fun `` [] pt);; % Function to print an ML parse-tree for a print-rule. % let write_rule f port pt = % : ((string # string -> void) -> string -> print_tree -> void) % write_strings f port (generate_rule pt);; % Function to print a list of parse-trees derived from print-rules, % % terminating all but the last with a semi-colon and a line-break. % % The last rule is terminated only by a line-break. % letrec write_rules f port ptl = % : ((string # string -> void) -> string -> print_tree list -> void) % if (null ptl) then failwith `write_rules` else if (null (tl ptl)) then do (write_rule f port (hd ptl); f (port,`\L`)) else do (write_rule f port (hd ptl); f (port,`;`); f (port,`\L`); write_rules f port (tl ptl));; % Function to generate a list of strings representing ML code from an ML % % parse-tree for declarations. Uses the pretty-printing functions. The % % function assumes an 80-column output. It indents the text by 3 spaces. % % Debugging is active, so that system errors are reported. This is % % controlled by the first argument to `print_box_to_strings'. % let generate_declarations pt = % : (print_tree -> string list) % print_box_to_strings true 3 (print_tree_to_box 79 3 PP_to_ML_rules_fun `` [] pt);; % Function to print an ML parse-tree for declarations. % let write_declarations f port pt = % : ((string # string -> void) -> string -> print_tree -> void) % do (write_strings f port (generate_declarations pt); f (port,`\L`));; % Generate beginning of ML declaration from name of pretty-printer. % let generate_head s = % : (string -> string list) % [``; `let `^s^`_rules =`; ``; ` % : (print_rule list) %`; `\L` ];; % Write beginning of ML declaration. % let write_head f port s = % : ((string # string -> void) -> string -> string -> void) % write_strings f port (generate_head s);; % Generate end of ML declaration from name of pretty-printer. % let generate_tail s = % : (string -> string list) % [` ] : print_rule list;;`; ``; ``; `let `^s^`_rules_fun =`; ``; ` % : (print_rule_function) %`; ``; ` print_rule_fun `^s^`_rules;;`; `\L` ];; % Write end of ML declaration. % let write_tail f port s = % : ((string # string -> void) -> string -> string -> void) % write_strings f port (generate_tail s);; % Write the whole ML translation of a pretty-printer. % % The parse-tree for the ML translation of the pretty-printer specification % % is split into name of pretty-printer, declarations (if present), and % % a list of rules. Each rule is processed seperately so as to avoid giving % % the pretty-printer too large an amount to process. % let generate_ML (f:(string # string) -> void) port pt = % : ((string # string -> void) -> string -> print_tree -> void) % case pt of (Print_node (`LET`,[Print_node (`VAR`,[Print_node (s,[])]); Print_node (`LIST`,ptl)])) . (do (write_head f port s; f (port,` [`); f (port,`\L`); write_rules f port ptl; write_tail f port s)) | (Print_node (`LET`,[Print_node (`VAR`,[Print_node (s,[])]); Print_node (`IN`,[pt1; Print_node (`LIST`,ptl)])])) . (do (write_head f port s; write_declarations f port pt1; f (port,` in`); f (port,`\L`); f (port,` [`); f (port,`\L`); write_rules f port ptl; write_tail f port s)) | (_) . failwith `generate_ML`;; generate_ML;; end_section generate;; let generate_ML = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/lex.ml0000640000212700021270000002335105071610122020052 0ustar cammcamm% lex.ml % %-----------------------------------------------------------------------------% % Function to copy a number of characters from an input port to an output % % port. % % The input port is specified as a function and a port name. When the e % % function is applied to the port name, a character is obtained. The output % % port is specified as a function which given a character writes it to some % % destination. If the input is exhausted before the specified number of % % characters have been copied, the copying terminates without error. % letrec copy_chars n inf (inport:string) (out:string -> void) = % : (int -> (string -> string) -> string -> (string -> void) -> void) % if (n < 1) then () else let char = inf inport in if (char = `nil`) then () else do (out char; copy_chars (n - 1) inf inport out);; % Datatype for lexical objects. % % The kinds of object are: special symbols, numbers, identifiers, and % % blocks of text. Lex_block((begin,end),sl) is obtained from a block of % % text beginning with the value of `begin' and ending with the value of % % `end'. The text in between is split on line-breaks into a list of % % strings, sl. % type lex_symb = Lex_spec of string | Lex_num of string | Lex_id of string | Lex_block of (string # string) # string list;; begin_section lex;; % Functions for determining classification of a character. % let is_lex_char (l,c,u) = % : (string # string # string -> bool) % not (((ascii_code c) < (ascii_code l)) or ((ascii_code c) > (ascii_code u)));; let is_lex_ucase c = is_lex_char (`A`,c,`Z`);; let is_lex_lcase c = is_lex_char (`a`,c,`z`);; let is_lex_letter c = (is_lex_ucase c) or (is_lex_lcase c);; let is_lex_digit c = is_lex_char (`0`,c,`9`);; let is_lex_underscore c = mem c [`_`];; let is_lex_eof c = mem c [`nil`];; let is_lex_eol c = mem c [`\R`;`\L`;`\F`];; let is_lex_space c = mem c [`\0`;`\1`;`\2`;`\3`;`\4`;`\5`;`\6`;`\7`;`\8`;`\9`; ` `;`\S`;`\T`];; % Error handler for lexical errors. % let lex_error f port exp got = % : ((string -> string) -> string -> string -> string -> ?) % tty_write (`Syntax error: expected `^exp^`, got `^got^` ...`^`\L`); copy_chars 200 f port tty_write; tty_write `\L`; tty_write (`... parse failed.`^`\L`); failwith `lex_error`;; % Function to read a character from an input port. % let read_char f port = % : ((string -> string) -> string -> string) % let c = f port in if (is_lex_eof c) then failwith `read_char -- input exhausted` else c;; % Function to read a number. % % Requires first character of input as an argument. Returns the first % % unused character. This allows the necessary lookahead. Builds digits into % % a string until no more are encountered. % let read_number f port c = % : ((string -> string) -> string -> string -> (lex_symb # string)) % letrec scan f port (s,c') = % : ((string -> string) -> string -> (string # string) -> % % (string # string)) % if (is_lex_digit c') then scan f port ((s ^ c'),(read_char f port)) else (s,c') in let (s,c') = scan f port (``,c) in (Lex_num s,c');; % Function to read an identifier. % % Identifiers can contain letters, digits and underscores, but underscores % % must be followed by a letter or a digit. The function given allows % % identifiers to begin with a number or an underscore. This is not correct % % but since the function will only ever be called when a letter is % % encountered, there should be no problem. % let read_identifier f port c = % : ((string -> string) -> string -> string -> (lex_symb # string)) % letrec scan f port (s,c') = % : ((string -> string) -> string -> (string # string) -> % % (string # string)) % if (is_lex_underscore c') then (let c'' = read_char f port in if ((is_lex_letter c'') or (is_lex_digit c'')) then scan f port ((s ^ c' ^ c''),(read_char f port)) else lex_error f port `letter or digit` c'') if (is_lex_letter c') then (scan f port ((s ^ c'),(read_char f port))) if (is_lex_digit c') then (scan f port ((s ^ c'),(read_char f port))) else (s,c') in let (s,c') = scan f port (``,c) in (Lex_id s,c');; % Function to read a block of text. % % This function expects to be called with the character used to introduce % % the block as its last argument. It discards this character because it is % % not to be included in the list of strings representing the block of text. % % On encountering the terminating character, the function reads the next % % character to check if the end character has been doubled-up. If it has, % % a single end character is included in the string list, and the scan % % continues. Otherwise the scan ends and the list of strings is reversed, % % since it has been built in reverse order. % % If the start character is encountered doubled-up, a single start char. is % % included in the list of strings. If the start char. is not doubled-up, an % % error occurs. % % If an end-of-line occurs, a new string is begun. % let read_block f port (start,end) (c:string) = % : ((string -> string) -> string -> (string # string) -> string -> % % (lex_symb # string)) % letrec scan f port (start,end) (sl,s,c') = % : ((string -> string) -> string -> (string # string) -> % % (string list # string # string) -> (string list # string)) % if (c' = end) then % Note : order important if start = end % (let c'' = read_char f port in if (c'' = end) then scan f port (start,end) (sl,(s ^ end),(read_char f port)) else (rev (s.sl),c'')) if (c' = start) then (let c'' = read_char f port in if (c'' = start) then scan f port (start,end) (sl,(s ^ start),(read_char f port)) else lex_error f port (start ^ start) start) if (is_lex_eol c') then (scan f port (start,end) ((s.sl),``,(read_char f port))) else scan f port (start,end) (sl,(s ^ c'),(read_char f port)) in let (sl,c') = scan f port (start,end) ([],``,(read_char f port)) in (Lex_block ((start,end),sl),c');; % Function to read a special symbol. % % Note: Special symbols must not contain letters, digits, underscore or any % % character occuring in the argument `quotes' of the function `read_symb'. % % The function builds up a string. Initially this is null. It tries adding % % the next character of the input to the end of the string. If the result % % is one of the specified special symbols, or the beginnings of one, the % % function tries to add another character. If not, the old string is tested % % to see if it is a special symbol. If it is not, or if no characters could % % be added, an error occurs. This process allows one special symbol to be a % % substring of another. The function reads the larger one if it can. % let read_special f port specials c = % : ((string -> string) -> string -> string list -> string -> % % (lex_symb # string)) % letrec scan f port specials (s,c') = % : ((string -> string) -> string -> string list -> % % (string # string) -> (string # string)) % let s' = s ^ c' in if (exists (\x. (s' = (substr 0 (strlen s') x)) ? false) specials) then scan f port specials (s',(read_char f port)) else if (mem s specials) then (s,c') else (``,s') in let (s,c') = scan f port specials (``,c) in if (s = ``) then lex_error f port `a special symbol` c' else (Lex_spec s,c');; % Function to read a lexical object. % % Spaces and line-breaks are ignored. If a digit is encountered, a number % % is read. If a letter is encountered, an identifier is read. The % % identifier is made into a special symbol if it is listed as a keyword. % % If the next character is listed as the start of a block, the appropriate % % kind of block is read. Failing all these, an attempt is made to read a % % special symbol. % letrec read_symb f (port:string) quotes keywords specials c = % : ((string -> string) -> string -> (string # string) list -> % % string list -> string list -> string -> (lex_symb # string)) % if ((is_lex_space c) or (is_lex_eol c)) then (read_symb f port quotes keywords specials (read_char f port)) if (is_lex_digit c) then (read_number f port c) if (is_lex_letter c) then (case (read_identifier f port c) of (Lex_id s,c') . (if (mem s keywords) then (Lex_spec s,c') else (Lex_id s,c')) | (_) . failwith `read_symb -- system error`) else ( (let p = assoc c quotes in read_block f port p c) ?? [`assoc`] (read_special f port specials c) );; read_symb;; end_section lex;; let read_symb = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/pp_lang1.build0000640000212700021270000000063705071610123021455 0ustar cammcamm% pp_lang1.build % %-----------------------------------------------------------------------------% let pp_lang1_rules = % : (print_rule list) % [] : print_rule list;; let pp_lang1_rules_fun = % : (print_rule_function) % print_rule_fun pp_lang1_rules;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/pp_lang1.pp0000640000212700021270000002060305071610123020770 0ustar cammcamm% pp_lang1.pp % %-----------------------------------------------------------------------------% % A pretty-printer for the pretty-printing language (part 1) % prettyprinter pp_lang1 = declarations % Function to double-up a specified character within a string. % quote_quote = { \s. letrec dupl s sl = if (null sl) then [] else if ((hd sl) = s) then s.s.(dupl s (tl sl)) else (hd sl).(dupl s (tl sl)) in (implode o (dupl s) o explode) }; destruct = { \ptaddl. map (\(pt,add). case pt of (Print_node (s,[])) . (s,add) | (_) . failwith `pp_lang_rules_fun`) ptaddl }; construct = {\saddl. map (\(s,add). Print_node (s,[]),add) saddl}; % `convert' processes the list of strings representing a block of ML code % % in the pretty-printing specification. The text is to appear neatly in the % % pretty-printed output. When there is only one line in the text block, the % % conversion is easy. Space is trimmed from the beginning and the end of % % the string. % % If the block extends over more than one line, the first line must be % % blank, so that the vertical alignment of the text in the source file can % % be deduced. If this condition is satisfied, the first line is discarded, % % and trailing blanks are removed from all of the other lines. Any blank % % lines will now be empty strings. The smallest number of leading blanks in % % those strings which are not empty is computed, and this amount of space % % is removed from the beginning of all the strings which are not blank. % % This process retains the vertical alignment of the text, but removes dead % % space to the left of the block. % convert = { \saddl. if ((length saddl) = 1) then [(trim_enclosing_chars [` `] # I) (hd saddl)] else if ((trim_enclosing_chars [` `] (fst (hd saddl))) = ``) then let saddl' = map (trim_trailing_chars [` `] # I) saddl in let dead_space = min (map (num_of_leading_chars [` `]) (filter (\s. not (s = ``)) (map fst saddl'))) in map (\(s,add). if (s = ``) then (s,add) else (substr dead_space ((strlen s) - dead_space) s,add)) saddl' else failwith `pp_lang_rules_fun` }; % Functions for determining whether a string is a valid identifier. % is_char = { \(l,c,u). not (((ascii_code c) < (ascii_code l)) or ((ascii_code c) > (ascii_code u))) }; is_ucase = {\c. is_char (`A`,c,`Z`)}; is_lcase = {\c. is_char (`a`,c,`z`)}; is_letter = {\c. (is_ucase c) or (is_lcase c)}; is_digit = {\c. is_char (`0`,c,`9`)}; is_underscore = {\c. mem c [`_`]}; is_id_body = { \sl. if (null sl) then true else if (is_underscore (hd sl)) then if (null (tl sl)) then false else if (is_letter (hd (tl sl))) or (is_digit (hd (tl sl))) then is_id_body (tl (tl sl)) else false else if (is_letter (hd sl)) or (is_digit (hd sl)) then is_id_body (tl sl) else false }; not_id = { (\sl. if (null sl) then true else if (is_letter (hd sl)) then not (is_id_body (tl sl)) else true) o explode }; % Function for determining whether a string is a keyword of the % % pretty-printing language. % is_keyword = { \s. mem s [`prettyprinter`;`rules`;`declarations`;`abbreviations`; `with`;`end`;`where`;`if`;`then`;`else`; `h`;`v`;`hv`;`hov`] }; end declarations abbreviations % Abbreviation for a function which produces valid textual output for a % % block of ML code within the pretty-printer specification. An appropriate % % formatting is applied, and occurrences of `{' and `}' are doubled-up so % % that they appear as the original input would have done. % despace = { construct o (map ((quote_quote `{{` # I) o (quote_quote `}}` # I))) o convert o destruct }; % Abbreviations for functions which double-up quotes within quoted text. % quote_string = {quote_quote `'`}; quote_terminal = {quote_quote `"`}; % Abbreviation for a function which surrounds an identifier with sharp % % signs if the string representing the identifier is a keyword or not a % % valid identifier. Any occurrences of `#' within the string are doubled-up % % so that they do not appear to be the terminating `#'. % quote_id = { \s. if ((is_keyword s) or (not_id s)) then (`#` ^ (quote_quote `#` s) ^ `#`) else s }; end abbreviations % A number of the following rules use a metavariable which matches a list of % % sub-trees (i.e. zero or more), that is a metavariable beginning with `**', % % to match a single optional sub-tree (zero or one occurrences). % rules ''::NUM(***num()) -> [ ***num]; ''::NEG(*num) -> [ "-" *num]; ''::STRING(***string()) -> [ "'" quote_string(***string) "'"]; ''::TERMINAL(***string()) -> [ """" quote_terminal(***string) """"]; ''::ML_FUN(**strings) -> [ "{" [ despace(**strings)] "}" ]; ''::ID(***id()) -> [ quote_id(***id)]; ''::NAME_META(**id) -> [ "***" **id]; ''::CHILD_META(**id) -> [ "*" **id]; ''::CHILDREN_META(**id) -> [ "**" **id]; ''::[METAVAR_LIST(*metavars,<>)]METAVAR_LIST(*metavar) -> [ **[ *metavars ";"] *metavar]; ''::MIN(*num) -> [ *num]; ''::MAX(*num) -> [ *num]; ''::LOOP_RANGE(MIN(*num)) -> [ *num ".."]; ''::LOOP_RANGE(MAX(*num)) -> [ ".." *num]; ''::LOOP_RANGE(*min,*max) -> [ *min ".." *max]; ''::LOOP_LINK(*loop_range,*metavar_list) -> [ "<" *loop_range ":" <1> *metavar_list ">"]; ''::LOOP_LINK(**metavar_list) -> [ "<" **metavar_list ">"]; ''::LABEL(*child_meta) -> [ "|" *child_meta "|"]; ''::NODE_NAME(*node_name) -> [ *node_name]; ''::CHILD(*child) -> [ *child]; ''::[CHILD_LIST(*children,<>)]CHILD_LIST(*child) -> [ **[ *children ","] *child]; ''::PATT_TREE(NODE_NAME(*node_name),*child_list) -> [ *node_name [ "(" *child_list ")"]]; ''::PATT_TREE(NODE_NAME(*node_name)) -> [ *node_name "()"]; ''::PATT_TREE(**x) -> [ **x]; ''::LOOP(*patt_tree) -> [ "[" *patt_tree "]"]; ''::TEST(*test) -> [ *test]; ''::PATTERN(*string,*patt_tree,**test) -> [ *string "::" [ *patt_tree **[ "where" **test]]]; ''::TRANSFORM(*transform) -> [ *transform]; ''::P_SPECIAL(*metavar,*transform) -> [ [ *metavar "="] *transform]; ''::[P_SPECIAL_LIST(*p_specials,<>)]P_SPECIAL_LIST(*p_special) -> [ **[ *p_specials ";"] *p_special]; end rules end prettyprinter %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/pp_lang2.build0000640000212700021270000000063705071610124021457 0ustar cammcamm% pp_lang2.build % %-----------------------------------------------------------------------------% let pp_lang2_rules = % : (print_rule list) % [] : print_rule list;; let pp_lang2_rules_fun = % : (print_rule_function) % print_rule_fun pp_lang2_rules;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/pp_lang2.pp0000640000212700021270000002406305071610124020776 0ustar cammcamm% pp_lang2.pp % %-----------------------------------------------------------------------------% % A pretty-printer for the pretty-printing language (part 2) % prettyprinter pp_lang2 = declarations % Function to double-up a specified character within a string. % quote_quote = { \s. letrec dupl s sl = if (null sl) then [] else if ((hd sl) = s) then s.s.(dupl s (tl sl)) else (hd sl).(dupl s (tl sl)) in (implode o (dupl s) o explode) }; destruct = { \ptaddl. map (\(pt,add). case pt of (Print_node (s,[])) . (s,add) | (_) . failwith `pp_lang_rules_fun`) ptaddl }; construct = {\saddl. map (\(s,add). Print_node (s,[]),add) saddl}; % `convert' processes the list of strings representing a block of ML code % % in the pretty-printing specification. The text is to appear neatly in the % % pretty-printed output. When there is only one line in the text block, the % % conversion is easy. Space is trimmed from the beginning and the end of % % the string. % % If the block extends over more than one line, the first line must be % % blank, so that the vertical alignment of the text in the source file can % % be deduced. If this condition is satisfied, the first line is discarded, % % and trailing blanks are removed from all of the other lines. Any blank % % lines will now be empty strings. The smallest number of leading blanks in % % those strings which are not empty is computed, and this amount of space % % is removed from the beginning of all the strings which are not blank. % % This process retains the vertical alignment of the text, but removes dead % % space to the left of the block. % convert = { \saddl. if ((length saddl) = 1) then [(trim_enclosing_chars [` `] # I) (hd saddl)] else if ((trim_enclosing_chars [` `] (fst (hd saddl))) = ``) then let saddl' = map (trim_trailing_chars [` `] # I) saddl in let dead_space = min (map (num_of_leading_chars [` `]) (filter (\s. not (s = ``)) (map fst saddl'))) in map (\(s,add). if (s = ``) then (s,add) else (substr dead_space ((strlen s) - dead_space) s,add)) saddl' else failwith `pp_lang_rules_fun` }; % Functions for determining whether a string is a valid identifier. % is_char = { \(l,c,u). not (((ascii_code c) < (ascii_code l)) or ((ascii_code c) > (ascii_code u))) }; is_ucase = {\c. is_char (`A`,c,`Z`)}; is_lcase = {\c. is_char (`a`,c,`z`)}; is_letter = {\c. (is_ucase c) or (is_lcase c)}; is_digit = {\c. is_char (`0`,c,`9`)}; is_underscore = {\c. mem c [`_`]}; is_id_body = { \sl. if (null sl) then true else if (is_underscore (hd sl)) then if (null (tl sl)) then false else if (is_letter (hd (tl sl))) or (is_digit (hd (tl sl))) then is_id_body (tl (tl sl)) else false else if (is_letter (hd sl)) or (is_digit (hd sl)) then is_id_body (tl sl) else false }; not_id = { (\sl. if (null sl) then true else if (is_letter (hd sl)) then not (is_id_body (tl sl)) else true) o explode }; % Function for determining whether a string is a keyword of the % % pretty-printing language. % is_keyword = { \s. mem s [`prettyprinter`;`rules`;`declarations`;`abbreviations`; `with`;`end`;`where`;`if`;`then`;`else`; `h`;`v`;`hv`;`hov`] }; end declarations abbreviations % Abbreviation for a function which produces valid textual output for a % % block of ML code within the pretty-printer specification. An appropriate % % formatting is applied, and occurrences of `{' and `}' are doubled-up so % % that they appear as the original input would have done. % despace = { construct o (map ((quote_quote `{{` # I) o (quote_quote `}}` # I))) o convert o destruct }; % Abbreviations for functions which double-up quotes within quoted text. % quote_string = {quote_quote `'`}; quote_terminal = {quote_quote `"`}; % Abbreviation for a function which surrounds an identifier with sharp % % signs if the string representing the identifier is a keyword or not a % % valid identifier. Any occurrences of `#' within the string are doubled-up % % so that they do not appear to be the terminating `#'. % quote_id = { \s. if ((is_keyword s) or (not_id s)) then (`#` ^ (quote_quote `#` s) ^ `#`) else s }; end abbreviations % A number of the following rules use a metavariable which matches a list of % % sub-trees (i.e. zero or more), that is a metavariable beginning with `**', % % to match a single optional sub-tree (zero or one occurrences). % rules ''::INT_EXP(*int_exp) -> [ *int_exp]; ''::ASSIGN(*id,*exp) -> [ [ *id ":="] *exp]; ''::[ASSIGNMENTS(*assigns,<>)]ASSIGNMENTS(*assign) -> [ **[ *assigns ";"] *assign]; ''::F_SUBCALL(*child) -> [ *child]; ''::F_SUBCALL(*transform,*metavar) -> [ *transform [ "(" *metavar ")"]]; ''::C_SUBCALL(*f_subcall) -> [ *f_subcall]; ''::C_SUBCALL(*string,*f_subcall) -> [ [ *string "::"] *f_subcall]; ''::LEAF_OR_SUBCALL(*c_subcall,**assigns) -> [ *c_subcall **[ "with" <3,0> **assigns "end with"]]; ''::INC(*num) -> [ "+" *num]; ''::H_PARAMS(*num) -> [ *num]; ''::V_PARAMS(*indent,*num) -> [ *indent "," *num]; ''::HV_PARAMS(*num1,*indent,*num2) -> [ *num1 "," *indent "," *num2]; ''::HOV_PARAMS(*num1,*indent,*num2) -> [ *num1 "," *indent "," *num2]; ''::H_BOX(*h_params) -> [ "h" *h_params]; ''::V_BOX(*v_params) -> [ "v" *v_params]; ''::HV_BOX(*hv_params) -> [ "hv" *hv_params]; ''::HOV_BOX(*hov_params) -> [ "hov" *hov_params]; ''::OBJECT(*object) -> [ *object]; ''::H_OBJECT(**h_params,*object) -> [ **[ "<" **h_params ">"] *object]; ''::V_OBJECT(**v_params,*object) -> [ **[ "<" **v_params ">"] *object]; ''::HV_OBJECT(**hv_params,*object) -> [ **[ "<" **hv_params ">"] *object]; ''::HOV_OBJECT(**hov_params,*object) -> [ **[ "<" **hov_params ">"] *object]; ''::[H_OBJECT_LIST(*h_objects,<>)]H_OBJECT_LIST(*h_object) -> [ *h_objects *h_object]; ''::[V_OBJECT_LIST(*v_objects,<>)]V_OBJECT_LIST(*v_object) -> [ *v_objects *v_object]; ''::[HV_OBJECT_LIST(*hv_objects,<>)]HV_OBJECT_LIST(*hv_object) -> [ *hv_objects *hv_object]; ''::[HOV_OBJECT_LIST(*hov_objects,<>)]HOV_OBJECT_LIST(*hov_object) -> [ *hov_objects *hov_object]; ''::BOX_SPEC(*box,*object_list) -> [ "<" *box ">" <1> *object_list]; ''::EXPAND(*box_spec) -> [ "**[" *box_spec "]"]; ''::FORMAT() -> [ "[]"]; ''::FORMAT(*box_spec) -> [ "[" *box_spec "]"]; ''::FORMAT(*test,*format1,*format2) -> [ [ "if" *test] [ "then" *format1] [ "else" *format2]]; ''::RULE(PATTERN(*string,*patt_tree,**test),**p_specials,*format) -> [ *string "::" [ [ [ *patt_tree **[ "where" **test]] "->"] **[ "<<" **p_specials ">>"] *format]]; % `rules' is a keyword, so it must be quoted. % ''::[RULE_LIST(*#rules#,<>)]RULE_LIST(*rule) -> [ **[ *#rules# ";"] [ *rule ";"]]; ''::RULES(*rule_list) -> [ "rules" *rule_list <0,1> "end rules"]; ''::BINDING(*id,*ml_fun) -> [ [ *id "="] *ml_fun]; ''::[BINDING_LIST(*bindings,<>)]BINDING_LIST(*binding) -> [ **[ *bindings ";"] [ *binding ";"]]; ''::DECLARS(*binding_list) -> [ "declarations" *binding_list <0,1> "end declarations"]; ''::ABBREVS(*binding_list) -> [ "abbreviations" *binding_list <0,1> "end abbreviations"]; ''::BODY(**x) -> [ **x]; ''::PP(*id,*body) -> [ [ "prettyprinter" *id "="] *body <0,2> "end prettyprinter"]; end rules end prettyprinter %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_parser/syntax.ml0000640000212700021270000014036305071610126020617 0ustar cammcamm% syntax.ml % %-----------------------------------------------------------------------------% begin_section syntax;; % The constant symbols of the pretty-printing language. % let PP_quotes = [`'`,`'`; `"`,`"`; `{`,`}`; `#`,`#`; `%`,`%`];; let PP_keywords = [`prettyprinter`;`rules`;`declarations`;`abbreviations`; `with`;`end`;`where`;`if`;`then`;`else`; `h`;`v`;`hv`;`hov`];; let PP_specials = [`+`;`-`;`*`;`**`;`***`;`,`;`;`;`:`;`::`;`=`;`:=`;`->`;`..`; `(`;`)`;`**[`;`[`;`]`;`<`;`>`;`<<`;`>>`;`|`];; % Error handlers. % let syntax_error f port c exp x = % : ((string -> string) -> string -> string -> string -> lex_symb -> ?) % let got = case x of (Lex_spec s) . (`the special symbol \``^s^`'`) | (Lex_num s) . (`the number \``^s^`'`) | (Lex_id s) . (`the identifier \``^s^`'`) | (Lex_block ((start,end),sl)) . (start^(hd sl ? ``)^`...`^end) in tty_write (`Syntax_error: expected `^exp^`, got `^got^` ...`^`\L`); tty_write c; copy_chars 200 f port tty_write; tty_write `\L`; tty_write (`... parse failed.`^`\L`); failwith `syntax_error`;; let general_error f port c exp got = % : ((string -> string) -> string -> string -> string -> string -> ?) % tty_write (`Syntax error: expected `^exp^`, got `^got^` ...`^`\L`); tty_write c; copy_chars 200 f port tty_write; tty_write `\L`; tty_write (`... parse failed.`^`\L`); failwith `general_error`;; % Symbol reader for pretty-printing language. % % A string enclosed within sharp signs (#) is made into an identifier, % % provided it does not contain line-breaks. % % A string enclosed within percent signs is treated as a comment, % % i.e. it is discarded. % letrec read_PP_symb f port c = % : ((string -> string) -> string -> string -> (lex_symb # string)) % let (ls',c') = read_symb f port PP_quotes PP_keywords PP_specials c in case ls' of (Lex_block ((`#`,`#`),sl)) . (if (length sl) = 1 then (Lex_id (hd sl),c') else general_error f port c `\`#'` `a line break`) | (Lex_block ((`%`,`%`),_)) . (read_PP_symb f port c') | (_) . (ls',c');; % The remaining functions in this file all have the same form. They make up % % a recursive descent parser for the pretty-printing language. % % Each function has three arguments. The first two represent the input % % port. When `f' is applied to `port' the next character is obtained. % % The third argument is a pair. The first element of the pair is the next % % symbol to be processed. The second element is the character immediately % % following the symbol in the input. % % The result of the function is a triple consisting of the parse-tree % % built by the function, the next symbol to be processed, and the character % % which follows the next symbol. % let read_PP_number f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_num s) . (Print_node (`NUM`,[Print_node (s,[])]), (read_PP_symb f port c)) | (_) . (syntax_error f port c `a number` ls);; let read_PP_integer f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `-`) . (let (pt,next) = read_PP_number f port (read_PP_symb f port c) in (Print_node (`NEG`,[pt]), next)) | (_) . (read_PP_number f port (ls,c));; let read_PP_string f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_block ((`'`,`'`),[s])) . (Print_node (`STRING`,[Print_node (s,[])]), (read_PP_symb f port c)) | (_) . (syntax_error f port c `a string` ls);; let read_PP_terminal f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_block ((`"`,`"`),[s])) . (Print_node (`TERMINAL`,[Print_node (s,[])]), (read_PP_symb f port c)) | (_) . (syntax_error f port c `a terminal` ls);; let read_PP_ML_function f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_block ((`{`,`}`),sl)) . (Print_node (`ML_FUN`,map (\s. Print_node (s,[])) sl), (read_PP_symb f port c)) | (_) . (syntax_error f port c `an ML function` ls);; letrec read_PP_identifier f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_id s) . (Print_node (`ID`,[Print_node (s,[])]), (read_PP_symb f port c)) | (_) . (syntax_error f port c `an identifier` ls);; let read_PP_name_metavar f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `***`) . (case (read_PP_symb f port c) of (Lex_id s,c') . (let (pt,next) = read_PP_identifier f port (Lex_id s,c') in (Print_node (`NAME_META`,[pt]), next)) | (next) . (Print_node (`NAME_META`,[]), next)) | (_) . (syntax_error f port c `\`***'` ls);; let read_PP_child_metavar f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `*`) . (case (read_PP_symb f port c) of (Lex_id s,c') . (let (pt,next) = read_PP_identifier f port (Lex_id s,c') in (Print_node (`CHILD_META`,[pt]), next)) | (next) . (Print_node (`CHILD_META`,[]), next)) | (_) . (syntax_error f port c `\`*'` ls);; let read_PP_children_metavar f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `**`) . (case (read_PP_symb f port c) of (Lex_id s,c') . (let (pt,next) = read_PP_identifier f port (Lex_id s,c') in (Print_node (`CHILDREN_META`,[pt]), next)) | (next) . (Print_node (`CHILDREN_META`,[]), next)) | (_) . (syntax_error f port c `\`**'` ls);; letrec read_PP_metavar_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = case ls of (Lex_spec `*`) . (read_PP_child_metavar f port (ls,c)) | (Lex_spec `**`) . (read_PP_children_metavar f port (ls,c)) | (Lex_spec `***`) . (read_PP_name_metavar f port (ls,c)) | (_) . (syntax_error f port c `a metavariable` ls) in case ls' of (Lex_spec `;`) . (let (pt',next) = read_PP_metavar_list f port (read_PP_symb f port c') in (Print_node (`METAVAR_LIST`,[pt;pt']), next)) | (_) . (Print_node (`METAVAR_LIST`,[pt]), ls',c');; let read_PP_min f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = read_PP_number f port (ls,c) in (Print_node (`MIN`,[pt]), next);; let read_PP_max f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = read_PP_number f port (ls,c) in (Print_node (`MAX`,[pt]), next);; let read_PP_loop_range f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `..`) . (let (pt,next) = read_PP_max f port (read_PP_symb f port c) in (Print_node (`LOOP_RANGE`,[pt]), next)) | (_) . (let (pt,ls',c') = read_PP_min f port (ls,c) in case ls' of (Lex_spec `..`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_num _) . (let (pt',next) = read_PP_max f port (ls'',c'') in (Print_node (`LOOP_RANGE`,[pt;pt']), next)) | (_) . (Print_node (`LOOP_RANGE`,[pt]), ls'',c'')) | (_) . (syntax_error f port c' `\`..'` ls'));; let read_PP_loop_link f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `<`) . (let (ls',c') = read_PP_symb f port c in case ls' of (Lex_spec `>`) . (Print_node (`LOOP_LINK`,[]), (read_PP_symb f port c')) | (Lex_num _) . (let (pt,ls'',c'') = read_PP_loop_range f port (ls',c') in case ls'' of (Lex_spec `>`) . (Print_node (`LOOP_LINK`,[pt]), (read_PP_symb f port c'')) | (Lex_spec `:`) . (let (pt',ls''',c''') = read_PP_metavar_list f port (read_PP_symb f port c'') in case ls''' of (Lex_spec `>`) . (Print_node (`LOOP_LINK`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `\`>'` ls''')) | (_) . (syntax_error f port c'' `\`>' or \`:'` ls'')) | (Lex_spec `..`) . (let (pt,ls'',c'') = read_PP_loop_range f port (ls',c') in case ls'' of (Lex_spec `>`) . (Print_node (`LOOP_LINK`,[pt]), (read_PP_symb f port c'')) | (Lex_spec `:`) . (let (pt',ls''',c''') = read_PP_metavar_list f port (read_PP_symb f port c'') in case ls''' of (Lex_spec `>`) . (Print_node (`LOOP_LINK`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `\`>'` ls''')) | (_) . (syntax_error f port c'' `\`>' or \`:'` ls'')) | (_) . (let (pt,ls'',c'') = read_PP_metavar_list f port (ls',c') in case ls'' of (Lex_spec `>`) . (Print_node (`LOOP_LINK`,[pt]), (read_PP_symb f port c'')) | (_) . (syntax_error f port c'' `\`>'` ls''))) | (_) . (syntax_error f port c `\`<'` ls);; let read_PP_label f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `|`) . (let (pt,ls',c') = read_PP_child_metavar f port (read_PP_symb f port c) in case ls' of (Lex_spec `|`) . (Print_node (`LABEL`,[pt]), (read_PP_symb f port c')) | (_) . (syntax_error f port c' `\`|'` ls')) | (_) . (syntax_error f port c `\`|'` ls);; let read_PP_node_name f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = case ls of (Lex_spec `***`) . (read_PP_name_metavar f port (ls,c)) | (_) . (read_PP_identifier f port (ls,c)) in (Print_node (`NODE_NAME`,[pt]), next);; letrec read_PP_child f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `**`) . (let (pt,next) = read_PP_children_metavar f port (ls,c) in (Print_node (`CHILD`,[pt]),next)) | (_) . (let (pt,next) = read_PP_pattern_tree f port (ls,c) in (Print_node (`CHILD`,[pt]),next)) and read_PP_child_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_child f port (ls,c) in case ls' of (Lex_spec `,`) . (let (pt',next) = read_PP_child_list f port (read_PP_symb f port c') in (Print_node (`CHILD_LIST`,[pt;pt']), next)) | (_) . (Print_node (`CHILD_LIST`,[pt]), ls',c') and read_PP_pattern_tree f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % if ((ls = (Lex_spec `[`)) or (ls = (Lex_spec `<`))) then (let (pt,ls',c') = case ls of (Lex_spec `[`) . (read_PP_loop f port (ls,c)) | (_) . (read_PP_loop_link f port (ls,c)) in case ls' of (Lex_spec `]`) . (Print_node (`PATT_TREE`,[pt]), ls',c') | (Lex_spec `,`) . (Print_node (`PATT_TREE`,[pt]), ls',c') | (Lex_spec `)`) . (Print_node (`PATT_TREE`,[pt]), ls',c') | (Lex_spec `->`) . (Print_node (`PATT_TREE`,[pt]), ls',c') | (Lex_spec `where`) . (Print_node (`PATT_TREE`,[pt]), ls',c') | (_) . (let (pt',next) = read_PP_pattern_tree f port (ls',c') in (Print_node (`PATT_TREE`,[pt;pt']),next))) if (ls = (Lex_spec `|`)) then (let (pt,ls',c') = read_PP_label f port (ls,c) in let (pt',next) = read_PP_pattern_tree f port (ls',c') in (Print_node (`PATT_TREE`,[pt;pt']), next)) if (ls = (Lex_spec `*`)) then (let (pt,next) = read_PP_child_metavar f port (ls,c) in (Print_node (`PATT_TREE`,[pt]), next)) else (let (pt,ls',c') = read_PP_node_name f port (ls,c) in case ls' of (Lex_spec `(`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `)`) . (Print_node (`PATT_TREE`,[pt]), (read_PP_symb f port c'')) | (_) . (let (pt',ls''',c''') = read_PP_child_list f port (ls'',c'') in case ls''' of (Lex_spec `)`) . (Print_node (`PATT_TREE`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `\`)'` ls'''))) | (_) . (syntax_error f port c' `\`('` ls')) and read_PP_loop f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `[`) . (let (pt,ls',c') = read_PP_pattern_tree f port (read_PP_symb f port c) in case ls' of (Lex_spec `]`) . (Print_node (`LOOP`,[pt]), (read_PP_symb f port c')) | (_) . (syntax_error f port c' `\`]'` ls')) | (_) . (syntax_error f port c `\`['` ls);; let read_PP_test f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = case ls of (Lex_block ((`{`,`}`),_)) . (read_PP_ML_function f port (ls,c)) | (_) . (read_PP_identifier f port (ls,c)) in (Print_node (`TEST`,[pt]),next);; let read_PP_pattern f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_string f port (ls,c) in case ls' of (Lex_spec `::`) . (let (pt',ls'',c'') = read_PP_pattern_tree f port (read_PP_symb f port c') in case ls'' of (Lex_spec `where`) . (let (pt'',next) = read_PP_test f port (read_PP_symb f port c'') in (Print_node (`PATTERN`,[pt;pt';pt'']),next)) | (_) . (Print_node (`PATTERN`,[pt;pt']), ls'',c'')) | (_) . (syntax_error f port c' `\`::'` ls');; let read_PP_transformation f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = case ls of (Lex_block ((`{`,`}`),_)) . (read_PP_ML_function f port (ls,c)) | (_) . (read_PP_identifier f port (ls,c)) in (Print_node (`TRANSFORM`,[pt]),next);; let read_PP_p_special f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = case ls of (Lex_spec `*`) . (read_PP_child_metavar f port (ls,c)) | (Lex_spec `**`) . (read_PP_children_metavar f port (ls,c)) | (Lex_spec `***`) . (read_PP_name_metavar f port (ls,c)) | (_) . (syntax_error f port c `a metavariable` ls) in case ls' of (Lex_spec `=`) . (let (pt',next) = read_PP_transformation f port (read_PP_symb f port c') in (Print_node (`P_SPECIAL`,[pt;pt']), next)) | (_) . (syntax_error f port c `\`='` ls');; letrec read_PP_p_special_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_p_special f port (ls,c) in case ls' of (Lex_spec `;`) . (let (pt',next) = read_PP_p_special_list f port (read_PP_symb f port c') in (Print_node (`P_SPECIAL_LIST`,[pt;pt']), next)) | (_) . (Print_node (`P_SPECIAL_LIST`,[pt]), ls',c');; let read_PP_int_expression f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = case ls of (Lex_block ((`{`,`}`),_)) . (read_PP_ML_function f port (ls,c)) | (Lex_id _) . (read_PP_identifier f port (ls,c)) | (_) . (read_PP_integer f port (ls,c)) in (Print_node (`INT_EXP`,[pt]),next);; let read_PP_assignment f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_identifier f port (ls,c) in case ls' of (Lex_spec `:=`) . (let (pt',next) = read_PP_int_expression f port (read_PP_symb f port c') in (Print_node (`ASSIGN`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`:='` ls');; letrec read_PP_assignments f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_assignment f port (ls,c) in case ls' of (Lex_spec `;`) . (let (pt',next) = read_PP_assignments f port (read_PP_symb f port c') in (Print_node (`ASSIGNMENTS`,[pt;pt']), next)) | (_) . (Print_node (`ASSIGNMENTS`,[pt]), ls',c');; let read_PP_fun_subcall f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `***`) . (let (pt,next) = read_PP_name_metavar f port (ls,c) in (Print_node (`F_SUBCALL`,[pt]),next)) | (Lex_spec `*`) . (let (pt,next) = read_PP_child_metavar f port (ls,c) in (Print_node (`F_SUBCALL`,[pt]),next)) | (Lex_spec `**`) . (let (pt,next) = read_PP_children_metavar f port (ls,c) in (Print_node (`F_SUBCALL`,[pt]),next)) | (_) . (let (pt,ls',c') = read_PP_transformation f port (ls,c) in case ls' of (Lex_spec `(`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `***`) . (let (pt',ls''',c''') = read_PP_name_metavar f port (ls'',c'') in case ls''' of (Lex_spec `)`) . (Print_node (`F_SUBCALL`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `\`)'` ls''')) | (Lex_spec `*`) . (let (pt',ls''',c''') = read_PP_child_metavar f port (ls'',c'') in case ls''' of (Lex_spec `)`) . (Print_node (`F_SUBCALL`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `\`)'` ls''')) | (Lex_spec `**`) . (let (pt',ls''',c''') = read_PP_children_metavar f port (ls'',c'') in case ls''' of (Lex_spec `)`) . (Print_node (`F_SUBCALL`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `\`)'` ls''')) | (_) . (syntax_error f port c'' `a metavariable` ls'')) | (_) . (syntax_error f port c' `\`('` ls'));; let read_PP_context_subcall f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_block ((`'`,`'`),_)) . (let (pt,ls',c') = read_PP_string f port (ls,c) in case ls' of (Lex_spec `::`) . (let (pt',next) = read_PP_fun_subcall f port (read_PP_symb f port c') in (Print_node (`C_SUBCALL`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`::'` ls')) | (_) . (let (pt,next) = read_PP_fun_subcall f port (ls,c) in (Print_node (`C_SUBCALL`,[pt]),next));; let read_PP_leaf_or_subcall f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_context_subcall f port (ls,c) in case ls' of (Lex_spec `with`) . (let (pt',ls'',c'') = read_PP_assignments f port (read_PP_symb f port c') in case ls'' of (Lex_spec `end`) . (let (ls''',c''') = read_PP_symb f port c'' in case ls''' of (Lex_spec `with`) . (Print_node (`LEAF_OR_SUBCALL`,[pt;pt']), (read_PP_symb f port c''')) | (_) . (syntax_error f port c''' `with` ls''')) | (_) . (syntax_error f port c'' `end with` ls'')) | (_) . (Print_node (`LEAF_OR_SUBCALL`,[pt]), ls',c');; let read_PP_indent f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `+`) . (let (pt,next) = read_PP_integer f port (read_PP_symb f port c) in (Print_node (`INC`,[pt]), next)) | (_) . (read_PP_integer f port (ls,c));; let read_PP_h_params f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = read_PP_number f port (ls,c) in (Print_node (`H_PARAMS`,[pt]),next);; let read_PP_v_params f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_indent f port (ls,c) in case ls' of (Lex_spec `,`) . (let (pt',next) = read_PP_number f port (read_PP_symb f port c') in (Print_node (`V_PARAMS`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`,'` ls');; let read_PP_hv_params f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_number f port (ls,c) in case ls' of (Lex_spec `,`) . (let (pt',ls'',c'') = read_PP_indent f port (read_PP_symb f port c') in case ls'' of (Lex_spec `,`) . (let (pt'',next) = read_PP_number f port (read_PP_symb f port c'') in (Print_node (`HV_PARAMS`,[pt;pt';pt'']),next)) | (_) . (syntax_error f port c'' `\`,'` ls'')) | (_) . (syntax_error f port c' `\`,'` ls');; let read_PP_hov_params f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_number f port (ls,c) in case ls' of (Lex_spec `,`) . (let (pt',ls'',c'') = read_PP_indent f port (read_PP_symb f port c') in case ls'' of (Lex_spec `,`) . (let (pt'',next) = read_PP_number f port (read_PP_symb f port c'') in (Print_node (`HOV_PARAMS`,[pt;pt';pt'']),next)) | (_) . (syntax_error f port c'' `\`,'` ls'')) | (_) . (syntax_error f port c' `\`,'` ls');; let read_PP_h_box f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `h`) . (let (pt,next) = read_PP_h_params f port (read_PP_symb f port c) in (Print_node (`H_BOX`,[pt]),next)) | (_) . (syntax_error f port c `\`h'` ls);; let read_PP_v_box f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `v`) . (let (pt,next) = read_PP_v_params f port (read_PP_symb f port c) in (Print_node (`V_BOX`,[pt]),next)) | (_) . (syntax_error f port c `\`v'` ls);; let read_PP_hv_box f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `hv`) . (let (pt,next) = read_PP_hv_params f port (read_PP_symb f port c) in (Print_node (`HV_BOX`,[pt]),next)) | (_) . (syntax_error f port c `\`hv'` ls);; let read_PP_hov_box f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `hov`) . (let (pt,next) = read_PP_hov_params f port (read_PP_symb f port c) in (Print_node (`HOV_BOX`,[pt]),next)) | (_) . (syntax_error f port c `\`hov'` ls);; letrec read_PP_object f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,next) = case ls of (Lex_spec `if`) . (read_PP_format f port (ls,c)) | (Lex_spec `[`) . (read_PP_format f port (ls,c)) | (Lex_spec `**[`) . (read_PP_expand f port (ls,c)) | (Lex_block ((`"`,`"`),_)) . (read_PP_terminal f port (ls,c)) | (Lex_block ((`'`,`'`),_)) . (read_PP_leaf_or_subcall f port (ls,c)) | (_) . (read_PP_leaf_or_subcall f port (ls,c)) in (Print_node (`OBJECT`,[pt]),next) and read_PP_h_object f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `<`) . (let (pt,ls',c') = read_PP_h_params f port (read_PP_symb f port c) in case ls' of (Lex_spec `>`) . (let (pt',next) = read_PP_object f port (read_PP_symb f port c') in (Print_node (`H_OBJECT`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`>'` ls')) | (_) . (let (pt,next) = read_PP_object f port (ls,c) in (Print_node (`H_OBJECT`,[pt]),next)) and read_PP_v_object f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `<`) . (let (pt,ls',c') = read_PP_v_params f port (read_PP_symb f port c) in case ls' of (Lex_spec `>`) . (let (pt',next) = read_PP_object f port (read_PP_symb f port c') in (Print_node (`V_OBJECT`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`>'` ls')) | (_) . (let (pt,next) = read_PP_object f port (ls,c) in (Print_node (`V_OBJECT`,[pt]),next)) and read_PP_hv_object f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `<`) . (let (pt,ls',c') = read_PP_hv_params f port (read_PP_symb f port c) in case ls' of (Lex_spec `>`) . (let (pt',next) = read_PP_object f port (read_PP_symb f port c') in (Print_node (`HV_OBJECT`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`>'` ls')) | (_) . (let (pt,next) = read_PP_object f port (ls,c) in (Print_node (`HV_OBJECT`,[pt]),next)) and read_PP_hov_object f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `<`) . (let (pt,ls',c') = read_PP_hov_params f port (read_PP_symb f port c) in case ls' of (Lex_spec `>`) . (let (pt',next) = read_PP_object f port (read_PP_symb f port c') in (Print_node (`HOV_OBJECT`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`>'` ls')) | (_) . (let (pt,next) = read_PP_object f port (ls,c) in (Print_node (`HOV_OBJECT`,[pt]),next)) and read_PP_h_object_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_h_object f port (ls,c) in case ls' of (Lex_spec `]`) . (Print_node (`H_OBJECT_LIST`,[pt]), ls',c') | (_) . (let (pt',ls'',c'') = read_PP_h_object_list f port (ls',c') in (Print_node (`H_OBJECT_LIST`,[pt;pt']), ls'',c'')) and read_PP_v_object_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_v_object f port (ls,c) in case ls' of (Lex_spec `]`) . (Print_node (`V_OBJECT_LIST`,[pt]), ls',c') | (_) . (let (pt',ls'',c'') = read_PP_v_object_list f port (ls',c') in (Print_node (`V_OBJECT_LIST`,[pt;pt']), ls'',c'')) and read_PP_hv_object_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_hv_object f port (ls,c) in case ls' of (Lex_spec `]`) . (Print_node (`HV_OBJECT_LIST`,[pt]), ls',c') | (_) . (let (pt',ls'',c'') = read_PP_hv_object_list f port (ls',c') in (Print_node (`HV_OBJECT_LIST`,[pt;pt']), ls'',c'')) and read_PP_hov_object_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_hov_object f port (ls,c) in case ls' of (Lex_spec `]`) . (Print_node (`HOV_OBJECT_LIST`,[pt]), ls',c') | (_) . (let (pt',ls'',c'') = read_PP_hov_object_list f port (ls',c') in (Print_node (`HOV_OBJECT_LIST`,[pt;pt']), ls'',c'')) and read_PP_box_spec f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `<`) . (let (ls',c') = read_PP_symb f port c in case ls' of (Lex_spec `h`) . (let (pt,ls'',c'') = read_PP_h_box f port (ls',c') in case ls'' of (Lex_spec `>`) . (let (pt',next) = read_PP_h_object_list f port (read_PP_symb f port c'') in (Print_node (`BOX_SPEC`,[pt;pt']),next)) | (_) . (syntax_error f port c'' `\`>'` ls'')) | (Lex_spec `v`) . (let (pt,ls'',c'') = read_PP_v_box f port (ls',c') in case ls'' of (Lex_spec `>`) . (let (pt',next) = read_PP_v_object_list f port (read_PP_symb f port c'') in (Print_node (`BOX_SPEC`,[pt;pt']),next)) | (_) . (syntax_error f port c'' `\`>'` ls'')) | (Lex_spec `hv`) . (let (pt,ls'',c'') = read_PP_hv_box f port (ls',c') in case ls'' of (Lex_spec `>`) . (let (pt',next) = read_PP_hv_object_list f port (read_PP_symb f port c'') in (Print_node (`BOX_SPEC`,[pt;pt']),next)) | (_) . (syntax_error f port c'' `\`>'` ls'')) | (Lex_spec `hov`) . (let (pt,ls'',c'') = read_PP_hov_box f port (ls',c') in case ls'' of (Lex_spec `>`) . (let (pt',next) = read_PP_hov_object_list f port (read_PP_symb f port c'') in (Print_node (`BOX_SPEC`,[pt;pt']),next)) | (_) . (syntax_error f port c'' `\`>'` ls'')) | (_) . (syntax_error f port c' `a box type` ls')) | (_) . (syntax_error f port c `\`<'` ls) and read_PP_expand f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `**[`) . (let (pt,ls',c') = read_PP_box_spec f port (read_PP_symb f port c) in case ls' of (Lex_spec `]`) . (Print_node (`EXPAND`,[pt]), (read_PP_symb f port c')) | (_) . (syntax_error f port c' `\`]'` ls')) | (_) . (syntax_error f port c `\`**['` ls) and read_PP_format f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `[`) . (let (ls',c') = read_PP_symb f port c in case ls' of (Lex_spec `]`) . (Print_node (`FORMAT`,[]), (read_PP_symb f port c')) | (_) . (let (pt,ls'',c'') = read_PP_box_spec f port (ls',c') in case ls'' of (Lex_spec `]`) . (Print_node (`FORMAT`,[pt]), (read_PP_symb f port c'')) | (_) . (syntax_error f port c'' `\`]'` ls''))) | (Lex_spec `if`) . (let (pt,ls',c') = read_PP_test f port (read_PP_symb f port c) in case ls' of (Lex_spec `then`) . (let (pt',ls'',c'') = read_PP_format f port (read_PP_symb f port c') in case ls'' of (Lex_spec `else`) . (let (pt'',next) = read_PP_format f port (read_PP_symb f port c'') in (Print_node (`FORMAT`,[pt;pt';pt'']),next)) | (_) . (syntax_error f port c'' `\`else'` ls'')) | (_) . (syntax_error f port c' `\`then'` ls')) | (_) . (syntax_error f port c `a format` ls);; let read_PP_rule f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_pattern f port (ls,c) in case ls' of (Lex_spec `->`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `<<`) . (let (pt',ls''',c''') = read_PP_p_special_list f port (read_PP_symb f port c'') in case ls''' of (Lex_spec `>>`) . (let (pt'',next) = read_PP_format f port (read_PP_symb f port c''') in (Print_node (`RULE`,[pt;pt';pt'']), next)) | (_) . (syntax_error f port c''' `\`>>'` ls''')) | (_) . (let (pt',next) = read_PP_format f port (ls'',c'') in (Print_node (`RULE`,[pt;pt']),next))) | (_) . (syntax_error f port c' `\`->'` ls');; letrec read_PP_rule_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_rule f port (ls,c) in case ls' of (Lex_spec `;`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `end`) . (Print_node (`RULE_LIST`,[pt]), ls'',c'') | (_) . (let (pt',ls''',c''') = read_PP_rule_list f port (ls'',c'') in (Print_node (`RULE_LIST`,[pt;pt']), ls''',c'''))) | (_) . (syntax_error f port c' `\`;'` ls');; let read_PP_rules f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `rules`) . (let (pt,ls',c') = read_PP_rule_list f port (read_PP_symb f port c) in case ls' of (Lex_spec `end`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `rules`) . (Print_node (`RULES`,[pt]), read_PP_symb f port c'') | (_) . (syntax_error f port c'' `the keyword \`rules'` ls'')) | (_) . (syntax_error f port c' `the keywords \`end rules'` ls')) | (_) . (syntax_error f port c `the keyword \`rules'` ls);; let read_PP_binding f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_identifier f port (ls,c) in case ls' of (Lex_spec `=`) . (let (pt',next) = read_PP_ML_function f port (read_PP_symb f port c') in (Print_node (`BINDING`,[pt;pt']),next)) | (_) . (syntax_error f port c' `\`='` ls');; letrec read_PP_binding_list f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % let (pt,ls',c') = read_PP_binding f port (ls,c) in case ls' of (Lex_spec `;`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `end`) . (Print_node (`BINDING_LIST`,[pt]), ls'',c'') | (_) . (let (pt',next) = read_PP_binding_list f port (ls'',c'') in (Print_node (`BINDING_LIST`,[pt;pt']),next))) | (_) . (syntax_error f port c' `\`;'` ls');; let read_PP_declarations f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `declarations`) . (let (pt,ls',c') = read_PP_binding_list f port (read_PP_symb f port c) in case ls' of (Lex_spec `end`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `declarations`) . (Print_node (`DECLARS`,[pt]), read_PP_symb f port c'') | (_) . (syntax_error f port c'' `the keyword \`declarations'` ls'')) | (_) . (syntax_error f port c' `the keywords \`end declarations'` ls')) | (_) . (syntax_error f port c `the keyword \`declarations'` ls);; let read_PP_abbreviations f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `abbreviations`) . (let (pt,ls',c') = read_PP_binding_list f port (read_PP_symb f port c) in case ls' of (Lex_spec `end`) . (let (ls'',c'') = read_PP_symb f port c' in case ls'' of (Lex_spec `abbreviations`) . (Print_node (`ABBREVS`,[pt]), read_PP_symb f port c'') | (_) . (syntax_error f port c'' `the keyword \`abbreviations'` ls'')) | (_) . (syntax_error f port c' `the keywords \`end abbreviations'` ls')) | (_) . (syntax_error f port c `the keyword \`abbreviations'` ls);; let read_PP_body f port (ls,c) = % : ((string -> string) -> string -> (lex_symb # string) -> % % (print_tree # lex_symb # string)) % case ls of (Lex_spec `declarations`) . (let (pt,ls',c') = read_PP_declarations f port (ls,c) in case ls' of (Lex_spec `abbreviations`) . (let (pt',ls'',c'') = read_PP_abbreviations f port (ls',c') in let (pt'',next) = read_PP_rules f port (ls'',c'') in (Print_node (`BODY`,[pt;pt';pt'']),next)) | (_) . (let (pt',next) = read_PP_rules f port (ls',c') in (Print_node (`BODY`,[pt;pt']),next))) | (Lex_spec `abbreviations`) . (let (pt,ls',c') = read_PP_abbreviations f port (ls,c) in let (pt',next) = read_PP_rules f port (ls',c') in (Print_node (`BODY`,[pt;pt']),next)) | (_) . (let (pt,next) = read_PP_rules f port (ls,c) in (Print_node (`BODY`,[pt]),next));; % `read_PP' differs from the preceding functions. It is the top-level % % parsing function, and so does not require a next symbol and next % % character on input. It also does not need to provide them as part of the % % result. Note that if the terminating keyword `prettyprinter' in the % % source file is not followed by at least one character, the parser will % % think that the input was exhausted before completion, due to it reading % % a character for lookahead. % let read_PP f (port:string) = % : ((string -> string) -> string -> print_tree) % let (ls,c) = read_PP_symb f port ` ` in case ls of (Lex_spec `prettyprinter`) . (let (pt,ls',c') = read_PP_identifier f port (read_PP_symb f port c) in case ls' of (Lex_spec `=`) . (let (pt',ls'',c'') = read_PP_body f port (read_PP_symb f port c') in case ls'' of (Lex_spec `end`) . (let (ls''',c''') = read_PP_symb f port c'' in case ls''' of (Lex_spec `prettyprinter`) . (Print_node (`PP`,[pt;pt'])) | (_) . (syntax_error f port c''' `the keyword \`prettyprinter'` ls''')) | (_) . (syntax_error f port c'' `the keywords \`end prettyprinter'` ls'')) | (_) . (syntax_error f port c' `\`='` ls')) | (_) . (syntax_error f port c `the keyword \`prettyprinter'` ls);; read_PP;; end_section syntax;; let read_PP = it;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/0000750000212700021270000000000005533117217016223 5ustar cammcammhol88-2.02.19940316/Library/prettyp/PP_hol/PP_hol.ml0000640000212700021270000001113605071610231017730 0ustar cammcamm%=============================================================================% % % % A General-Purpose % % Pretty-Printer % % for the HOL System % % % %-----------------------------------------------------------------------------% % % % Filename: PP_hol.ml (A pretty-printer for HOL types, terms, and theorems) % % Version: 1.1 % % Author: Richard J. Boulton % % Date: 5th August 1991 % % % % Special instructions: Requires PP_printer.ml to be pre-loaded. % % % %-----------------------------------------------------------------------------% % % % Load sub-files in the following order: % % % % hol_trees.ml % % precedence.ml % % hol_type_pp.ml % % hol_term_pp.ml % % hol_thm_pp.ml % % new_printers.ml % % link_to_hol.ml % % % %-----------------------------------------------------------------------------% % % % Changes history: % % % % Version 0.0 (pre-release), 23rd March 1990 % % % % The parse-tree representations of types and terms used nodes labelled % % with `NAME' for constant and variable names. It is sufficient to use % % simply the name of the variable or constant concerned. The nodes % % labelled `NAME' have therefore been stripped away. % % % % `assignable_print_term' is now set to the new term printer so that % % goals are printed using the new printer. % % % % Version 1.0, 11th December 1990 % % % % The pretty-printing rules for terms have been modified so that long % % lists of bound variables are broken across lines if necessary. In the % % previous version the list of variables could not be split between % % lines. % % % % Version 1.1, 5th August 1991 % % % %=============================================================================% %-----------------------------------------------------------------------------% % Load the compiled code into ml. % %-----------------------------------------------------------------------------% let path st = library_pathname() ^ `/prettyp/PP_hol/` ^ st and flag = get_flag_value `print_lib` in map (\st. load(path st, flag)) [`hol_trees`; `precedence`; `hol_type_pp`; `hol_term_pp`; `hol_thm_pp`; `new_printers`; `link_to_hol`];; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/hol_term.pp0000640000212700021270000005025605071610232020376 0ustar cammcamm% hol_term.pp % %-----------------------------------------------------------------------------% % A pretty-printer for HOL terms % % Should be used along with a printer for HOL types % prettyprinter hol_term = declarations % Function for detecting associative operators % is_right_assoc = { \meta. meta is_a_member_of [`/\\`;`\\/`;`o`;`+`;`*`;`EXP`] }; % Function for detecting infix operators % is_an_infix = {\meta. apply1 is_infix (bound_name meta)}; % Function for detecting binders % is_a_binder = {\meta. apply1 is_binder (bound_name meta)}; % Functions for handling the precedence of terms % % Uses the function `term_prec' defined in `precedence.ml' % prec = {bound_number `prec`}; prec_of = {\meta. apply1 term_prec (bound_name meta)}; prec_of_const = {\symb. apply0 (term_prec symb)}; prec_test_meta = {\meta. apply2 (curry $<) (prec_of meta) prec}; prec_test_const = {\symb. apply2 (curry $<) (prec_of_const symb) prec}; end declarations abbreviations % Function to prefix an operator with a `$' if it is an infix, a binder % % or ~. % prefix = { \symb. if ((is_infix symb) or (is_binder symb) or (symb = `~`)) then (`$` ^ symb) else symb }; % Function to reverse a list of sub-trees bound to a metavariable % rev = {rev}; % `min_term_prec' and `max_term_prec' are defined in the file % % `precedence.ml'. % min_prec = {apply0 min_term_prec}; max_prec = {apply0 max_term_prec}; end abbreviations rules % The constant `NIL' is printed as `[]' % 'term'::CONST(NIL(),**) -> [ "[]"]; % Variables with no type information % 'term'::VAR(***var()) -> [ ***var]; % Variables with type information % % The node `type', used to label the sub-tree for the type, is stripped % % off before printing it. This assumes that rules exist for handling % % types in the context `term'. The `:' used to separate the variable % % name from its type is taken to have a precedence. This is used to % % determine whether or not to put parentheses around the variable/type % % unit. % 'term'::VAR(***var(),type(*type)) -> [ if {prec_test_const `:`} then [] else [ "("] [ ***var [ ":" *type]] if {prec_test_const `:`} then [] else [ ")"]]; % Constants are prefixed with `$' if infixes, binders or ~. Note that this % % pretty-printer contains many rules which have special actions for % % particular constants. These rules are set up to work whether or not type % % information is present. This is done by using ** to match the sub-tree % % containing the type information. ** can also match nothing, so it also % % works if the type information is not present. % % Constants with no type information % 'term'::CONST(***const()) -> [ prefix(***const)]; % Constants with type information % 'term'::CONST(***const(),type(*type)) -> [ if {prec_test_const `:`} then [] else [ "("] [ prefix(***const) [ ":" *type]] if {prec_test_const `:`} then [] else [ ")"]]; % Pairs. % % These are treated separately from other infixes because no space is to % % appear between the comma and the components of the pair. % % The rule actually deals with tuples represented by nested pairs. This % % prevents unnecessary bracketing. % 'term'::[COMB(COMB(CONST(***op(),**),*comps),<1..:***op>)]*comp where {`op` is_a_member_of [`,`]} -> [ if {prec_test_meta `op`} then [] else [ "("] [ **[ *comps with prec := {prec_of `op`} end with ***op] *comp with prec := {prec_of `op`} end with] if {prec_test_meta `op`} then [] else [ ")"]]; % Associative operators (assumed to be right associative) % % These are dealt with separately from other infixes so that unnecessary % % levels of parentheses can be omitted. To avoid ambiguities, the normal % % rule for infixes inserts parentheses when two operators of the same % % precedence occur together. If the two operators are the same, and the % % operator is associative, the ambiguity can only be in the structure, % % not in the meaning. % % The rule deals with not just two operators, but a whole chain of them. % % If the sub-expressions do not fit on one line, they appear vertically, % % each but the last being followed by the operator. % 'term'::[COMB(COMB(CONST(***op(),**),*args),<1..:***op>)]*arg where {is_right_assoc `op`} -> [ if {prec_test_meta `op`} then [] else [ "("] [ **[ *args with prec := {prec_of `op`} end with ***op] *arg with prec := {prec_of `op`} end with] if {prec_test_meta `op`} then [] else [ ")"]]; % Infixes. % % Note that rules which deal with more specialised infixes appear before % % this rule so as to have priority over it. % 'term'::COMB(COMB(CONST(***op(),**),*arg1),*arg2) where {is_an_infix `op`} -> [ if {prec_test_meta `op`} then [] else [ "("] [ [ *arg1 with prec := {prec_of `op`} end with ***op] *arg2 with prec := {prec_of `op`} end with] if {prec_test_meta `op`} then [] else [ ")"]]; % Rule for `~'. % % This is dealt with separately from other prefixes because no space is % % to appear between the `~' and its argument. % 'term'::COMB(CONST(***op(),**),*arg) where {`op` is_a_member_of [`~`]} -> [ if {prec_test_meta `op`} then [] else [ "("] ***op *arg with prec := {prec_of `op`} end with if {prec_test_meta `op`} then [] else [ ")"]]; % Binders. % % When a binder is applied to an abstraction, the name of the binder % % replaces the lambda. This rule deals with nested bindings, pulling % % the bound variables into a list. The name of the binder is displayed % % only once, followed by the bound variables separated by spaces, % % followed by a dot and the body of the binding. % % The rule assumes that terms containing bound variables as tuples % % have been converted from the form using `UNCURRY' to a form in which % % a tuple takes the place of a single bound variable. As a term, the % % latter form is not valid, but as a parse-tree it is fine. The rule % % implicitly handles tuples in place of variables, because it makes a % % recursive call to print the bound variables. Actually this is not % % quite true. To ensure that a tuple of variables is enclosed within % % parentheses, the recursive call has to be made with the precedence % % set to its lowest value (highest precedence). Single variables will % % not appear in parentheses because the rule for variables ignores the % % value of the precedence parameter. % 'term'::[COMB(CONST(***op(),**),ABS(*bvs,<1..:***op>))]*body where {is_a_binder `op`} -> [ if {prec_test_meta `op`} then [] else [ "("] [ [ ***op [ *bvs with prec := min_prec end with] "."] *body with prec := {prec_of `op`} end with] if {prec_test_meta `op`} then [] else [ ")"]]; % Abstractions. % % The lambda of abstractions is allocated a precedence. The rule is % % analogous to the one for binders. See the comments for that rule. % 'term'::[ABS(*bvs,<1..>)]*body -> [ if {prec_test_const `\\`} then [] else [ "("] [ [ "\" [ *bvs with prec := min_prec end with] "."] *body with prec := {prec_of_const `\\`} end with] if {prec_test_const `\\`} then [] else [ ")"]]; % Conditionals. % % All three sub-expressions are printed subject to the precedence of % % the `COND' constant. % 'term'::COMB(COMB(COMB(CONST(COND(),**),*cond),*x),*y) -> [ if {prec_test_const `COND`} then [] else [ "("] [ [ *cond with prec := {prec_of_const `COND`} end with "=>"] [ *x with prec := {prec_of_const `COND`} end with "|"] *y with prec := {prec_of_const `COND`} end with] if {prec_test_const `COND`} then [] else [ ")"]]; % Let statements % % The second rule is the main rule for `LET'. The pattern loops down a % % chain of LETs, stopping before the last one so that it can bind the % % sub-expressions for the last LET separately. It does this because the % % last LET is in fact the first one to appear in the textual % % representation (i.e. the LET chain is in reverse order) and the first % % textual LET is printed differently to the others (it begins with % % `let' whereas the others begin with `and'). % % At the end of the chain of LETs there is a chain of abstractions, the % % bound variables of which are the variables being declared. These are % % in the textual order. After the chain of abstractions, comes the `in' % % body (which is bound to the metavariable `*body'). % % For each LET in the chain there is a chain of abstractions. The bound % % variables are the arguments of the identifier being declared, and the % % body is the body of the declaration. The pattern binds the bodies to % % the metavariables `*letbodyl' and `*letbody'. Each of the abstraction % % chains is also bound (to either `*argsl' or `*args'). The individual % % arguments cannot be bound because lists of lists are flattened by the % % pretty-printer. An attempt to bind the individual arguments would % % result in one list of all the arguments to all of the LETs, with no % % indication of which arguments belong to which LET. The first of the % % two rules for pretty-printing let statements is used to print the % % chain of arguments for each LET. It throws away the body. It only % % matches in the context of having been called from the second `let' % % rule. It makes recursive calls to the printer to print the variables % % in the normal context for terms. % % If the number of argument sets is not the same as the number of % % variables seemingly being declared, the rule fails to match (this is % % done by the `where' clause). The LETs will then be printed as raw % % terms. The difference in numbers occurs if the `in' body is itself a % % lambda abstraction, and although this structure can be printed as a % % proper `let' statement, the standard HOL pretty-printer does not do % % it. % % As indicated previously, some of the bound lists are in reverse % % order. This is rectified before using the format to display the text. % % The identifiers declared in the let statement, and the names of their % % arguments are printed subject to the highest precedence (lowest % % numerical value). This ensures that they are enclosed within % % parentheses if they are in fact tuples rather than single variables. % % This assumes that instances of UNCURRY have been converted (see the % % comments for the rule for binders). % 'term_let'::[ABS(*args,<>)] -> [ 'term'::*args]; 'term'::[COMB(COMB(CONST(LET(),**),<>COMB(COMB(CONST(LET(),**),*),*)), |*argsl|[ABS(*,<>)]*letbodyl)] COMB(COMB(CONST(LET(),**),ABS(*bv,[ABS(*bvl,<>)]*body)), |*args|[ABS(*,<>)]*letbody) where { apply2 (\x y. length x = length y) (bound_children `bvl`) (bound_children `argsl`) } -> << **argsl = {new_children rev `argsl`}; **letbodyl = {new_children rev `letbodyl`} >> [ if {prec_test_const `LET`} then [] else [ "("] [ [ [ "let" *bv with prec := min_prec end with 'term_let'::*args with prec := min_prec end with "="] *letbody with prec := {prec_of_const `LET`} end with] **[ **[ "and" *bvl with prec := min_prec end with 'term_let'::**argsl with prec := min_prec end with "="] **letbodyl with prec := {prec_of_const `LET`} end with] [ "in" *body with prec := {prec_of_const `LET`} end with]] if {prec_test_const `LET`} then [] else [ ")"]]; % Lists (see also the rule for the constant `NIL') % % The elements of the list are obtained from a chain of applications of % % the constant `CONS'. The looping pattern used stops before the last % % CONS so that the last element can be bound separately. The last % % element has to be treated differently (it is not followed by a % % semi-colon). The rule works for lists of one or more elements. % % Lists are not explicitly assigned a precedence. They never need to be % % enclosed within parentheses because they are already enclosed within % % brackets. `;' is given the lowest possible precedence (highest % % numerical value), so the elements of a list never appear enclosed % % within parentheses. % 'term'::[COMB(COMB(CONST(CONS(),**),*elems),<>COMB(**))] COMB(COMB(CONST(CONS(),**),*elem),CONST(NIL(),**)) -> [ "[" [ **[ *elems with prec := max_prec end with ";"] *elem with prec := max_prec end with] "]"]; % Function applications. % % Every application not covered by a preceding rule is dealt with by % % this one. The precedence used is that of the null string. The % % precedence table assigns the highest precedence to anything it does % % not recognise. Thus user defined functions have the highest % % precedence. So, the arguments to the function appear in parentheses % % unless they are just identifiers. This rule deals with functions % % applied to one or more arguments. Note that the pattern binds the % % arguments in the reverse of the textual order, so the list has to % % be reversed before printing. % 'term'::[COMB(<1..>,*rands)]*rator -> [ if {prec_test_const ``} then [] else [ "("] [ *rator with prec := {prec_of_const ``} end with rev(*rands) with prec := {prec_of_const ``} end with] if {prec_test_const ``} then [] else [ ")"]]; % Wrap quotes around term when a term labelling node is encountered. % % Also, initialise precedence of parent constructor to be lowest % % precedence (highest numerical value) so that the term within the % % quotes is not enclosed within parentheses. This initialisation is also % % required to prevent an error occurring. % 'term'::term(*term) -> [ """" *term with prec := max_prec end with """"]; % If term to be printed is part of a thm, switch context and initialise % % precedence parameter. Call printer on whole tree. If the term passed % % on from the thm printer still contains its labelling node, the % % previous rule will display an unwanted set of quotes in the middle of % % the thm. % 'thm'::*term -> [ 'term'::*term with prec := max_prec end with]; end rules end prettyprinter %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/hol_thm.pp0000640000212700021270000000222005071610233020204 0ustar cammcamm% hol_thm.pp % %-----------------------------------------------------------------------------% % A pretty-printer for HOL theorems % % Should be used along with printers for HOL terms and types % prettyprinter hol_thm = rules % Hypothesis to be printed only as an abbreviation % 'thm'::dot() -> [ "."]; % Strip node labelling a term before printing it. This assumes that rules % % exist for handling terms in the context `thm'. % 'thm'::term(*term) -> [ *term]; % Theorem with abbreviated hypotheses % 'thm'::thm(*concl,dots(**dots)) -> [ [ **dots] "|-" *concl]; % Theorem with hypotheses in full (at least one hypothesis) % 'thm'::thm(*concl,hyp(**hyps,*hyp)) -> [ **[ **hyps ","] *hyp [ "|-" *concl]]; % Theorem with hypotheses in full (but no hypotheses present) % 'thm'::thm(*concl,hyp()) -> [ "|-" *concl]; end rules end prettyprinter %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/hol_trees.ml0000640000212700021270000002016605071610234020541 0ustar cammcamm% hol_trees.ml % %-----------------------------------------------------------------------------% % Datatype for specifying amount of type information to be included in % % parse-trees obtained from terms. % type type_selection = No_types | Hidden_types | Useful_types | All_types;; % Function to convert HOL type into the corresponding parse-tree. % % The sub-function does the conversion. The tree it produces is labelled as % % having been derived from a type. The type is either a variable type or a % % compound type. % let type_to_print_tree t = % : (type -> print_tree) % letrec type_to_print_tree' t = % : (type -> print_tree) % if (is_vartype t) then Print_node (`VAR`,[Print_node (dest_vartype t,[])]) else let (name,args) = dest_type t in Print_node (`OP`,((Print_node (name,[])). (map type_to_print_tree' args))) in Print_node (`type`,[type_to_print_tree' t]);; % Function to convert HOL term into the corresponding parse-tree. % % The first argument determines whether or not occurrences of the constant % % UNCURRY are to be converted into abstractions with tuples in place of % % bound variables. The conversion is attempted as soon as a sub-tree has % % been built. This causes the conversion to be applied upwards from deep % % within the tree, which means that if the conversion generates any new % % instances of sub-trees that should be converted, they will not be missed. % % The second argument controls the amount of type information included in % % the tree. % % Type information is included with constants if all type info is required % % or if useful type info is required and the constant is a function which % % is not fully applied. % % There are two cases for variables. If a variable of the same name has % % already been encountered, type info is included if all type info is % % required. If no type info is required, no type is included. In any other % % case, type info is included if the variable has a different type to that % % of the variable already encountered. If no variable of the same name has % % been encountered, type info is included if required, and in any case the % % variable is added to the list of those already encountered. % % For abstractions, the bound variable is converted first so that it is % % adorned with type information in preference to occurrences of the same % % variable within the body. Any variables of the same name already in the % % list of variables encountered are removed because they are not visible % % within the body. % % At an application, the rator may be told that it is fully applied. This % % is the case if the application has an overall type which is not a % % function type, and it is also the case if there is a fully applied parent % % application (i.e. one higher up the tree). % % Finally, the tree is labelled as having been generated from a term. % let term_to_print_tree transform type_info t = % : (bool -> type_selection -> term -> print_tree) % letrec term_to_print_tree' transform type_info fully_applied_fun stl t = % : (bool -> type_selection -> bool -> (string # type) list -> term -> % % (print_tree # (string # type) list)) % let (hidden_types,useful_types,all_types) = case type_info of No_types . (false,false,false) | Hidden_types . (true,false,false) | Useful_types . (true,true,false) | All_types . (true,true,true) and is_fun_type ty = % : (type -> bool) % (((fst (dest_type ty)) = `fun`) ? false) in let (pt,stl') = if (is_const t) then (let (name,typ) = dest_const t in (Print_node (`CONST`,((Print_node (name,[])). (if (((not fully_applied_fun) & (is_fun_type typ) & useful_types) or all_types) then [type_to_print_tree typ] else []))), stl)) if (is_var t) then (let (name,typ) = dest_var t in ( (let ty = snd (assoc name stl) in (Print_node (`VAR`,((Print_node (name,[])). (if (((not (ty = typ)) & hidden_types) or all_types) then [type_to_print_tree typ] else []))), stl)) ?? [`assoc`] (Print_node (`VAR`,((Print_node (name,[])). (if (useful_types or all_types) then [type_to_print_tree typ] else []))), ((name,typ).stl)) )) if (is_abs t) then (let (bv,body) = dest_abs t in let (pt1,stl1) = term_to_print_tree' transform type_info false [] bv in let (pt2,stl2) = term_to_print_tree' transform type_info false ((hd stl1). (filter (\x. not ((fst x) = (fst (hd stl1)))) stl)) body in (Print_node (`ABS`,[pt1;pt2]), stl2)) if (is_comb t) then (let (rator,rand) = dest_comb t and fully_applied_fun' = fully_applied_fun or (not (is_fun_type (type_of t))) in let (pt1,stl1) = term_to_print_tree' transform type_info fully_applied_fun' stl rator in let (pt2,stl2) = term_to_print_tree' transform type_info false stl1 rand in (Print_node (`COMB`,[pt1;pt2]),stl2)) else failwith `term_to_print_tree` in case (pt,transform) of (Print_node (`COMB`,[Print_node (`CONST`,((Print_node (`UNCURRY`,[]))._)); Print_node (`ABS`,[pt1;Print_node (`ABS`,[pt2;pt3])]) ]), true) . (Print_node (`ABS`, [Print_node (`COMB`, [Print_node (`COMB`, [Print_node (`CONST`,[Print_node (`,`,[])]); pt1]);pt2]);pt3]), stl') | (_) . (pt,stl') in Print_node (`term`,[fst (term_to_print_tree' transform type_info false [] t)]);; % Function to convert HOL theorem into the corresponding parse-tree. % % The first argument controls whether or not hypotheses are abbreviated. % let thm_to_print_tree show_assumps transform type_info t = % : (bool -> bool -> type_selection -> thm -> print_tree) % Print_node (`thm`,[term_to_print_tree transform type_info (concl t); (if show_assumps then Print_node (`hyp`, map (term_to_print_tree transform type_info) (hyp t)) else Print_node (`dots`,map (\x. Print_node (`dot`,[])) (hyp t))) ]);; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/hol_type.pp0000640000212700021270000001033305071610234020402 0ustar cammcamm% hol_type.pp % %-----------------------------------------------------------------------------% % A pretty-printer for HOL types % prettyprinter hol_type = declarations % Function for detecting infix type constructors % is_type_infix = {\meta. meta is_a_member_of [`fun`;`prod`;`sum`]}; % Mapping infix constructors to their symbols % symb_of = { \symb. case symb of `fun` . `->` | `prod` . `#` | `sum` . `+` | _ . symb }; % Functions for handling the precedence of type constructors % % Uses the function `type_prec' defined in `precedence.ml' % prec = {bound_number `prec`}; prec_of = {\meta. apply1 type_prec (bound_name meta)}; prec_test = {\meta. apply2 (curry $<) (prec_of meta) prec}; end declarations abbreviations symb = {symb_of}; % `max_type_prec' is defined in the file `precedence.ml' % max_prec = {apply0 max_type_prec}; end abbreviations rules % Variable types and the names of type constructors % 'type'::VAR(***op()) -> [ symb(***op)]; 'type'::OP(***op()) -> [ symb(***op)]; % Compound type with an infix constructor % % Type is enclosed in parentheses if constructor has a lower or the same % % precedence as the parent constructor. The precedence of the parent % % constructor is held in the parameter `prec' and is updated prior to % % recursive calls of the printer. % 'type'::OP(***op(),*type1,*type2) where {is_type_infix `op`} -> [ if {prec_test `op`} then [] else [ "("] [ [ *type1 with prec := {prec_of `op`} end with symb(***op)] *type2 with prec := {prec_of `op`} end with] if {prec_test `op`} then [] else [ ")"]]; % All other compound types % % The recursive calls to print the sub-types are made with the precedence % % set to its highest numerical value (lowest precedence) so that the % % sub-types do not appear enclosed within parentheses. % 'type'::OP(***op(),**types,*type) -> [ [ "(" [ **[ **types with prec := max_prec end with ","] *type with prec := max_prec end with] ")"] symb(***op)]; % Wrap quotes and a colon around type when a type labelling node is % % encountered. Also, initialise precedence of parent constructor to be % % lowest precedence (highest numerical value) so that the type within % % the quotes is not enclosed within parentheses. This initialisation is % % also required to prevent an error occurring. % 'type'::type(*type) -> [ """:" *type with prec := max_prec end with """"]; % If type to be printed is part of a term, switch context and initialise % % precedence parameter. Call printer on whole tree. If the type passed % % on from the term printer still contains its labelling node, the % % previous rule will display an unwanted set of quotes in the middle of % % the term. % 'term'::*type -> [ 'type'::*type with prec := max_prec end with]; end rules end prettyprinter %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/link_to_hol.ml0000640000212700021270000000066505071610235021061 0ustar cammcamm% link_to_hol.ml % %-----------------------------------------------------------------------------% % Installs new printers for types, terms, and theorems into HOL. % top_print pp_print_type;; top_print pp_print_term;; top_print pp_print_thm;; assignable_print_term := pp_print_term;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/new_printers.ml0000640000212700021270000000775705071610236021311 0ustar cammcamm% new_printers.ml % %-----------------------------------------------------------------------------% % Combined HOL pretty-printing rules % let hol_rules_fun = hol_thm_rules_fun then_try hol_term_rules_fun then_try hol_type_rules_fun;; % Functions to convert types, terms and theorems into parse-trees. % % The amount of type information included is that required by the rules % % in `hol_rules_fun'. % let pp_convert_type t = % : (type -> print_tree) % type_to_print_tree t;; let pp_convert_term t = % : (term -> print_tree) % term_to_print_tree true (if (get_flag_value `show_types`) then Useful_types else Hidden_types) t;; % Hypotheses abbreviated % let pp_convert_thm t = % : (thm -> print_tree) % thm_to_print_tree false true (if (get_flag_value `show_types`) then Useful_types else Hidden_types) t;; % Hypotheses in full % let pp_convert_all_thm t = % : (thm -> print_tree) % thm_to_print_tree true true (if (get_flag_value `show_types`) then Useful_types else Hidden_types) t;; % Print functions for HOL types, terms and theorems which simulate the % % standard HOL pretty-printer. % let pp_print_type t = % : (type -> void) % pp hol_type_rules_fun `type` [] (pp_convert_type t);; let pp_print_term t = % : (term -> void) % pp (hol_term_rules_fun then_try hol_type_rules_fun) `term` [] (pp_convert_term t);; let pp_print_thm t = % : (thm -> void) % pp (hol_thm_rules_fun then_try hol_term_rules_fun then_try hol_type_rules_fun) `thm` [] (pp_convert_thm t);; let pp_print_all_thm t = % : (thm -> void) % pp (hol_thm_rules_fun then_try hol_term_rules_fun then_try hol_type_rules_fun) `thm` [] (pp_convert_all_thm t);; % Function which simulates the standard HOL function `print_theory' % let pp_print_theory s = % : (string -> void) % let make_type ispair = % : ((int # string) -> type) % let make_vartypes n = % : (int -> type list) % letrec make_vartypes' n s l = % : (int -> string -> type list -> type list) % if (n < 1) then (rev l) else let s' = `*` ^ s in make_vartypes' (n - 1) s' ((mk_vartype s').l) in make_vartypes' n `` [] in mk_type (snd ispair, make_vartypes (fst ispair)) and print_constant t = % : (term -> void) % let (name,typ) = ((dest_const t) ? failwith `print_constant`) in do (print_begin 0; print_string name; print_break (1,0); pp_print_type typ; print_end ()) and print_theorem (s,t) = % : (string # thm -> void) % do (print_begin 0; print_string s; print_break (2,2); pp_print_thm t; print_end ()) in do (print_newline (); print_string (`The Theory ` ^ s); print_newline (); print_list true `Parents` print_string (parents s); print_list true `Types` (pp_print_type o make_type) (types s); print_list true `Constants` print_constant (constants s); print_list true `Infixes` print_constant (infixes s); print_list true `Binders` print_constant (binders s); print_list false `Axioms` print_theorem (axioms s); print_list false `Definitions` print_theorem (definitions s); print_list false `Theorems` print_theorem (theorems s); print_string (`******************** `^s^` ********************`); print_newline (); print_newline ());; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/PP_hol/precedence.ml0000640000212700021270000000317305071610236020653 0ustar cammcamm% precedence.ml % %-----------------------------------------------------------------------------% % Precedence tables for HOL % % Values have been chosen to allow user-defined objects to have a % % precedence between the precedences of any built-in objects. % % Precedence table for HOL types % let type_prec symb = % : (string -> int) % case symb of `fun` . 300 | `prod` . 100 | `sum` . 200 | _ . 0;; % Highest type precedence (minimum value) % let min_type_prec = 0;; % Lowest type precedence (maximum value) % let max_type_prec = 400;; % Precedence table for HOL terms % let term_prec symb = % : (string -> int) % case symb of `\\` . 1600 % Abstractions % | `o` . 1500 | `Sum` . 1500 | `IS_ASSUMPTION_OF` . 1500 | `=` . 1400 | `==>` . 1300 | `\\/` . 1200 | `/\\` . 1100 | `<` . 1000 | `>` . 1000 | `<=` . 1000 | `>=` . 1000 | `+` . 900 | `-` . 900 | `*` . 800 | `DIV` . 800 | `MOD` . 800 | `EXP` . 700 | `LET` . 600 | `COND` . 500 | `,` . 400 % Tuples % | `~` . 300 | `:` . 100 % Type information % | x . (if (is_binder x) then 1600 if (is_infix x) then 200 else 0);; % Highest term precedence (minimum value) % let min_term_prec = 0;; % Lowest term precedence (maximum value) % let max_term_prec = 1700;; %-----------------------------------------------------------------------------% hol88-2.02.19940316/Library/prettyp/help/0000750000212700021270000000000005227250253015770 5ustar cammcammhol88-2.02.19940316/Library/prettyp/help/entries/0000750000212700021270000000000005227260167017446 5ustar cammcammhol88-2.02.19940316/Library/prettyp/help/entries/Address.doc0000640000212700021270000000164105071610346021520 0ustar cammcamm\DOC Address \TYPE {Address : (int list -> address)} \SYNOPSIS Type constructor for sub-tree addresses. \LIBRARY prettyp \DESCRIBE {Address il} denotes the address of a sub-tree within a tree. The integer list {il} is the path that has to be followed from the root node of the tree in order to reach the sub-tree. \FAILURE Never fails. \EXAMPLE The ML value {Address [1;2]} is the address within the tree: { a / \ b c / \ \ d e f / \ g h } \noindent of the sub-tree: { e / \ g h } \noindent The sub-tree is the second child of the first child of the main tree. \USES Sub-tree addresses are maintained as far as possible during the pretty-printing process. They can thus be used to determine which sub-tree of the original parse-tree was used to generate some specified part of the pretty-printed text. \SEEALSO No_address. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/All_types.doc0000640000212700021270000000065305071610346022071 0ustar cammcamm\DOC All_types \TYPE {All_types : type_selection} \SYNOPSIS Value used to control the amount of type information included in the print-tree of a term. \LIBRARY prettyp \DESCRIBE {All_types} is a value used to instruct the term-to-print-tree conversion function to include type information in the tree for every variable and constant in the term. \SEEALSO No_types, Hidden_types, Useful_types, term_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/Hidden_types.doc0000640000212700021270000000130705071610346022551 0ustar cammcamm\DOC Hidden_types \TYPE {Hidden_types : type_selection} \SYNOPSIS Value used to control the amount of type information included in the print-tree of a term. \LIBRARY prettyp \DESCRIBE {Hidden_types} is a value used to instruct the term-to-print-tree conversion function as to how much type information to include in the tree. Type information is only included for variables which, although free, without type information appear to be bound. An example of such a variable is {"x:num"} in the term: { "\(x:bool). (x:num)" } \noindent Without types, this term appears as {"\x. x"}. However, the two occurrences of {x} are different. \SEEALSO No_types, Useful_types, All_types, term_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/No_address.doc0000640000212700021270000000036705071610346022220 0ustar cammcamm\DOC No_address \TYPE {No_address : address} \SYNOPSIS Type constructor for sub-tree addresses. \LIBRARY prettyp \DESCRIBE {No_address} is used to indicate that there is no valid address information for a sub-tree. \SEEALSO Address. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/No_types.doc0000640000212700021270000000060005071610346021725 0ustar cammcamm\DOC No_types \TYPE {No_types : type_selection} \SYNOPSIS Value used to control the amount of type information included in the print-tree of a term. \LIBRARY prettyp \DESCRIBE {No_types} is a value used to instruct the term-to-print-tree conversion function to include no type information in the tree. \SEEALSO Hidden_types, Useful_types, All_types, term_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/PP_to_ML.doc0000640000212700021270000000351705071610346021550 0ustar cammcamm\DOC PP_to_ML \TYPE {PP_to_ML : (bool -> string -> string -> void)} \SYNOPSIS Function to compile pretty-printing rules into ML datastructures. \LIBRARY prettyp \DESCRIBE The function {PP_to_ML} invokes the parser for the pretty-printing language. Its first argument indicates whether or not the output is to be appended to the destination file. If the argument is {false} and the destination file existed previously, the file is overwritten. The second and third arguments specify the names of the source and destination files respectively. For example, the ML function call: { PP_to_ML false `xxxx.pp` ``;; } \noindent compiles the file {xxxx.pp} to a file called {xxxx_pp.ml}, overwriting any previous version. The `{.pp}' extension can be omitted. So, the following has precisely the same effect as the previous `command': { PP_to_ML false `xxxx` ``;; } \noindent If the last argument is anything other than the empty string, it is used as the name of the destination file. So, { PP_to_ML false `xxxx` `test.ml`;; } \noindent compiles the file {xxxx.pp} to the file {test.ml}. \FAILURE The compiler may fail to parse the source code. In this case the error message specifies the kind of symbol the compiler was expecting and the kind of symbol it received. In addition, the compiler displays a few lines of the source file following the point at which the failure occurred. This should facilitate the location of the fault. The second kind of error occurs after the parse has completed successfully. At this point the compiler is converting the parse-tree into ML. Faults at this point are due to additional restrictions not being met, and the error messages are correspondingly ad hoc. The part of the parse-tree under conversion is printed in the pretty-printing language. This may or may not be helpful, depending on the size of the tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/Print_node.doc0000640000212700021270000000062205071610347022233 0ustar cammcamm\DOC Print_node \TYPE {Print_node : ((string # print_tree list) -> print_tree)} \SYNOPSIS Constructor function for print-trees (parse-trees). \LIBRARY prettyp \DESCRIBE {Print_node} takes a node label and a list of sub-trees and uses them to construct a new print-tree. Leaf nodes have an empty sub-tree (child) list. \FAILURE Never fails. \SEEALSO print_tree_name, print_tree_children. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/Useful_types.doc0000640000212700021270000000124205071610347022620 0ustar cammcamm\DOC Useful_types \TYPE {Useful_types : type_selection} \SYNOPSIS Value used to control the amount of type information included in the print-tree of a term. \LIBRARY prettyp \DESCRIBE {Useful_types} is a value used to instruct the term-to-print-tree conversion function to attach type information to the bound variables of abstractions, and to one occurrence of every free variable. Type information is only included for constants if the constant is a function and it is not fully applied. So, the equals sign in {"1 = 2"} would not be adorned with type information, but in {"$= 1"} it would be. \SEEALSO No_types, Hidden_types, All_types, term_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/apply0.doc0000640000212700021270000000177705071610347021353 0ustar cammcamm\DOC apply0 \TYPE {apply0 : (* -> (string # int) list -> print_binding -> *)} \SYNOPSIS Function for constructing environment accessing functions. \LIBRARY prettyp \DESCRIBE {apply0} is a higher-order function which can be used to simplify the ML code required for user-defined pretty-printer environment accessing functions. Instead of having to mention the parameter list and binding explicitly as in: { \params. \pbind. f } \noindent one can use {apply0}: { apply0 f } \FAILURE Cannot fail when given only one argument. However, the resulting function may fail. This will depend on the value of the argument. \EXAMPLE A function for testing whether the parameter `{test}' has value 1 can be written as: { apply2 (curry $=) (bound_number `test`) (apply0 1) } \noindent instead of: { \params. \pbind. (bound_number `test` params pbind) = 1 } \noindent In this example it is not clear that use of {apply0} and {apply2} is beneficial. However, it illustrates their usage. \SEEALSO apply1, apply2. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/apply1.doc0000640000212700021270000000253305071610347021343 0ustar cammcamm\DOC apply1 \BLTYPE apply1 : ((* -> **) -> ((string # int) list -> print_binding -> *) -> ((string # int) list -> print_binding -> **)) \ELTYPE \SYNOPSIS Function for constructing environment accessing functions. \LIBRARY prettyp \DESCRIBE {apply1} is a higher-order function which can be used to simplify the ML code required for user-defined pretty-printer environment accessing functions. Instead of having to mention the parameter list and binding explicitly as in: { \params. \pbind. f (val params pbind) } \noindent one can use {apply1}: { apply1 f val } \FAILURE Cannot fail when given no more than two arguments. However, the resulting function may fail. This will depend on the values of the arguments. \EXAMPLE Suppose a function is required which evaluates the length of the node-name bound to the metavariable {***x}. The ML code for this is: { \params. \pbind. (length o explode) (bound_name `x` params pbind) } \noindent The function takes a parameter list and a binding as arguments. It uses these to find the node-name bound to the metavariable with name `{x}'. The resulting string is then exploded into a list of single character strings and the length of this list is computed. Using {apply1}, the code can be written more simply as: { apply1 (length o explode) (bound_name `x`) } \SEEALSO apply0, apply2. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/apply2.doc0000640000212700021270000000232105071610347021337 0ustar cammcamm\DOC apply2 \BLTYPE apply2 : ((* -> ** -> ***) -> ((string # int) list -> print_binding -> *) -> ((string # int) list -> print_binding -> **) -> ((string # int) list -> print_binding -> ***)) \ELTYPE \SYNOPSIS Function for constructing environment accessing functions. \LIBRARY prettyp \DESCRIBE {apply2} is a higher-order function which can be used to simplify the ML code required for user-defined pretty-printer environment accessing functions. Instead of having to mention the parameter list and binding explicitly as in: { \params. \pbind. f (val1 params pbind) (val2 params pbind) } \noindent one can use {apply2}: { apply2 f val1 val2 } \FAILURE Cannot fail when given no more than three arguments. However, the resulting function may fail. This will depend on the values of the arguments. \EXAMPLE A function for testing whether the parameter `{test}' has value 1 can be written as: { apply2 (curry $=) (bound_number `test`) (\params. \pbind. 1) } \noindent instead of: { \params. \pbind. (bound_number `test` params pbind) = 1 } \noindent In this example it is not clear that use of {apply2} is beneficial. However, it illustrates its usage. \SEEALSO apply0, apply1. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/bound_child.doc0000640000212700021270000000173105071610347022406 0ustar cammcamm\DOC bound_child \BLTYPE bound_child : (string -> (string # int) list -> print_binding -> print_tree) \ELTYPE \SYNOPSIS Obtains the print-tree bound to a pretty-printer metavariable. \LIBRARY prettyp \DESCRIBE {bound_child} can be used to obtain the data item bound to a named metavariable. It takes the name of a metavariable (less the preceding {*}, {**}, or {***}) as its first argument and returns a function of type: { (string # int) list -> print_binding -> print_tree } \noindent When given the current environment as arguments, this function yields the print-tree bound to the specified metavariable. The parameter list is not used, but is present for consistency. \FAILURE The function fails if the specified metavariable is not bound to a print-tree. It also fails if the metavariable cannot be found in the binding. \SEEALSO bound_children, bound_name, bound_names, is_a_member_of, bound_number, bound_context. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/bound_children.doc0000640000212700021270000000200505071610350023100 0ustar cammcamm\DOC bound_children \BLTYPE bound_children : (string -> (string # int) list -> print_binding -> print_tree list) \ELTYPE \SYNOPSIS Obtains the print-trees bound to a pretty-printer metavariable. \LIBRARY prettyp \DESCRIBE {bound_children} can be used to obtain the data item bound to a named metavariable. It takes the name of a metavariable (less the preceding {*}, {**}, or {***}) as its first argument and returns a function of type: { (string # int) list -> print_binding -> print_tree list } \noindent When given the current environment as arguments, this function yields the list of print-trees bound to the specified metavariable. The parameter list is not used, but is present for consistency. \FAILURE The function fails if the specified metavariable is not bound to a list of print-trees. It also fails if the metavariable cannot be found in the binding. \SEEALSO bound_child, bound_name, bound_names, is_a_member_of, bound_number, bound_context. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/bound_context.doc0000640000212700021270000000140405071610350022776 0ustar cammcamm\DOC bound_context \TYPE {bound_context : ((string # int) list -> print_binding -> string)} \SYNOPSIS Obtains the value of the current context from the pretty-printer environment. \LIBRARY prettyp \DESCRIBE To make it easier to extract the value of the current context from its rather contorted representation in the parameter list, there is a function called {bound_context}. When presented with the current environment by way of its arguments, {bound_context} returns the character string representing the current context. The binding is not used, but is present for consistency. \FAILURE The function will not fail unless it is given an invalid parameter list. \SEEALSO is_a_member_of, bound_name, bound_names, bound_child, bound_children, bound_number. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/bound_name.doc0000640000212700021270000000163605071610350022241 0ustar cammcamm\DOC bound_name \TYPE {bound_name : (string -> (string # int) list -> print_binding -> string)} \SYNOPSIS Obtains the node-name bound to a pretty-printer metavariable. \LIBRARY prettyp \DESCRIBE {bound_name} can be used to obtain the data item bound to a named metavariable. It takes the name of a metavariable (less the preceding {*}, {**}, or {***}) as its first argument and returns a function of type: { (string # int) list -> print_binding -> string } \noindent When given the current environment as arguments, this function yields the node-name bound to the specified metavariable. The parameter list is not used, but is present for consistency. \FAILURE The function fails if the specified metavariable is not bound to a single node-name. It also fails if the metavariable cannot be found in the binding. \SEEALSO bound_names, bound_child, bound_children, is_a_member_of, bound_number, bound_context. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/bound_names.doc0000640000212700021270000000175305071610350022424 0ustar cammcamm\DOC bound_names \BLTYPE bound_names : (string -> (string # int) list -> print_binding -> string list) \ELTYPE \SYNOPSIS Obtains the node-names bound to a pretty-printer metavariable. \LIBRARY prettyp \DESCRIBE {bound_names} can be used to obtain the data item bound to a named metavariable. It takes the name of a metavariable (less the preceding {*}, {**}, or {***}) as its first argument and returns a function of type: { (string # int) list -> print_binding -> string list } \noindent When given the current environment as arguments, this function yields the list of node-names bound to the specified metavariable. The parameter list is not used, but is present for consistency. \FAILURE The function fails if the specified metavariable is not bound to a list of node-names. It also fails if the metavariable cannot be found in the binding. \SEEALSO bound_name, bound_child, bound_children, is_a_member_of, bound_number, bound_context. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/bound_number.doc0000640000212700021270000000133005071610350022600 0ustar cammcamm\DOC bound_number \TYPE {bound_number : (string -> print_int_exp)} \SYNOPSIS Obtains the value bound to a pretty-printer parameter. \LIBRARY prettyp \DESCRIBE {bound_number} takes the name of a pretty-printer parameter as its first argument (a string) and returns a function of type: { (string # int) list -> print_binding -> int } \noindent This function yields the integer value associated with the parameter, when it is presented with an environment via its two arguments. The binding is not used, but is present for consistency. \FAILURE The function fails if the parameter is not present in the parameter list. \SEEALSO is_a_member_of, bound_name, bound_names, bound_child, bound_children, bound_context. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/get_margin.doc0000640000212700021270000000041005071610350022233 0ustar cammcamm\DOC get_margin \TYPE {get_margin : (void -> int)} \SYNOPSIS Returns the limit on the width of the output produced by the standard HOL pretty-printer. \LIBRARY prettyp \FAILURE Never fails. \EXAMPLE { #get_margin ();; 72 : int } \SEEALSO set_margin. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/hol_rules_fun.doc0000640000212700021270000000075305071610351022776 0ustar cammcamm\DOC hol_rules_fun \TYPE {hol_rules_fun : print_rule_function} \SYNOPSIS Pretty-printing rules (as a function) for HOL types, terms and theorems. \LIBRARY prettyp \FAILURE Fails if none of the rules match the input. However, this function should not be applied `by hand'; it should only be used as an argument to one of the pretty-printing functions. \SEEALSO hol_type_rules_fun, hol_term_rules_fun, hol_thm_rules_fun, raw_tree_rules_fun, then_try, pretty_print, pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/new_child.doc0000640000212700021270000000272305071610352022066 0ustar cammcamm\DOC new_child \BLTYPE new_child : ((print_tree -> print_tree) -> string -> (string # int) list -> print_binding -> metavar_binding) \ELTYPE \SYNOPSIS Function for transforming a print-tree bound to a metavariable. \LIBRARY prettyp \DESCRIBE Within the metavariable transformation part of a pretty-printing rule, a typical requirement is to `declare' a new metavariable to be bound to the result of performing a transformation on a single existing metavariable. The type of function required is: { (string # int) list -> print_binding -> metavar_binding } \noindent There are four functions available to facilitate this, corresponding to the four different types of data which can be bound to a metavariable. {new_child} is the function for use when the data is a single print-tree. The first argument is the transformation function. The second argument is the name of the metavariable which is bound to the value to be transformed. When provided with these arguments and a pretty-printer environment, {new_child} extracts the item bound to the named metavariable and then applies the transformation function to it. The result is then made into a form suitable for binding to a metavariable, that is it is made into an object of type {metavar_binding}. \FAILURE {new_child} fails if the named metavariable does not exist or is bound to an item of the wrong type. \SEEALSO new_children, new_name, new_names, bound_child. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/hol_term_rules_fun.doc0000640000212700021270000000105505071610351024021 0ustar cammcamm\DOC hol_term_rules_fun \TYPE {hol_term_rules_fun : print_rule_function} \SYNOPSIS Pretty-printing rules (as a function) for HOL terms. {hol_type_rules_fun} is required for {hol_term_rules_fun} to function correctly. \LIBRARY prettyp \FAILURE Fails if none of the rules match the input. However, this function should not be applied `by hand'; it should only be used as an argument to one of the pretty-printing functions. \SEEALSO hol_type_rules_fun, hol_thm_rules_fun, hol_rules_fun, raw_tree_rules_fun, then_try, pretty_print, pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/hol_thm_rules_fun.doc0000640000212700021270000000112205071610351023635 0ustar cammcamm\DOC hol_thm_rules_fun \TYPE {hol_thm_rules_fun : print_rule_function} \SYNOPSIS Pretty-printing rules (as a function) for HOL theorems. The rules {hol_type_rules_fun} and {hol_term_rules_fun} are required for {hol_thm_rules_fun} to function correctly. \LIBRARY prettyp \FAILURE Fails if none of the rules match the input. However, this function should not be applied `by hand'; it should only be used as an argument to one of the pretty-printing functions. \SEEALSO hol_type_rules_fun, hol_term_rules_fun, hol_rules_fun, raw_tree_rules_fun, then_try, pretty_print, pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/hol_type_rules_fun.doc0000640000212700021270000000073405071610351024036 0ustar cammcamm\DOC hol_type_rules_fun \TYPE {hol_type_rules_fun : print_rule_function} \SYNOPSIS Pretty-printing rules (as a function) for HOL types. \LIBRARY prettyp \FAILURE Fails if none of the rules match the input. However, this function should not be applied `by hand'; it should only be used as an argument to one of the pretty-printing functions. \SEEALSO hol_term_rules_fun, hol_thm_rules_fun, hol_rules_fun, raw_tree_rules_fun, then_try, pretty_print, pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/is_a_member_of.doc0000640000212700021270000000161605072362346023070 0ustar cammcamm\DOC is_a_member_of \TYPE {$is_a_member_of : (string -> string list -> print_test)} \SYNOPSIS Function for testing a node-name metavariable in a pretty-printing rule. \LIBRARY prettyp \DESCRIBE {is_a_member_of} forms a {print_test} which yields {true} only if the metavariable whose name is the first argument to {is_a_member_of} is bound to a node-name which appears in the second argument. This evaluation to a Boolean value is only performed when the {print_test} is applied to a parameter list and a binding. \FAILURE The function fails if the metavariable named is bound to anything other than a single node-name. \EXAMPLE An example of the use of this function is the rule: { ''::***node(*,*) where {{`node` is_a_member_of [`plus`;`minus`;`mult`;`div`]}} -> [ ***node]; } \SEEALSO bound_number, bound_name, bound_names, bound_child, bound_children, bound_context. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/max_term_prec.doc0000640000212700021270000000036505071610351022756 0ustar cammcamm\DOC max_term_prec \TYPE {max_term_prec : int} \SYNOPSIS Lowest precedence (maximum value) used by the pretty-printer for HOL function constants and syntactic constructs in terms. \LIBRARY prettyp \SEEALSO min_term_prec, term_prec. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/max_type_prec.doc0000640000212700021270000000031705071610352022766 0ustar cammcamm\DOC max_type_prec \TYPE {max_type_prec : int} \SYNOPSIS Lowest precedence (maximum value) used by the pretty-printer for HOL type operators. \LIBRARY prettyp \SEEALSO min_type_prec, type_prec. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/min_term_prec.doc0000640000212700021270000000036605071610352022756 0ustar cammcamm\DOC min_term_prec \TYPE {min_term_prec : int} \SYNOPSIS Highest precedence (minimum value) used by the pretty-printer for HOL function constants and syntactic constructs in terms. \LIBRARY prettyp \SEEALSO max_term_prec, term_prec. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/min_type_prec.doc0000640000212700021270000000032005071610352022756 0ustar cammcamm\DOC min_type_prec \TYPE {min_type_prec : int} \SYNOPSIS Highest precedence (minimum value) used by the pretty-printer for HOL type operators. \LIBRARY prettyp \SEEALSO max_type_prec, type_prec. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/new_children.doc0000640000212700021270000000357705071610352022603 0ustar cammcamm\DOC new_children \BLTYPE new_children : (((print_tree # address) list -> (print_tree # address) list) -> string -> (string # int) list -> print_binding -> metavar_binding) \ELTYPE \SYNOPSIS Function for transforming a list of print-trees bound to a metavariable. \LIBRARY prettyp \DESCRIBE Within the metavariable transformation part of a pretty-printing rule, a typical requirement is to `declare' a new metavariable to be bound to the result of performing a transformation on a single existing metavariable. The type of function required is: { (string # int) list -> print_binding -> metavar_binding } \noindent There are four functions available to facilitate this, corresponding to the four different types of data which can be bound to a metavariable. {new_children} is the function for use when the data is a list of print-trees. The first argument is the transformation function. The second argument is the name of the metavariable which is bound to the value to be transformed. When provided with these arguments and a pretty-printer environment, {new_children} extracts the item bound to the named metavariable and then applies the transformation function to it. The result is then made into a form suitable for binding to a metavariable, that is it is made into an object of type {metavar_binding}. Note that the transformation function has to deal with sub-tree addresses in addition to the print-trees. If the transformation function is polymorphic, as is for example a function to reverse the list, this will not cause any difficulties. The addresses have to be dealt with by the transformation function because the system cannot know how to re-assign addresses to the values in the result list. \FAILURE {new_children} fails if the named metavariable does not exist or is bound to an item of the wrong type. \SEEALSO new_child, new_name, new_names, bound_children. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/new_name.doc0000640000212700021270000000270005071610352021716 0ustar cammcamm\DOC new_name \BLTYPE new_name : ((string -> string) -> string -> (string # int) list -> print_binding -> metavar_binding) \ELTYPE \SYNOPSIS Function for transforming a node-name bound to a metavariable. \LIBRARY prettyp \DESCRIBE Within the metavariable transformation part of a pretty-printing rule, a typical requirement is to `declare' a new metavariable to be bound to the result of performing a transformation on a single existing metavariable. The type of function required is: { (string # int) list -> print_binding -> metavar_binding } \noindent There are four functions available to facilitate this, corresponding to the four different types of data which can be bound to a metavariable. {new_name} is the function for use when the data is a single node-name. The first argument is the transformation function. The second argument is the name of the metavariable which is bound to the value to be transformed. When provided with these arguments and a pretty-printer environment, {new_name} extracts the item bound to the named metavariable and then applies the transformation function to it. The result is then made into a form suitable for binding to a metavariable, that is it is made into an object of type {metavar_binding}. \FAILURE {new_name} fails if the named metavariable does not exist or is bound to an item of the wrong type. \SEEALSO new_names, new_child, new_children, bound_name. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/new_names.doc0000640000212700021270000000360605071610353022110 0ustar cammcamm\DOC new_names \BLTYPE new_names : (((string # address) list -> (string # address) list) -> string -> (string # int) list -> print_binding -> metavar_binding) \ELTYPE \SYNOPSIS Function for transforming a list of node-names bound to a metavariable. \LIBRARY prettyp \DESCRIBE Within the metavariable transformation part of a pretty-printing rule, a typical requirement is to `declare' a new metavariable to be bound to the result of performing a transformation on a single existing metavariable. The type of function required is: { (string # int) list -> print_binding -> metavar_binding } \noindent There are four functions available to facilitate this, corresponding to the four different types of data which can be bound to a metavariable. {new_names} is the function for use when the data is a list of node-names. The first argument is the transformation function. The second argument is the name of the metavariable which is bound to the value to be transformed. When provided with these arguments and a pretty-printer environment, {new_names} extracts the item bound to the named metavariable and then applies the transformation function to it. The result is then made into a form suitable for binding to a metavariable, that is it is made into an object of type {metavar_binding}. Note that the transformation function has to deal with sub-tree addresses in addition to the node-names. If the transformation function is polymorphic, as is for example a function to reverse the list, this will not cause any difficulties. The addresses have to be dealt with by the transformation function because the system cannot know how to re-assign addresses to the values in the result list. \FAILURE {new_names} fails if the named metavariable does not exist or is bound to an item of the wrong type. \SEEALSO new_name, new_child, new_children, bound_names. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp.doc0000640000212700021270000000432405071610353020551 0ustar cammcamm\DOC pp \BLTYPE pp : (print_rule_function -> string -> (string # int) list -> print_tree -> void) \ELTYPE \SYNOPSIS One of the main pretty-printing functions. For use with the standard HOL pretty-printer. \LIBRARY prettyp \DESCRIBE {pp} invokes the pretty-printer. It can be used for merging output with text produced by the standard HOL pretty-printer. Instead of ending each line of text by printing a new-line, it sends its output to the standard HOL printer in the form of a pretty-printing block. The arguments to the function are: (1) pretty-printing rules expressed as a function, (2) the initial context, (3) initial parameters, (4) tree to be printed. {pp} uses as its maximum width the width for the standard HOL printer, as specified by the function {set_margin}. The initial offset from the left margin is taken to be zero. \FAILURE Failure or incorrect behaviour can be caused by mistakes in the pretty-printing rules or by inappropriate arguments to the printing function. The most common errors are use of uninitialised parameters and reference to unknown metavariables. The latter are due to metavariables appearing in the format of a rule, but not in the pattern. Errors also occur if a metavariable is used in a place inappropriate for the value it is bound to. An example of this is an attempt to compare a string with a metavariable that is bound to a tree rather than a node-name. Use of negative indentations in formats may cause text to overflow the left margin, and an exception to be raised. Any user defined function may also cause a run-time error. The printing functions have been designed to trap exceptions and to print {*error*}. This does not indicate what caused the error, but it may give some indication of where the error occurred. However, this is not the main reason for trapping exceptions. The ML directive {top_print} installs a user print function. If an exception is raised within this function, it does not appear at the top-level of ML. Instead, an obscure Lisp error is produced. Since the pretty-printing functions are normally used with {top_print}, it is best to avoid raising exceptions. For this reason the printing functions display {*error*} instead. \SEEALSO pretty_print, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_convert_all_thm.doc0000640000212700021270000000220105071610353024001 0ustar cammcamm\DOC pp_convert_all_thm \TYPE {pp_convert_all_thm : (thm -> print_tree)} \SYNOPSIS Function for converting a HOL theorem into a print-tree. \LIBRARY prettyp \DESCRIBE {pp_convert_all_thm} converts a theorem into a print-tree. The hypotheses (assumptions) of the theorem are included in the print-tree. Instances of the HOL constant {UNCURRY} in the theorem are converted into an appropriate use of ordered pairs in the print-tree. The amount of type information included in the print-tree is determined by the value of the HOL system flag {show_types}. If {show_types} is {true}, then `useful' types are included in the print-tree. Otherwise, only `hidden' types are included. `Useful' type information is type information on the bound variables of abstractions and on one occurrence of every free variable. Type information is only included for constants if the constant is a function and it is not fully applied. `Hidden' types are rare. They only occur on variables which, although free, without type information appear to be bound. \FAILURE Never fails. \SEEALSO pp_convert_thm, pp_convert_type, pp_convert_term, thm_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_convert_term.doc0000640000212700021270000000205005071610353023332 0ustar cammcamm\DOC pp_convert_term \TYPE {pp_convert_term : (term -> print_tree)} \SYNOPSIS Function for converting a HOL term into a print-tree. \LIBRARY prettyp \DESCRIBE {pp_convert_term} converts a term into a print-tree. Instances of the HOL constant {UNCURRY} in the term are converted into an appropriate use of ordered pairs in the print-tree. The amount of type information included in the print-tree is determined by the value of the HOL system flag {show_types}. If {show_types} is {true}, then `useful' types are included in the print-tree. Otherwise, only `hidden' types are included. `Useful' type information is type information on the bound variables of abstractions and on one occurrence of every free variable. Type information is only included for constants if the constant is a function and it is not fully applied. `Hidden' types are rare. They only occur on variables which, although free, without type information appear to be bound. \FAILURE Never fails. \SEEALSO pp_convert_type, pp_convert_thm, pp_convert_all_thm, term_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_convert_thm.doc0000640000212700021270000000217505071610353023163 0ustar cammcamm\DOC pp_convert_thm \TYPE {pp_convert_thm : (thm -> print_tree)} \SYNOPSIS Function for converting a HOL theorem into a print-tree. \LIBRARY prettyp \DESCRIBE {pp_convert_thm} converts a theorem into a print-tree. The hypotheses (assumptions) of the theorem are not included in the print-tree. Instances of the HOL constant {UNCURRY} in the theorem are converted into an appropriate use of ordered pairs in the print-tree. The amount of type information included in the print-tree is determined by the value of the HOL system flag {show_types}. If {show_types} is {true}, then `useful' types are included in the print-tree. Otherwise, only `hidden' types are included. `Useful' type information is type information on the bound variables of abstractions and on one occurrence of every free variable. Type information is only included for constants if the constant is a function and it is not fully applied. `Hidden' types are rare. They only occur on variables which, although free, without type information appear to be bound. \FAILURE Never fails. \SEEALSO pp_convert_all_thm, pp_convert_type, pp_convert_term, thm_to_print_tree. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_convert_type.doc0000640000212700021270000000054005071610354023347 0ustar cammcamm\DOC pp_convert_type \TYPE {pp_convert_type : (type -> print_tree)} \SYNOPSIS Function for converting a HOL type into a print-tree. \LIBRARY prettyp \DESCRIBE {pp_convert_type} has an identical specification to {type_to_print_tree}. \FAILURE Never fails. \SEEALSO type_to_print_tree, pp_convert_term, pp_convert_thm, pp_convert_all_thm. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_print_all_thm.doc0000640000212700021270000000040705071610354023464 0ustar cammcamm\DOC pp_print_all_thm \TYPE {pp_print_all_thm : (thm -> void)} \SYNOPSIS Print function for HOL theorems. Simulates the HOL system function {print_all_thm}. \LIBRARY prettyp \FAILURE Never fails. \SEEALSO pp_print_thm, pp_print_type, pp_print_term. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_print_term.doc0000640000212700021270000000037705071610354023021 0ustar cammcamm\DOC pp_print_term \TYPE {pp_print_term : (term -> void)} \SYNOPSIS Print function for HOL terms. Simulates the HOL system function {print_term}. \LIBRARY prettyp \FAILURE Never fails. \SEEALSO pp_print_type, pp_print_thm, pp_print_all_thm. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_print_theory.doc0000640000212700021270000000127605071610354023363 0ustar cammcamm\DOC pp_print_theory \TYPE {pp_print_theory : (string -> void)} \SYNOPSIS Print function for HOL theories. \LIBRARY prettyp \DESCRIBE {pp_print_theory} simulates the HOL system function {print_theory} using the pretty-printer library. The function takes a theory-segment name as argument. The following information is displayed: the parents of the theory, types defined within the theory, constants of the theory, the binders and infixes (subsets of the constants), the axioms, the definitions, and the derived theorems. \FAILURE Fails if the named theory does not exist or is not an ancestor of the current theory. \SEEALSO pp_print_type, pp_print_term, pp_print_thm, pp_print_all_thm. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_print_thm.doc0000640000212700021270000000037705071610354022642 0ustar cammcamm\DOC pp_print_thm \TYPE {pp_print_thm : (thm -> void)} \SYNOPSIS Print function for HOL theorems. Simulates the HOL system function {print_thm}. \LIBRARY prettyp \FAILURE Never fails. \SEEALSO pp_print_all_thm, pp_print_type, pp_print_term. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_print_type.doc0000640000212700021270000000037705071610354023033 0ustar cammcamm\DOC pp_print_type \TYPE {pp_print_type : (type -> void)} \SYNOPSIS Print function for HOL types. Simulates the HOL system function {print_type}. \LIBRARY prettyp \FAILURE Never fails. \SEEALSO pp_print_term, pp_print_thm, pp_print_all_thm. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pp_write.doc0000640000212700021270000000372605071610355021772 0ustar cammcamm\DOC pp_write \BLTYPE pp_write : (string -> int -> int -> print_rule_function -> string -> (string # int) list -> print_tree -> void) \ELTYPE \SYNOPSIS One of the main pretty-printing functions. Function for printing to files. \LIBRARY prettyp \DESCRIBE {pp_write} invokes the pretty-printer. The arguments to this function are: (1) file handle (port) of the file to be written to, (2) maximum width of output permitted, (3) initial offset from left margin, (4) pretty-printing rules expressed as a function, (5) the initial context, (6) initial parameters, (7) tree to be printed. \FAILURE Failure or incorrect behaviour can be caused by mistakes in the pretty-printing rules or by inappropriate arguments to the printing function. The most common errors are use of uninitialised parameters and reference to unknown metavariables. The latter are due to metavariables appearing in the format of a rule, but not in the pattern. Errors also occur if a metavariable is used in a place inappropriate for the value it is bound to. An example of this is an attempt to compare a string with a metavariable that is bound to a tree rather than a node-name. Use of negative indentations in formats may cause text to overflow the left margin, and an exception to be raised. Any user defined function may also cause a run-time error. The printing functions have been designed to trap exceptions and to print {*error*}. This does not indicate what caused the error, but it may give some indication of where the error occurred. However, this is not the main reason for trapping exceptions. The ML directive {top_print} installs a user print function. If an exception is raised within this function, it does not appear at the top-level of ML. Instead, an obscure Lisp error is produced. Since the pretty-printing functions are normally used with {top_print}, it is best to avoid raising exceptions. For this reason the printing functions display {*error*} instead. \SEEALSO pretty_print, pp. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/pretty_print.doc0000640000212700021270000000373005071610355022677 0ustar cammcamm\DOC pretty_print \BLTYPE pretty_print : (int -> int -> print_rule_function -> string -> (string # int) list -> print_tree -> void) \ELTYPE \SYNOPSIS One of the main pretty-printing functions. This one writes directly to the terminal, independently of the standard HOL printer. \LIBRARY prettyp \DESCRIBE {pretty_print} invokes the pretty-printer. The arguments to this function are: (1) maximum width of output permitted, (2) initial offset from left margin, (3) pretty-printing rules expressed as a function, (4) the initial context, (5) initial parameters, (6) tree to be printed. \FAILURE Failure or incorrect behaviour can be caused by mistakes in the pretty-printing rules or by inappropriate arguments to the printing function. The most common errors are use of uninitialised parameters and reference to unknown metavariables. The latter are due to metavariables appearing in the format of a rule, but not in the pattern. Errors also occur if a metavariable is used in a place inappropriate for the value it is bound to. An example of this is an attempt to compare a string with a metavariable that is bound to a tree rather than a node-name. Use of negative indentations in formats may cause text to overflow the left margin, and an exception to be raised. Any user defined function may also cause a run-time error. The printing functions have been designed to trap exceptions and to print {*error*}. This does not indicate what caused the error, but it may give some indication of where the error occurred. However, this is not the main reason for trapping exceptions. The ML directive {top_print} installs a user print function. If an exception is raised within this function, it does not appear at the top-level of ML. Instead, an obscure Lisp error is produced. Since the pretty-printing functions are normally used with {top_print}, it is best to avoid raising exceptions. For this reason the printing functions display {*error*} instead. \SEEALSO pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/print_tree_children.doc0000640000212700021270000000041305071610355024152 0ustar cammcamm\DOC print_tree_children \TYPE {print_tree_children : (print_tree -> print_tree list)} \SYNOPSIS Function to extract the sub-trees (children) of the root node of a print-tree. \LIBRARY prettyp \FAILURE Never fails. \SEEALSO print_tree_name, Print_node. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/print_tree_name.doc0000640000212700021270000000036605071610355023311 0ustar cammcamm\DOC print_tree_name \TYPE {print_tree_name : (print_tree -> string)} \SYNOPSIS Function to extract the name (label) of the root node of a print-tree. \LIBRARY prettyp \FAILURE Never fails. \SEEALSO print_tree_children, Print_node. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/raw_tree_rules_fun.doc0000640000212700021270000000116205071610355024023 0ustar cammcamm\DOC raw_tree_rules_fun \TYPE {raw_tree_rules_fun : print_rule_function} \SYNOPSIS Pretty-printing rules (as a function) for raw print-trees (parse-trees). \LIBRARY prettyp \DESCRIBE In the event of no pretty-printing rules matching the tree to be printed, a default set of rules are used. These rules always match, and the output generated is a textual representation of the structure of the tree. The default rules are available to the user as {raw_tree_rules_fun}. \FAILURE Never fails. \SEEALSO hol_type_rules_fun, hol_term_rules_fun, hol_thm_rules_fun, hol_rules_fun, then_try, pretty_print, pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/term_prec.doc0000640000212700021270000000066605071610355022121 0ustar cammcamm\DOC term_prec \TYPE {term_prec : (string -> int)} \SYNOPSIS Precedence table for HOL terms (as a function). \LIBRARY prettyp \DESCRIBE {term_prec} is a function which given the name of a HOL function constant, returns the precedence used by the pretty-printer. The precedences of abstractions ({`\\`}) and type annotations ({`:`}) are also included. \FAILURE Never fails. \SEEALSO min_term_prec, max_term_prec, type_prec. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/term_to_print_tree.doc0000640000212700021270000000534605071610356024046 0ustar cammcamm\DOC term_to_print_tree \TYPE {term_to_print_tree : (bool -> type_selection -> term -> print_tree)} \SYNOPSIS Function for converting a HOL term into a print-tree. \LIBRARY prettyp \DESCRIBE The first argument to {term_to_print_tree} is a flag. If the flag is {true}, the function converts instances of the HOL constant {UNCURRY} in the term into an appropriate use of ordered pairs in the print-tree. If the flag is {false}, {UNCURRY} is treated in the same way as any other HOL constant. The conversion is necessary because the representation of tuples of bound variables in a HOL term is so unlike the syntax of the tuples that the pretty-printer cannot handle them. So, normally, the flag should be set to {true}. The second argument to {term_to_print_tree} controls the amount of type information included in the print-tree of the term. If {No_types} is given as the argument, then the print-tree will contain no type information. If {All_types} is given as the argument, the tree will contain type information for every variable and constant. Use of {Useful_types} instructs {term_to_print_tree} to attach type information to the bound variables of abstractions, and to one occurrence of every free variable. Type information is only included for constants if the constant is a function and it is not fully applied. So, the equals sign in {"1 = 2"} would not be adorned with type information, but in {"$= 1"} it would be. Finally, using {Hidden_types} as the second argument to {term_to_print_tree} causes type information to be attached only to variables which, although free, without type information appear to be bound. An example of such a variable is {"x:num"} in the term: { "\(x:bool). (x:num)" } \noindent Without types, this term appears as {"\x. x"}. However, the two occurrences of {x} are different. \FAILURE Never fails. \EXAMPLE { #term_to_print_tree true No_types "\x. x /\ T";; Print_node(`term`, [Print_node(`ABS`, [Print_node(`VAR`, [Print_node(`x`, [])]); Print_node(`COMB`, [Print_node(`COMB`, [Print_node(`CONST`, [Print_node(`/\`, [])]); Print_node(`VAR`, [Print_node(`x`, [])])]); Print_node(`CONST`, [Print_node(`T`, [])])])])]) : print_tree } \SEEALSO type_to_print_tree, thm_to_print_tree, pp_convert_term. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/then_try.doc0000640000212700021270000000151105071610356021764 0ustar cammcamm\DOC then_try \BLTYPE $then_try : (print_rule_function -> print_rule_function -> print_rule_function) \ELTYPE \SYNOPSIS Function for composing print-rule functions. \LIBRARY prettyp \DESCRIBE {then_try} is an infix function which forms the composite of two print-rule functions, say {prf1} and {prf2}. The result is a new print-rule function which, when given a tree to match, first tries the rules of {prf1}; if none of these match, it then tries the rules of {prf2}. \FAILURE Cannot fail when given two print-rule functions as arguments. However, the resulting function may fail when used, with this depending on the failure properties of the two argument functions. \SEEALSO hol_type_rules_fun, hol_term_rules_fun, hol_thm_rules_fun, hol_rules_fun, raw_tree_rules_fun, pretty_print, pp, pp_write. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/thm_to_print_tree.doc0000640000212700021270000000535205071610356023664 0ustar cammcamm\DOC thm_to_print_tree \BLTYPE thm_to_print_tree : (bool -> bool -> type_selection -> thm -> print_tree) \ELTYPE \SYNOPSIS Function for converting a HOL theorem into a print-tree. \LIBRARY prettyp \DESCRIBE The first argument to {thm_to_print_tree} determines whether or not the hypotheses (assumptions) of the theorem are included in the print-tree in full. The second argument to {thm_to_print_tree} is a flag. If the flag is {true}, the function converts instances of the HOL constant {UNCURRY} in the theorem into an appropriate use of ordered pairs in the print-tree. If the flag is {false}, {UNCURRY} is treated in the same way as any other HOL constant. The conversion is necessary because the representation of tuples of bound variables in a HOL term is so unlike the syntax of the tuples that the pretty-printer cannot handle them. So, normally, the flag should be set to {true}. The third argument to {thm_to_print_tree} controls the amount of type information included in the print-tree of the theorem. If {No_types} is given as the argument, then the print-tree will contain no type information. If {All_types} is given as the argument, the tree will contain type information for every variable and constant. Use of {Useful_types} instructs {thm_to_print_tree} to attach type information to the bound variables of abstractions, and to one occurrence of every free variable. Type information is only included for constants if the constant is a function and it is not fully applied. So, the equals sign in {"1 = 2"} would not be adorned with type information, but in {"$= 1"} it would be. Finally, using {Hidden_types} as the third argument to {thm_to_print_tree} causes type information to be attached only to variables which, although free, without type information appear to be bound. An example of such a variable is {"x:num"} in the term: { "\(x:bool). (x:num)" } \noindent Without types, this term appears as {"\x. x"}. However, the two occurrences of {x} are different. \FAILURE Never fails. \EXAMPLE { #thm_to_print_tree false true No_types (UNDISCH (SPEC_ALL FALSITY));; Print_node(`thm`, [Print_node(`term`, [Print_node(`VAR`, [Print_node(`t`, [])])]); Print_node(`dots`, [Print_node(`dot`, [])])]) : print_tree #thm_to_print_tree true true No_types (UNDISCH (SPEC_ALL FALSITY));; Print_node(`thm`, [Print_node(`term`, [Print_node(`VAR`, [Print_node(`t`, [])])]); Print_node(`hyp`, [Print_node(`term`, [Print_node(`CONST`, [Print_node(`F`, [])])])])]) : print_tree } \SEEALSO type_to_print_tree, term_to_print_tree, pp_convert_thm, pp_convert_all_thm. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/type_prec.doc0000640000212700021270000000072005071610356022123 0ustar cammcamm\DOC type_prec \TYPE {type_prec : (string -> int)} \SYNOPSIS Precedence table for HOL types (as a function). \LIBRARY prettyp \DESCRIBE {type_prec} is a function which given the name of a HOL type operator, returns the precedence used by the pretty-printer. The standard infix type operators should be referred to by {fun}, {prod} and {sum}, rather than by the symbolic forms. \FAILURE Never fails. \SEEALSO min_type_prec, max_type_prec, term_prec. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/entries/type_to_print_tree.doc0000640000212700021270000000104505071610356024050 0ustar cammcamm\DOC type_to_print_tree \TYPE {type_to_print_tree : (type -> print_tree)} \SYNOPSIS Function for converting a HOL type into a print-tree. \LIBRARY prettyp \FAILURE Never fails. \EXAMPLE { #type_to_print_tree ":* -> bool";; Print_node(`type`, [Print_node(`OP`, [Print_node(`fun`, []); Print_node(`VAR`, [Print_node(`*`, [])]); Print_node(`OP`, [Print_node(`bool`, [])])])]) : print_tree } \SEEALSO term_to_print_tree, thm_to_print_tree, pp_convert_type. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/0000750000212700021270000000000005227260251017766 5ustar cammcammhol88-2.02.19940316/Library/prettyp/help/internals/A_box.doc0000640000212700021270000000022605071610470021505 0ustar cammcamm\DOC A_box \TYPE {A_box : (((nat # string) # *) -> * print_box)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Abs.doc0000640000212700021270000000020205071610470021154 0ustar cammcamm\DOC Abs \TYPE {Abs : (int -> print_indent)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Bound_child.doc0000640000212700021270000000025005071610470022664 0ustar cammcamm\DOC Bound_child \TYPE {Bound_child : ((print_tree # address) -> metavar_binding)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Bound_children.doc0000640000212700021270000000026305071610471023376 0ustar cammcamm\DOC Bound_children \TYPE {Bound_children : ((print_tree # address) list -> metavar_binding)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Bound_name.doc0000640000212700021270000000024205071610471022523 0ustar cammcamm\DOC Bound_name \TYPE {Bound_name : ((string # address) -> metavar_binding)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Bound_names.doc0000640000212700021270000000025105071610471022706 0ustar cammcamm\DOC Bound_names \TYPE {Bound_names : ((string # address) list -> metavar_binding)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/C_box.doc0000640000212700021270000000033305071610471021507 0ustar cammcamm\DOC C_box \BLTYPE C_box : ((((nat # nat # nat) # nat # (int # nat) # * print_box # * print_box) # *)} -> * print_box) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Const_name.doc0000640000212700021270000000025505071610471022546 0ustar cammcamm\DOC Const_name \TYPE {Const_name : ((string # child_metavar list) -> print_patt_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Default.doc0000640000212700021270000000017405071610472022045 0ustar cammcamm\DOC Default \TYPE {Default : loop_limit} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/HV_box.doc0000640000212700021270000000027705071610472021652 0ustar cammcamm\DOC HV_box \BLTYPE HV_box : (((nat # print_indent # nat) # print_object) list -> print_box_spec) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/H_box.doc0000640000212700021270000000023605071610472021517 0ustar cammcamm\DOC H_box \TYPE {H_box : ((nat # print_object) list -> print_box_spec)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/HoV_box.doc0000640000212700021270000000031405071610472022021 0ustar cammcamm\DOC HoV_box \BLTYPE HoV_box : (((nat # print_indent # nat) # print_object) list -> print_box_spec) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Inc.doc0000640000212700021270000000020205071610472021162 0ustar cammcamm\DOC Inc \TYPE {Inc : (int -> print_indent)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Int.doc0000640000212700021270000000017105071610472021210 0ustar cammcamm\DOC Int \TYPE {Int : (nat -> int)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/L_box.doc0000640000212700021270000000025705071610473021527 0ustar cammcamm\DOC L_box \TYPE {L_box : (((nat # nat # * print_box # * print_box) # *) -> * print_box)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Lex_block.doc0000640000212700021270000000025005071610473022357 0ustar cammcamm\DOC Lex_block \TYPE {Lex_block : (((string # string) # string list) -> lex_symb)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Lex_id.doc0000640000212700021270000000020705071610473021663 0ustar cammcamm\DOC Lex_id \TYPE {Lex_id : (string -> lex_symb)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Lex_num.doc0000640000212700021270000000021105071610473022061 0ustar cammcamm\DOC Lex_num \TYPE {Lex_num : (string -> lex_symb)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Lex_spec.doc0000640000212700021270000000021305071610473022216 0ustar cammcamm\DOC Lex_spec \TYPE {Lex_spec : (string -> lex_symb)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Link.doc0000640000212700021270000000032705071610474021360 0ustar cammcamm\DOC Link \BLTYPE Link : ((((loop_limit # loop_limit) # string list) # print_tree # int list) -> print_loop_link) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Link_child.doc0000640000212700021270000000031705071610475022523 0ustar cammcamm\DOC Link_child \BLTYPE Link_child : (((loop_limit # loop_limit) # string list) -> print_patt_tree) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/N_box.doc0000640000212700021270000000017105071610475021526 0ustar cammcamm\DOC N_box \TYPE {N_box : * print_box} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Nat.doc0000640000212700021270000000017105071610476021204 0ustar cammcamm\DOC Nat \TYPE {Nat : (int -> nat)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/No_link.doc0000640000212700021270000000020105071610476022045 0ustar cammcamm\DOC No_link \TYPE {No_link : print_loop_link} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF.doc0000640000212700021270000000021305071610477020765 0ustar cammcamm\DOC PF \TYPE {PF : (print_box_spec -> print_format)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF_H.doc0000640000212700021270000000023205071610500021220 0ustar cammcamm\DOC PF_H \TYPE {PF_H : ((nat # print_object) list -> print_format)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF_HV.doc0000640000212700021270000000027305071610500021353 0ustar cammcamm\DOC PF_HV \BLTYPE PF_HV : (((nat # print_indent # nat) # print_object) list -> print_format) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF_HoV.doc0000640000212700021270000000027505071610500021534 0ustar cammcamm\DOC PF_HoV \BLTYPE PF_HoV : (((nat # print_indent # nat) # print_object) list -> print_format) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF_V.doc0000640000212700021270000000025305071610500021241 0ustar cammcamm\DOC PF_V \TYPE {PF_V : (((print_indent # nat) # print_object) list -> print_format)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF_branch.doc0000640000212700021270000000027505071610500022275 0ustar cammcamm\DOC PF_branch \BLTYPE PF_branch : ((print_test # print_format # print_format) -> print_format) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PF_empty.doc0000640000212700021270000000020005071610500022162 0ustar cammcamm\DOC PF_empty \TYPE {PF_empty : print_format} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PO_constant.doc0000640000212700021270000000022505071610500022675 0ustar cammcamm\DOC PO_constant \TYPE {PO_constant : (string -> print_object)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PO_context_subcall.doc0000640000212700021270000000045005071610501024236 0ustar cammcamm\DOC PO_context_subcall \BLTYPE PO_context_subcall : ((string # (string # ((print_tree # address) list -> (print_tree # address) list)) # (string # print_int_exp) list) -> print_object) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PO_expand.doc0000640000212700021270000000023105071610501022321 0ustar cammcamm\DOC PO_expand \TYPE {PO_expand : (print_box_spec -> print_object)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PO_format.doc0000640000212700021270000000022705071610501022337 0ustar cammcamm\DOC PO_format \TYPE {PO_format : (print_format -> print_object)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PO_leaf.doc0000640000212700021270000000024405071610501021755 0ustar cammcamm\DOC PO_leaf \TYPE {PO_leaf : ((string # (string -> string)) -> print_object)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/PO_subcall.doc0000640000212700021270000000041205071610501022470 0ustar cammcamm\DOC PO_subcall \BLTYPE PO_subcall : (((string # ((print_tree # address) list -> (print_tree # address) list)) # (string # print_int_exp) list) -> print_object) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Patt_child.doc0000640000212700021270000000023505071610502022524 0ustar cammcamm\DOC Patt_child \TYPE {Patt_child : (print_patt_tree -> child_metavar)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Print_label.doc0000640000212700021270000000025405071610502022705 0ustar cammcamm\DOC Print_label \TYPE {Print_label : ((string # print_patt_tree) -> print_patt_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Print_link.doc0000640000212700021270000000033405071610502022562 0ustar cammcamm\DOC Print_link \BLTYPE Print_link : ((((loop_limit # loop_limit) # string list) # print_patt_tree) -> print_patt_tree) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Print_loop.doc0000640000212700021270000000026305071610502022577 0ustar cammcamm\DOC Print_loop \TYPE {Print_loop : ((print_patt_tree # print_patt_tree) -> print_patt_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/UB_H.doc0000640000212700021270000000033105071610502021223 0ustar cammcamm\DOC UB_H \BLTYPE UB_H : (((int -> int -> * print_box) # (nat # (int -> int -> * print_box)) list) -> * unbuilt_box) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/UB_HV.doc0000640000212700021270000000036705071610503021363 0ustar cammcamm\DOC UB_HV \BLTYPE UB_HV : (((int -> int -> * print_box) # ((nat # print_indent # nat) # (int -> int -> * print_box)) list) -> * unbuilt_box) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/UB_HoV.doc0000640000212700021270000000040205071610503021530 0ustar cammcamm\DOC UB_HoV \BLTYPE UB_HoV : (((int -> int -> * print_box) # ((nat # print_indent # nat) # (int -> int -> * print_box)) list) -> * unbuilt_box) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/UB_V.doc0000640000212700021270000000036405071610503021250 0ustar cammcamm\DOC UB_V \BLTYPE UB_V : (((int -> int -> * print_box) # ((print_indent # nat) # (int -> int -> * print_box)) list) -> * unbuilt_box) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/V_box.doc0000640000212700021270000000025705071610503021533 0ustar cammcamm\DOC V_box \TYPE {V_box : (((print_indent # nat) # print_object) list -> print_box_spec)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Val.doc0000640000212700021270000000020005071610504021165 0ustar cammcamm\DOC Val \TYPE {Val : (nat -> loop_limit)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Var_child.doc0000640000212700021270000000022405071610504022344 0ustar cammcamm\DOC Var_child \TYPE {Var_child : (string -> print_patt_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Var_children.doc0000640000212700021270000000023005071610504023046 0ustar cammcamm\DOC Var_children \TYPE {Var_children : (string -> child_metavar)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Var_name.doc0000640000212700021270000000025105071610504022201 0ustar cammcamm\DOC Var_name \TYPE {Var_name : ((string # child_metavar list) -> print_patt_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Wild_child.doc0000640000212700021270000000020705071610504022514 0ustar cammcamm\DOC Wild_child \TYPE {Wild_child : print_patt_tree} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Wild_children.doc0000640000212700021270000000021305071610505023217 0ustar cammcamm\DOC Wild_children \TYPE {Wild_children : child_metavar} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/Wild_name.doc0000640000212700021270000000024005071610505022347 0ustar cammcamm\DOC Wild_name \TYPE {Wild_name : (child_metavar list -> print_patt_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/add_context.doc0000640000212700021270000000026305071610505022751 0ustar cammcamm\DOC add_context \TYPE {add_context : (string -> (string # int) list -> (string # int) list)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/build_print_box.doc0000640000212700021270000000026605071610505023643 0ustar cammcamm\DOC build_print_box \TYPE {build_print_box : (int -> int -> * -> * unbuilt_box -> * print_box)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/change_assocl.doc0000640000212700021270000000026205071610505023245 0ustar cammcamm\DOC change_assocl \TYPE {change_assocl : ((* # **) list -> (* # **) list -> (* # **) list)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/convert_PP.doc0000640000212700021270000000035105071610506022533 0ustar cammcamm\DOC convert_PP \BLTYPE convert_PP : ((print_tree # (string # print_tree) list) -> (print_tree # (string # print_tree) list)) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/copy_chars.doc0000640000212700021270000000030405071610506022604 0ustar cammcamm\DOC copy_chars \BLTYPE copy_chars : (int -> (string -> string) -> string -> (string -> void) -> void) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/generate_ML.doc0000640000212700021270000000030205071610506022632 0ustar cammcamm\DOC generate_ML \BLTYPE generate_ML : (((string # string) -> void) -> string -> print_tree -> void) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/hol_term_rules.doc0000640000212700021270000000021705071610506023500 0ustar cammcamm\DOC hol_term_rules \TYPE {hol_term_rules : print_rule list} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/hol_thm_rules.doc0000640000212700021270000000021505071610506023317 0ustar cammcamm\DOC hol_thm_rules \TYPE {hol_thm_rules : print_rule list} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/hol_type_rules.doc0000640000212700021270000000021705071610506023512 0ustar cammcamm\DOC hol_type_rules \TYPE {hol_type_rules : print_rule list} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/lookup_metavar.doc0000640000212700021270000000025705071610507023512 0ustar cammcamm\DOC lookup_metavar \TYPE {lookup_metavar : (print_binding -> string -> metavar_binding)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/max.doc0000640000212700021270000000061305071610507021243 0ustar cammcamm\DOC max \TYPE {max : (int list -> int)} \SYNOPSIS Function to find the maximum element of a list of integers. \LIBRARY prettyp \FAILURE Fails if the argument is an empty list. \EXAMPLE { #max [2;1;3;5;3;4];; 5 : int #max [];; evaluation failed max -- null list given } \COMMENTS {max} is an internal function of the `{prettyp}' library, but is of general use. \SEEALSO min. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/min.doc0000640000212700021270000000061305071610507021241 0ustar cammcamm\DOC min \TYPE {min : (int list -> int)} \SYNOPSIS Function to find the minimum element of a list of integers. \LIBRARY prettyp \FAILURE Fails if the argument is an empty list. \EXAMPLE { #min [2;1;3;5;3;4];; 1 : int #min [];; evaluation failed min -- null list given } \COMMENTS {min} is an internal function of the `{prettyp}' library, but is of general use. \SEEALSO max. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/num_of_leading_chars.doc0000640000212700021270000000025505071610507024606 0ustar cammcamm\DOC num_of_leading_chars \TYPE {num_of_leading_chars : (string list -> string -> int)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/pp_lang1_rules.doc0000640000212700021270000000021705071610507023371 0ustar cammcamm\DOC pp_lang1_rules \TYPE {pp_lang1_rules : print_rule list} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/pp_lang1_rules_fun.doc0000640000212700021270000000023605071610510024234 0ustar cammcamm\DOC pp_lang1_rules_fun \TYPE {pp_lang1_rules_fun : print_rule_function} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/pp_lang2_rules.doc0000640000212700021270000000021705071610510023364 0ustar cammcamm\DOC pp_lang2_rules \TYPE {pp_lang2_rules : print_rule list} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/pp_lang2_rules_fun.doc0000640000212700021270000000023605071610510024235 0ustar cammcamm\DOC pp_lang2_rules_fun \TYPE {pp_lang2_rules_fun : print_rule_function} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_box_fo.doc0000640000212700021270000000022305071610511023136 0ustar cammcamm\DOC print_box_fo \TYPE {print_box_fo : (* print_box -> int)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_box_height.doc0000640000212700021270000000023305071610511024003 0ustar cammcamm\DOC print_box_height \TYPE {print_box_height : (* print_box -> int)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_box_io.doc0000640000212700021270000000022305071610511023141 0ustar cammcamm\DOC print_box_io \TYPE {print_box_io : (* print_box -> int)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_box_sizes.doc0000640000212700021270000000025705071610511023676 0ustar cammcamm\DOC print_box_sizes \TYPE {print_box_sizes : (* print_box -> ((int # int # int) # int))} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_box_to_strings.doc0000640000212700021270000000027205071610511024731 0ustar cammcamm\DOC print_box_to_strings \TYPE {print_box_to_strings : (bool -> int -> * print_box -> string list)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_box_width.doc0000640000212700021270000000023105071610512023651 0ustar cammcamm\DOC print_box_width \TYPE {print_box_width : (* print_box -> int)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_nat.doc0000640000212700021270000000020605071610512022446 0ustar cammcamm\DOC print_nat \TYPE {print_nat : (nat -> void)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_pattern_match.doc0000640000212700021270000000050005071610512024512 0ustar cammcamm\DOC print_pattern_match \BLTYPE print_pattern_match : (print_pattern -> string -> (string # int) list -> print_tree -> print_binding) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_rule_fun.doc0000640000212700021270000000025305071610512023505 0ustar cammcamm\DOC print_rule_fun \TYPE {print_rule_fun : (print_rule list -> print_rule_function)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_special_fun.doc0000640000212700021270000000047405071610512024163 0ustar cammcamm\DOC print_special_fun \BLTYPE print_special_fun : (string -> (string # int) list -> print_binding -> print_special list -> print_binding) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/print_tree_to_box.doc0000640000212700021270000000056605071610513024207 0ustar cammcamm\DOC print_tree_to_box \BLTYPE print_tree_to_box : (int -> int -> print_rule_function -> string -> (string # int) list -> print_tree -> address print_box) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/raw_tree_rules.doc0000640000212700021270000000021705071610513023475 0ustar cammcamm\DOC raw_tree_rules \TYPE {raw_tree_rules : print_rule list} \SYNOPSIS Internal value of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/read_PP.doc0000640000212700021270000000024105071610513021762 0ustar cammcamm\DOC read_PP \TYPE {read_PP : ((string -> string) -> string -> print_tree)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/read_symb.doc0000640000212700021270000000050605071610513022421 0ustar cammcamm\DOC read_symb \BLTYPE read_symb : ((string -> string) -> string -> (string # string) list -> string list -> string list -> string -> (lex_symb # string)) \ELTYPE \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/replace_box_label.doc0000640000212700021270000000025205071610513024074 0ustar cammcamm\DOC replace_box_label \TYPE {replace_box_label : (* -> * print_box -> * print_box)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/string_contains.doc0000640000212700021270000000023705071610514023662 0ustar cammcamm\DOC string_contains \TYPE {string_contains : (string -> string -> bool)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/string_copies.doc0000640000212700021270000000023205071610514023321 0ustar cammcamm\DOC string_copies \TYPE {string_copies : (string -> int -> string)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/strings_contain.doc0000640000212700021270000000024405071610514023660 0ustar cammcamm\DOC strings_contain \TYPE {strings_contain : (string list -> string -> bool)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/strlen.doc0000640000212700021270000000052405071610514021764 0ustar cammcamm\DOC strlen \TYPE {strlen : (string -> int)} \SYNOPSIS Function to compute the number of characters in a string. \LIBRARY prettyp \FAILURE Never fails. \EXAMPLE { #strlen `abcdef`;; 6 : int #strlen ``;; 0 : int } \COMMENTS {strlen} is an internal function of the `{prettyp}' library, but is of general use. \SEEALSO substr. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/substr.doc0000640000212700021270000000130605071610514021776 0ustar cammcamm\DOC substr \TYPE {substr : (int -> int -> string -> string)} \SYNOPSIS Function to obtain a sub-string of a string. \LIBRARY prettyp \DESCRIBE {substr i l s} computes the sub-string of {s} beginning at the ({i+1})th character and ending at the ({i+l})th character. So, the first {i} characters are discarded, and the next {l} characters are taken as the sub-string. \FAILURE The function fails if the string is not long enough to meet the requirements. \EXAMPLE { #substr 3 4 `abcdefghij`;; `defg` : string #substr 3 4 `abcdef`;; evaluation failed substr -- string too short } \COMMENTS {substr} is an internal function of the `{prettyp}' library, but is of general use. \SEEALSO strlen. \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/trim_enclosing_chars.doc0000640000212700021270000000026005071610515024647 0ustar cammcamm\DOC trim_enclosing_chars \TYPE {trim_enclosing_chars : (string list -> string -> string)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/trim_leading_chars.doc0000640000212700021270000000025405071610515024274 0ustar cammcamm\DOC trim_leading_chars \TYPE {trim_leading_chars : (string list -> string -> string)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/help/internals/trim_trailing_chars.doc0000640000212700021270000000025605071610515024504 0ustar cammcamm\DOC trim_trailing_chars \TYPE {trim_trailing_chars : (string list -> string -> string)} \SYNOPSIS Internal function of the `{prettyp}' library. \LIBRARY prettyp \ENDDOC hol88-2.02.19940316/Library/prettyp/Manual/0000750000212700021270000000000005535605130016255 5ustar cammcammhol88-2.02.19940316/Library/prettyp/Manual/prettyp.log0000640000212700021270000000673205535605247020511 0ustar cammcammThis is TeX, Version 3.1415 (C version 6.1) (format=lplain 94.2.9) 4 MAR 1994 10:15 **prettyp.tex (prettyp.tex LaTeX Version 2.09 <25 March 1992> (/usr/lib/tex/macros/latex/book.sty Standard Document Style `book' <14 Jan 92>. (/usr/lib/tex/macros/latex/bk12.sty) \descriptionmargin=\dimen99 \c@part=\count79 \c@chapter=\count80 \c@section=\count81 \c@subsection=\count82 \c@subsubsection=\count83 \c@paragraph=\count84 \c@subparagraph=\count85 \c@figure=\count86 \c@table=\count87 ) (/usr/lib/tex/macros/latex/fleqn.sty Document style option `fleqn' - Released 04 Nov 91 \mathindent=\dimen100 ) (../../../Manual/LaTeX/alltt.sty) (../../../Manual/LaTeX/layout.sty \@myenumdepth=\count88 \c@myenumi=\count89 ) (../../../Manual/LaTeX/commands.tex \minipagewidth=\skip41 \hsbw=\skip42 \c@sessioncount=\count90 ) (../../../Manual/LaTeX/ref-macros.tex) (win-macros.tex) \@indexfile=\write3 Writing index file prettyp.idx (prettyp.aux (title.aux) (intro.aux) (language.aux) (functions.aux) (datatypes.aux) (link_to_hol.aux) (debugging.aux) (examples.aux) (algorithm.aux ) (holppspec.aux) (references.aux) (syntax.aux) (types.aux) (entries.aux) (index.aux)) (title.tex [1 ] [2]) (prettyp.toc [3 ] [4]) \tf@toc=\write4 [5] [6 ] (intro.tex Chapter 1. [1 ] [2] [3] [4] [5] [6] [7] [8] [9] [10] [11] [12] [13] [14] [15] [16] [17]) [18] (language.tex Chapter 2. [19 ] [20] [21] [22] [23] [24] [25] [26] [27] [28] [29] [30] [31] [32] [33] [34] [35] [36] [37] [38] [39]) [40] (functions.tex Chapter 3. [41 ] [42] [43] [44] [45] [46]) [47] (datatypes.tex [48 ] Chapter 4. [49]) [50] (link_to_hol.tex Chapter 5. [51 ] [52] [53] [54] [55] [56] [57] [58] [59] [60]) [61] (debugging.tex [62 ] Chapter 6. [63]) [64] (examples.tex Chapter 7. [65 ] [66] [67] [68] [69] [70] [71] [72] [73] [74] [75] [76] [77] [78] [79] [80]) [81] (algorithm.tex [82 ] Chapter 8. (ppboxmacros.tex) [83] [84] [85] [86] [87] [88] [89] [90]) [91] (holppspec.tex [92 ] Chapter 9. [93] [94] [95] [96] [97] [98] [99] [100] [101] [102]) [103] (references.tex [104 ]) [105] (syntax.tex [106 ] Appendix A. [107] [108] [109] [110]) [111] (types.tex [112 ] Appendix B. ) [113] (entries.tex [114 ] Appendix C. (entries-intro.tex) Underfull \vbox (badness 10000) has occurred while \output is active \vbox(640.187+0.0)x455.24408, glue set 4.71832 .\write2{\@writefile{toc}{\string\contentsline\space {chapter}{\string\numberl\ ETC.} .\mark{{{Appendix\ C. \ ML Functions in the prettyp Library}}{}} .\write2{\@writefile{lof}{\string\addvspace\space {10\p@ }}} .\write2{\@writefile{lot}{\string\addvspace\space {10\p@ }}} .\glue(\topskip) 2.00002 .etc. [115] [116] [117] [118] [119] [120] [121] [122] [123] [124] [125] [126] [127] [128] [129] [130] [131] [132] [133] [134] [135] [136] [137] [138] [139] [140] [141] [142] [143] [144] [145] [146] [147] [148]) [149] (index.tex [150 ] [151 ]) (prettyp.aux (title.aux) (intro.aux) (language.aux) (functions.aux) (datatyp es.aux) (link_to_hol.aux) (debugging.aux) (examples.aux) (algorithm.aux) (holppspec.aux) (references.aux) (syntax.aux) (types.aux) (entries.aux) (index.aux)) ) Here is how much of TeX's memory you used: 691 strings out of 11977 5672 string characters out of 87025 49607 words of memory out of 262141 2360 multiletter control sequences out of 9500 19472 words of font info for 74 fonts, out of 100000 for 255 14 hyphenation exceptions out of 607 18i,12n,27p,206b,458s stack positions out of 300i,100n,60p,3000b,4000s Output written on prettyp.dvi (157 pages, 363300 bytes). hol88-2.02.19940316/Library/prettyp/Manual/intro.tex0000640000212700021270000007463105104513625020145 0ustar cammcamm \chapter{Introduction\label{intro}} This document describes the facilities provided by the \ml{prettyp} library for the \HOL\ system~\cite{description}. The library is a pretty-printer based on the Pretty-Printing Meta-Language (\PPML) for the \CENTAUR\ system~\cite{PPML}. It is intended as a tool for embedding languages within the \HOL\ logic. To be truly useful it should be used along with a special parser for the embedded language. Although such applications only require \HOL\ terms to be pretty-printed, the system described here can be used to pretty-print any tree structure (after undergoing translation). The pretty-printing program converts a tree represented as a particular \ML\ datatype to text, using a set of rules. The user must provide these rules. A parser for a special-purpose language is provided to facilitate this. The parser generates a file which can be read into the \HOL\ system. The file contains declarations of \ML\ values. These values are the rules used by the pretty-printer. To pretty-print a tree structure, the tree must be converted (usually by an \ML\ function) to the particular datatype used by the pretty-printer. Functions are provided with the system for converting \HOL\ types and terms. Chapter~\ref{language} describes the pretty-printing language in detail. Chapter~\ref{mldatatypes} describes the techniques required to convert an arbitrary tree structure to the datatype used by the pretty-printer. Linking specialised pretty-printers into the standard \HOL\ pretty-printer is discussed in Chapter~\ref{linking}, including the functions to convert \HOL\ types and terms to trees which the pretty-printer can use. Chapter~\ref{examples} gives examples of defining rules for a variety of languages. The remainder of this chapter illustrates the process of building a new pretty-printer. Some notation of set theory is added to the standard \HOL\ pretty-printer. First, though, the loading of the library is described. \section{Loading the library} The \ml{prettyp} library can be loaded into a \HOL\ session using the function \ml{load\_library}\index{load\_library@{\ptt load\_library}} (see the \HOL\ manual for a general description of library loading). The first action in the load sequence initiated by \ml{load\_library} is to update the \HOL\ help\index{help!updating search path} search path. The help search path is updated with pathnames to online help files for the \ML\ functions in the library. After updating the help search path, the \ML\ functions in the library are loaded into \HOL. There are three code files in the library of importance to the user. The first is called {\small\verb%PP_printer.ml%}. This file must be loaded in order to do anything with the pretty-printer. It is the main pretty-printing program. The file {\small\verb%PP_parser.ml%} can be loaded after {\small\verb%PP_printer.ml%}. It is the compiler for the pretty-printing language. It also contains a pretty-printer for the pretty-printing language! The file {\small\verb%PP_hol.ml%} can also be loaded after {\small\verb%PP_printer.ml%}. It contains functions for converting \HOL\ types, terms and theorems into parse-trees. It also contains a complete pretty-printer for the \HOL\ logic. When loaded, the standard \HOL\ pretty-printer is replaced by these new printers. {\small\verb%PP_hol.ml%} is required for any extension to the pretty-printing of \HOL\ types, terms or theorems. Note that {\small\verb%PP_parser.ml%} and {\small\verb%PP_hol.ml%} do not require each other to be resident to work. They can however be resident together. Use of \ml{load\_library} loads all three of the files. The following session shows how the entire \ml{prettyp} library can be loaded: \setcounter{sessioncount}{1} \begin{session}\begin{verbatim} #load_library `prettyp`;; Loading library `prettyp` ... Updating help search path ............................................................................. ............................................................................. ............................................................................. ............................................................. Library `prettyp` loaded. () : void # \end{verbatim}\end{session} If the user wants to load only one or two of the three files, they can be loaded separately. As an example of this, {\small\verb%PP_printer.ml%} can be loaded using one of the following \ML\ function calls: \begin{small}\begin{verbatim} loadf (library_pathname() ^ `/prettyp/PP_printer`);; loadt (library_pathname() ^ `/prettyp/PP_printer`);; \end{verbatim}\end{small} \noindent where the former loads `quietly' and the latter displays details of the declarations made within the file. \section{Example: a pretty-printer for set theory in HOL} \setcounter{sessioncount}{1} \newwindow{{\small\tt sets.pp}} This section illustrates the development process for an extension to the \HOL\ pretty-printer. Throughout the example we assume the user has two windows. A \HOL\ session is running within the first window, which is represented by a box of the following form: \begin{session}\begin{verbatim} ... \end{verbatim}\end{session} \noindent The other window is an editor in which a file named {\small\verb%sets.pp%} is being edited. The editor is represented by: \begin{window}\begin{verbatim} ... \end{verbatim}\end{window} \setcounter{sessioncount}{1} \noindent We begin by running \HOL\ and loading three files from the library \ml{prettyp}. \begin{session}\begin{verbatim} _ _ __ _ __ __ |___ |__| | | | |__| |__| | | | |__| |__ |__| |__| Version 2 #loadf (library_pathname() ^ `/prettyp/PP_printer`);; Updating help search path ............................................................................. .......................................() : void #loadf (library_pathname() ^ `/prettyp/PP_parser`);; Updating help search path ............................................................................. ...................................................................... () : void #loadf (library_pathname() ^ `/prettyp/PP_hol`);; Updating help search path .................................() : void \end{verbatim}\end{session} \noindent The first file is the main pretty-printing program. It must always be loaded when the pretty-printer is being used. The second file is a parser for the pretty-printing language. The first file must always be loaded before the second. The parser generates a file of \ML\ declarations. The third file is a replacement for the standard \HOL\ pretty-printer. It has been written using the pretty-printer described here. This allows it to be extended with the special-purpose syntax. The next thing to do is to load the library whose syntax we wish to extend: \begin{session}\begin{verbatim} #load_library `sets`;; Loading library `sets` ... Updating search path .Theory sets loaded ..................... Library `sets` loaded. () : void \end{verbatim}\end{session} \noindent The constant {\small\verb%EMPTY%} is now defined within the \HOL\ system. It represents an empty set. Observe that no special syntax is attached to the constant. \begin{session}\begin{verbatim} #"EMPTY:(*)set";; "EMPTY" : term \end{verbatim}\end{session} \noindent Now we enter a small pretty-printer specification into the editor window. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; end rules end prettyprinter \end{verbatim}\end{window} \noindent The name of the pretty-printer is specified as {\small\verb%sets%}. There is one rule. The rule instructs \HOL\ to print {\small\verb%{}%} whenever it encounters the constant {\small\verb%EMPTY%}. There are two parts to the rule: a {\it pattern\/} and a {\it format}. These are separated by {\small\verb%->%}. When printing, the system compares the pattern to the term which is to be printed. In the example, the pattern matches the term only if the current {\it context\/} is {\small\verb%'term'%}. The context is a string of characters which is specified when the pretty-printer is called. It may also be modified by a rule during the printing process. The rest of the pattern represents the tree structure of a \HOL\ term. So, for the pattern to match a term, the term must represent the constant {\small\verb%EMPTY%}. The {\small\verb%**%} in the pattern is used to match optional type information. We shall not concern ourselves with this notation at the moment. The format consists of a {\it box}, the components of which are to be composed horizontally with no space between them. In the example, the box has only one component, so the composition information is not required. The format instructs the printer to display {\small\verb%{}%}. The double quotation-marks are used to delimit a string which is to be displayed verbatim. So, whenever the pattern matches, the format is used to determine what to display. Let's see this in action. First the file must be saved. Then we instruct \HOL\ to convert the pretty-printer specification into a file of \ML\ declarations. \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void \end{verbatim}\end{session} \noindent There should now be a file called {\small\verb%sets_pp.ml%}. This contains two \ML\ declarations. The first declares \ml{sets\_rules} to be a list of pretty-printing rules as understood by the pretty-printing program. The second declares \ml{sets\_rules\_fun} to be a function which embodies the properties of the rules. The names of the identifiers are derived from the name of the pretty-printer specification given in the file. The function \ml{PP\_to\_ML} invokes the parser. Its first argument indicates whether the output is to be appended to the specified file. In the example the output is not appended, i.e.~if the destination file existed previously it will be overwritten. The second argument is the name of the source file. The name of the source file must end in {`}{\small\verb%.pp%}{'}. The {`}{\small\verb%.pp%}{'} may be omitted from the name given as the second argument. The third argument is the name of the destination file. This should either be given in full, or if, as in the example, a null string is given, the parser will replace the {`}{\small\verb%.pp%}{'} of the source file name with {`}{\small\verb%_pp.ml%}{'}. We can now load the file of \ML\ declarations, and instruct \HOL\ to add them to its existing pretty-printing rules. \begin{session}\begin{verbatim} #loadt `sets_pp`;; sets_rules = [((`term`, (Const_name(`CONST`, [Patt_child(Const_name(`EMPTY`, [])); Wild_children])), -), [], PF(H_box[(0, PO_constant `{}`)]))] : print_rule list sets_rules_fun = - : print_rule_function File sets_pp loaded () : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \noindent \ml{top\_print} is an \ML\ directive which given a function of type {\small\verb%(%}{\it type\/} {\small\verb%->%} {\small\verb%void)%} installs that function as a printer for any object of type {\it type}. \ml{pp} is an \ML\ function which pretty-prints in a way (almost) compatible with the standard \HOL\ pretty-printer. That is, when used with \ml{top\_print}, the text it produces merges properly with the surrounding text produced by other means. The first argument to \ml{pp} is a `rule function'. In the example this is made by composing three `rule functions' together using \ml{then\_try}. The rules of \ml{sets\_rules\_fun} are tried first. If none of these match, the standard \HOL\ rules are tried, first those for terms, then those for types\footnote{If no rules match, default rules will be used which print the object as a tree structure.}. The second argument is the {\it context\/} mentioned above. The third is a list of parameters, which is empty in the example. The fourth argument is an object of a type defined within the pretty-printer. The type represents a parse-tree. In the example, the term to be pretty-printed is converted into a parse-tree using the function \ml{pp\_convert\_term}. This function is defined within the pretty-printer, specifically the part of it concerned with printing \HOL\ terms. {\small\verb%EMPTY%} is now printed as {\small\verb%{}%}. \begin{session}\begin{verbatim} #"EMPTY:(*)set";; "{}" : term \end{verbatim}\end{session} \noindent We have not yet attached special syntax to non-empty sets. \begin{session}\begin{verbatim} #"INSERT 1 (EMPTY:(num)set)";; "1 INSERT {}" : term \end{verbatim}\end{session} \noindent The constant {\small\verb%INSERT%} is an infix. It is used to form a new set from a set and the element to be added. We can add a rule to pretty-print this. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**)) -> [ "{" *elem "}"]; end rules end prettyprinter \end{verbatim}\end{window} \noindent The new rule matches something of the form: \begin{small}\begin{verbatim} (INSERT *elem) EMPTY \end{verbatim}\end{small} \noindent The {\it metavariable\/} {\small\verb%*elem%} matches any tree, and becomes bound to that tree. When {\small\verb%*elem%} is used within the format, the pretty-printer is called recursively on the tree it is bound to. In the example, if the new rule matches the tree to be printed, the sub-tree bound to {\small\verb%*elem%} is printed enclosed within braces. To print the sub-tree, the system tries to match rules to it, beginning from the first rule, {\em not\/} the rule following the one just used. If neither of our new rules match the sub-tree, the rules for standard \HOL\ will be tried. So, let's save the file, recompile it, load the generated code and link the new rules into the pretty-printer. \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \noindent Now we try the example again. \begin{session}\begin{verbatim} #"INSERT 1 (EMPTY:(num)set)";; "{1}" : term \end{verbatim}\end{session} \noindent Unfortunately our rules do not work for sets of two or more elements. \begin{session}\begin{verbatim} #"INSERT 1 (INSERT 2 (EMPTY:(num)set))";; "1 INSERT {2}" : term #"INSERT 1 (INSERT 2 (INSERT 3 (EMPTY:(num)set)))";; "1 INSERT (2 INSERT {3})" : term \end{verbatim}\end{session} \noindent The problem is that the second rule only matches when the set into which the new element is being `inserted' is the empty set. We can make the pattern more general by replacing the part of it which matches {\small\verb%EMPTY%} with a metavariable. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ "{" *elem "," *elems "}"]; end rules end prettyprinter \end{verbatim}\end{window} \noindent We process the file again. \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \noindent Try the examples. \begin{session}\begin{verbatim} #"INSERT 1 (EMPTY:(num)set)";; "{1,{}}" : term #"INSERT 1 (INSERT 2 (EMPTY:(num)set))";; "{1,{2,{}}}" : term \end{verbatim}\end{session} \noindent Not quite what we wanted. Once we have matched the second rule, and sent out the braces, we want to treat an {\small\verb%INSERT%} in a different way. We can do this by adding an extra rule which matches in a different context to the others. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ 'term'::*elem "," *elems]; 'term'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ "{" *elem "," 'term_set'::*elems "}"]; end rules end prettyprinter \end{verbatim}\end{window} \noindent We also change the last rule so that the recursive call it makes to process the remainder of the set is made in the context {\small\verb%'term_set'%}. \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \begin{session}\begin{verbatim} #"INSERT 1 (EMPTY:(num)set)";; "{1,CONST(EMPTY)}" : term #"INSERT 1 (INSERT 2 (EMPTY:(num)set))";; "{1,2,CONST(EMPTY)}" : term \end{verbatim}\end{session} \noindent We now have no rule to match {\small\verb%EMPTY%} when it appears as an argument to {\small\verb%INSERT%}. Since we have also changed context, the \HOL\ rules no longer apply either. So, {\small\verb%EMPTY%} is displayed as its tree representation. We could easily add a rule to match {\small\verb%EMPTY%}, so that the {\small\verb%EMPTY%} is just thrown away. However, observe that we would still have a trailing comma before the right-hand brace. Instead, we can add a rule to deal with the last element of the set in a special way. Note that the new rule must come before the other rule which applies in the context {\small\verb%'term_set'%}, so that it takes priority over that rule. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**)) -> [ 'term'::*elem]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ 'term'::*elem "," *elems]; 'term'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ "{" *elem "," 'term_set'::*elems "}"]; end rules end prettyprinter \end{verbatim}\end{window} \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \begin{session}\begin{verbatim} #"INSERT 1 (EMPTY:(num)set)";; "{1,CONST(EMPTY)}" : term #"INSERT 1 (INSERT 2 (EMPTY:(num)set))";; "{1,2}" : term \end{verbatim}\end{session} \noindent Our rules now work for sets of two or more elements, but not for sets of only one element. This is because the last rule consumes the first {\small\verb%INSERT%}, leaving just {\small\verb%EMPTY%} for a one element set, and there is no rule to match {\small\verb%EMPTY%} in the context {\small\verb%'term_set'%}. We need to change the last rule so that it matches in the same situations, and displays the braces, but the tree it passes on in the changed context is the tree it was given, not some sub-tree of it. We do this by labelling a node of the tree with a metavariable. This is denoted by {\small\verb%|*elems|%}. The sub-trees that were being bound to metavariables no longer need to be. We can therefore use {\small\verb%*%} without a name to mean `match any sub-tree'. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**)) -> [ 'term'::*elem]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ 'term'::*elem "," *elems]; 'term'::|*elems|COMB(COMB(CONST(INSERT(),**),*),*) -> [ "{" 'term_set'::*elems "}"]; end rules end prettyprinter \end{verbatim}\end{window} \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \begin{session}\begin{verbatim} #"INSERT 1 (EMPTY:(num)set)";; "{1}" : term #"INSERT 1 (INSERT 2 (EMPTY:(num)set))";; "{1,2}" : term \end{verbatim}\end{session} \noindent Having worked hard to get here, our rules are still not quite right. In all the formats the objects displayed are composed horizontally. This means that all the text must appear on the same line. If the textual representation of the set is longer than the length of one line it will overflow. We need to specify where the set can be broken between lines. The obvious place to break the set is after a comma. So if the line length was very small, we might get output of the form: \begin{small}\begin{verbatim} {1,2,3,4, 5,6} \end{verbatim}\end{small} \noindent We can achieve this form of {\it inconsistent\/} breaking by some simple changes to our rules. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**)) -> [ 'term'::*elem]; 'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems) -> [ [ 'term'::*elem ","] *elems]; 'term'::|*elems|COMB(COMB(CONST(INSERT(),**),*),*) -> [ "{" 'term_set'::*elems "}"]; end rules end prettyprinter \end{verbatim}\end{window} \noindent A box labelled with {\small\verb%%} in a format means that the components of the box should appear on the same line separated by {\it dx\/} spaces, but if this is not possible, the components which will not fit on the line can go on a new line separated from the previous line by {\it dh\/} blank lines. The text of the new line begins {\it di\/} spaces to the right of the beginning of the first component of the box. \vfill In our example the box of this type has two components. The first is itself a box which instructs the printer to display the element of the set followed by a comma {\em which must go on the same line}. The second component is the remainder of the set. \vfill Let's try out the modified rules. \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \begin{session}\begin{verbatim} #let test = "INSERT 1 (INSERT 2 (INSERT 3 (INSERT 4 (INSERT 5 (INSERT 6 #(EMPTY:(num)set))))))";; test = "{1,2,3,4,5,6}" : term #set_margin 15;; 72 : int #test;; "{1,2,3,4,5,6}" : term #set_margin 14;; 15 : int #test;; "{1, 2,3,4,5,6}" : term #set_margin 12;; 14 : int #test;; "{1, 2, 3,4,5,6}" : term #set_margin 72;; 12 : int \end{verbatim}\end{session} \vfill \noindent The rules are not doing what we want. This is because instead of having all the elements of the set appear at the same level of a single box, they occur at different levels in a chain of nested boxes\footnote{The nesting is not explicit in the rules, but occurs by way of the recursive calls to the printer.}. To be able to express a relationship between {\em all\/} the elements of the set, we need to be able to grab them all in one call to the printer, so that we may place them all at the same box level. There is a special pattern which allows us to do this. The {\it looping\/} construct consists of two patterns. The first is enclosed within square brackets. It is followed by the second pattern. The combined pattern tries to match the first pattern zero or more times, and when the first no longer matches it tries to match the second exactly once. This probably requires further explanation. We begin by looking at the rule for our example. \begin{window}\begin{verbatim} prettyprinter sets = rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term'::[COMB(COMB(CONST(INSERT(),**),*elems),<>COMB(**))] COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**)) -> [ "{" [ **[ *elems ","] *elem] "}"]; end rules end prettyprinter \end{verbatim}\end{window} \vfill \noindent The {\small\verb%<>%} within the first part of the looping pattern is used to label the sub-tree which will be used on the next match attempt (the next time round the loop). This will typically appear without any pattern following it. This would indicate that no restriction is being placed on the sub-tree to be used on the next match attempt. However in the example, {\small\verb%<>%} is followed by {\small\verb%COMB(**)%}. This specifies that the sub-tree must have a {\small\verb%COMB%} as its root node. The looping part of the pattern matches a chain of {\small\verb%INSERT%}s. The representation of a set is such a chain. However, the last {\small\verb%INSERT%} in the chain is not matched by the looping part of the pattern, because the sub-tree to be used on the next match attempt does not have {\small\verb%COMB%} as its root (This is assuming that the chain of {\small\verb%INSERT%}s is terminated by an {\small\verb%EMPTY%}). For those {\small\verb%INSERT%}s which are matched during the loop, the elements being `inserted' are bound as a list to the metavariable {\small\verb%*elems%}. When the looping terminates, we are left with something of the form: \begin{small}\begin{verbatim} (INSERT *elem) EMPTY \end{verbatim}\end{small} \noindent which as we have seen before is matched by the remainder of the pattern. We bind the last element separately because it needs to be treated differently in the format. (The last element is not followed by a comma). The {\small\verb%**[ *elems ","]%} in the format expands to a sequence of boxes, one for each element bound to {\small\verb%*elems%}, in which the element is followed by a comma (on the same line). There is a lot more to be said about these looping patterns and expanding boxes, but we shall not go into it here. Instead let's see if the new rules really do do what we want. \begin{session}\begin{verbatim} #PP_to_ML false `sets` ``;; () : void #loadf `sets_pp`;; ..() : void #top_print (\t. pp (sets_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `term` [] (pp_convert_term t));; - : (term -> void) \end{verbatim}\end{session} \vfill \begin{session}\begin{verbatim} #test;; "{1,2,3,4,5,6}" : term #set_margin 14;; 72 : int #test;; "{1,2,3,4,5, 6}" : term #set_margin 12;; 14 : int #test;; "{1,2,3,4, 5,6}" : term #set_margin 72;; 12 : int \end{verbatim}\end{session} \vfill \noindent There is one more thing to say before leaving the example. The pretty-printer for \HOL\ terms uses a parameter called {`}{\small\verb%prec%}{'} to hold the precedence of the parent operator. If a rule does not explicitly modify this parameter, it is passed on unchanged to recursive calls of the printer. The braces of the set notation prevent any ambiguity, so we do not need to know the precedence of the parent operator. If within a set we consider the separating commas to have the lowest possible precedence, then the elements of the set should not appear enclosed within parentheses. We force this by making {`}{\small\verb%prec%}{'} have its highest possible value (which corresponds to the lowest precedence) for all recursive calls of the printer. \begin{window}\begin{verbatim} prettyprinter sets = abbreviations max_prec = {apply0 max_term_prec}; end abbreviations rules 'term'::CONST(EMPTY(),**) -> [ "{}"]; 'term'::[COMB(COMB(CONST(INSERT(),**),*elems),<>COMB(**))] COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**)) -> [ "{" [ **[ *elems with prec := max_prec end with ","] *elem with prec := max_prec end with] "}"]; end rules end prettyprinter \end{verbatim}\end{window} \vfill \noindent \ml{max\_prec} is a value suitable for use within the pretty-printing language. It is derived from the value of the \ML\ identifier \ml{max\_term\_prec}. The value of \ml{max\_term\_prec} is the largest possible precedence value (lowest precedence) for a \HOL\ `operator'. The transformation from \ml{max\_term\_prec} to \ml{max\_prec} is explained in Chapter~\ref{functions}. \section{CAUTION!} \setcounter{sessioncount}{1} \newwindow{{\small\tt bad.pp}} The previous section illustrates how the \HOL\ pretty-printer can be extended. It should not be hard to see that the same methods could be used to {\em modify\/} the \HOL\ pretty-printer. For example, consider the following pretty-printer which performs an exceedingly undesirable transformation. \begin{window}\begin{verbatim} prettyprinter bad = rules 'term'::CONST(F(),**) -> [ "T"]; end rules end prettyprinter \end{verbatim}\end{window} \noindent We can make use of this in a \HOL\ session. First we enter \HOL\ and load the library \ml{prettyp}. \begin{session}\begin{verbatim} _ _ __ _ __ __ |___ |__| | | | |__| |__| | | | |__| |__ |__| |__| Version 2 #load_library `prettyp`;; Loading library `prettyp` ... Updating help search path ............................................................................. ............................................................................. ............................................................................. ............................................................. Library `prettyp` loaded. () : void \end{verbatim}\end{session} \noindent Now we look at the definition of {\it false}. \begin{session}\begin{verbatim} #let test = F_DEF;; test = |- F = (!t. t) \end{verbatim}\end{session} \noindent The new pretty-printer can be compiled, loaded and linked into the \HOL\ system: \begin{session}\begin{verbatim} #PP_to_ML false `bad` ``;; () : void #loadf `bad_pp`;; ..() : void #top_print (\t. pp (bad_rules_fun then_try # hol_thm_rules_fun then_try # hol_term_rules_fun then_try # hol_type_rules_fun) `thm` [] (pp_convert_thm t));; - : (thm -> void) \end{verbatim}\end{session} \noindent The result is a theorem which, although perfectly valid in the underlying representation, appears to the user in a very unpleasant form. \begin{session}\begin{verbatim} #test;; |- T = (!t. t) \end{verbatim}\end{session} hol88-2.02.19940316/Library/prettyp/Manual/prettyp.tex0000640000212700021270000000537705104513667020530 0ustar cammcamm% ===================================================================== % HOL Manual LaTeX Source: prettyp library (standard latex style) % ===================================================================== \documentstyle[12pt,fleqn, ../../../Manual/LaTeX/alltt, ../../../Manual/LaTeX/layout]{book} % --------------------------------------------------------------------- % Input defined macros and commands % --------------------------------------------------------------------- \input{../../../Manual/LaTeX/commands} \input{../../../Manual/LaTeX/ref-macros} % --------------------------------------------------------------------- % Additional macros and commands % --------------------------------------------------------------------- \input{win-macros} \def\PPML{{\small PPML}} \def\CENTAUR{{\small CENTAUR}} %\includeonly{entries} % --------------------------------------------------------------------- % The document has an index % --------------------------------------------------------------------- \makeindex \begin{document} \setlength{\unitlength}{1mm} % unit of length = 1mm \setlength{\baselineskip}{16pt} % line spacing = 16pt % --------------------------------------------------------------------- % prelims % --------------------------------------------------------------------- \pagenumbering{roman} % roman page numbers for prelims \setcounter{page}{1} % start at page 1 \include{title} % title page \tableofcontents % table of contents % --------------------------------------------------------------------- % Systematic description of the library % --------------------------------------------------------------------- \cleardoublepage % kick to a right-hand page \pagenumbering{arabic} % arabic page numbers \setcounter{page}{1} % start at page 1 \include{intro} \include{language} \include{functions} \include{datatypes} \include{link_to_hol} \include{debugging} \include{examples} \include{algorithm} \include{holppspec} % --------------------------------------------------------------------- % References % --------------------------------------------------------------------- \include{references} % --------------------------------------------------------------------- % Appendices % --------------------------------------------------------------------- \appendix \include{syntax} \include{types} \include{entries} % --------------------------------------------------------------------- % Index % --------------------------------------------------------------------- {\def\_{{\char'137}} % \tt style `_' character \include{index}} \end{document} hol88-2.02.19940316/Library/prettyp/Manual/prettyp.idx0000640000212700021270000001251205535605247020505 0ustar cammcamm\indexentry{load\_library@{\ptt load\_library}}{1} \indexentry{help!updating search path}{1} \indexentry{line breaks!inconsistent}{31} \indexentry{line breaks!consistent}{31} \indexentry{node-names!non-alphanumeric}{39} \indexentry{node-names!clashing with reserved words}{39} \indexentry{sub-tree addresses|(}{41} \indexentry{address!of sub-trees|(}{41} \indexentry{address!of sub-trees|)}{42} \indexentry{sub-tree addresses|)}{42} \indexentry{context in the environment}{43} \indexentry{node-names!one rule for several names}{43} \indexentry{is\_a\_member\_of@{\ptt is\_a\_member\_of}|pin}{43} \indexentry{bound\_number@{\ptt bound\_number}|pin}{44} \indexentry{bound\_name@{\ptt bound\_name}|pin}{44} \indexentry{bound\_names@{\ptt bound\_names}|pin}{44} \indexentry{bound\_child@{\ptt bound\_child}|pin}{44} \indexentry{bound\_children@{\ptt bound\_children}|pin}{44} \indexentry{context in the environment}{44} \indexentry{bound\_context@{\ptt bound\_context}|pin}{44} \indexentry{apply1@{\ptt apply1}|pin}{45} \indexentry{apply2@{\ptt apply2}|pin}{45} \indexentry{apply0@{\ptt apply0}|pin}{46} \indexentry{new\_name@{\ptt new\_name}|pin}{46} \indexentry{new\_names@{\ptt new\_names}|pin}{46} \indexentry{new\_child@{\ptt new\_child}|pin}{46} \indexentry{new\_children@{\ptt new\_children}|pin}{46} \indexentry{type\_to\_print\_tree@{\ptt type\_to\_print\_tree}|pin}{51} \indexentry{term\_to\_print\_tree@{\ptt term\_to\_print\_tree}|pin}{53} \indexentry{thm\_to\_print\_tree@{\ptt thm\_to\_print\_tree}|pin}{54} \indexentry{pp\_convert\_term@{\ptt pp\_convert\_term}|pin}{55} \indexentry{pp\_convert\_type@{\ptt pp\_convert\_type}|pin}{56} \indexentry{pp\_convert\_thm@{\ptt pp\_convert\_thm}|pin}{56} \indexentry{pp\_convert\_all\_thm@{\ptt pp\_convert\_all\_thm}|pin}{56} \indexentry{PP\_to\_ML@{\ptt PP\_to\_ML}|pin}{56} \indexentry{filenames}{56} \indexentry{pretty\_print@{\ptt pretty\_print}|pin}{57} \indexentry{pp@{\ptt pp}|pin}{58} \indexentry{pp\_write@{\ptt pp\_write}|pin}{58} \indexentry{hol\_type\_rules\_fun@{\ptt hol\_type\_rules\_fun}|pin}{58} \indexentry{hol\_term\_rules\_fun@{\ptt hol\_term\_rules\_fun}|pin}{58} \indexentry{hol\_thm\_rules\_fun@{\ptt hol\_thm\_rules\_fun}|pin}{58} \indexentry{then\_try@{\ptt then\_try}|pin}{58} \indexentry{print-rule functions!composition of}{58} \indexentry{hol\_rules\_fun@{\ptt hol\_rules\_fun}|pin}{59} \indexentry{print-rules!defaults}{59} \indexentry{raw\_tree\_rules\_fun@{\ptt raw\_tree\_rules\_fun}|pin}{59} \indexentry{goals}{61} \indexentry{precedence}{76} \indexentry{precedence!in HOL terms}{94} \indexentry{associative operators in HOL terms}{96} \indexentry{Address@{\ptt Address}}{115} \indexentry{All\_types@{\ptt All\_types}}{116} \indexentry{apply0@{\ptt apply0}}{117} \indexentry{apply1@{\ptt apply1}}{118} \indexentry{apply2@{\ptt apply2}}{119} \indexentry{bound\_child@{\ptt bound\_child}}{120} \indexentry{bound\_children@{\ptt bound\_children}}{120} \indexentry{bound\_context@{\ptt bound\_context}}{121} \indexentry{bound\_name@{\ptt bound\_name}}{122} \indexentry{bound\_names@{\ptt bound\_names}}{122} \indexentry{bound\_number@{\ptt bound\_number}}{123} \indexentry{get\_margin@{\ptt get\_margin}}{124} \indexentry{Hidden\_types@{\ptt Hidden\_types}}{124} \indexentry{hol\_rules\_fun@{\ptt hol\_rules\_fun}}{125} \indexentry{hol\_term\_rules\_fun@{\ptt hol\_term\_rules\_fun}}{125} \indexentry{hol\_thm\_rules\_fun@{\ptt hol\_thm\_rules\_fun}}{125} \indexentry{hol\_type\_rules\_fun@{\ptt hol\_type\_rules\_fun}}{126} \indexentry{is\_a\_member\_of@{\ptt is\_a\_member\_of}}{126} \indexentry{max\_term\_prec@{\ptt max\_term\_prec}}{127} \indexentry{max\_type\_prec@{\ptt max\_type\_prec}}{127} \indexentry{min\_term\_prec@{\ptt min\_term\_prec}}{128} \indexentry{min\_type\_prec@{\ptt min\_type\_prec}}{128} \indexentry{new\_child@{\ptt new\_child}}{128} \indexentry{new\_children@{\ptt new\_children}}{129} \indexentry{new\_name@{\ptt new\_name}}{130} \indexentry{new\_names@{\ptt new\_names}}{131} \indexentry{No\_address@{\ptt No\_address}}{132} \indexentry{No\_types@{\ptt No\_types}}{133} \indexentry{pp@{\ptt pp}}{133} \indexentry{pp\_convert\_all\_thm@{\ptt pp\_convert\_all\_thm}}{134} \indexentry{pp\_convert\_term@{\ptt pp\_convert\_term}}{135} \indexentry{pp\_convert\_thm@{\ptt pp\_convert\_thm}}{135} \indexentry{pp\_convert\_type@{\ptt pp\_convert\_type}}{136} \indexentry{pp\_print\_all\_thm@{\ptt pp\_print\_all\_thm}}{137} \indexentry{pp\_print\_term@{\ptt pp\_print\_term}}{137} \indexentry{pp\_print\_theory@{\ptt pp\_print\_theory}}{137} \indexentry{pp\_print\_thm@{\ptt pp\_print\_thm}}{138} \indexentry{pp\_print\_type@{\ptt pp\_print\_type}}{138} \indexentry{PP\_to\_ML@{\ptt PP\_to\_ML}}{139} \indexentry{pp\_write@{\ptt pp\_write}}{140} \indexentry{pretty\_print@{\ptt pretty\_print}}{141} \indexentry{Print\_node@{\ptt Print\_node}}{142} \indexentry{print\_tree\_children@{\ptt print\_tree\_children}}{142} \indexentry{print\_tree\_name@{\ptt print\_tree\_name}}{142} \indexentry{raw\_tree\_rules\_fun@{\ptt raw\_tree\_rules\_fun}}{143} \indexentry{term\_prec@{\ptt term\_prec}}{143} \indexentry{term\_to\_print\_tree@{\ptt term\_to\_print\_tree}}{144} \indexentry{then\_try@{\ptt then\_try}}{145} \indexentry{thm\_to\_print\_tree@{\ptt thm\_to\_print\_tree}}{146} \indexentry{type\_prec@{\ptt type\_prec}}{147} \indexentry{type\_to\_print\_tree@{\ptt type\_to\_print\_tree}}{148} \indexentry{Useful\_types@{\ptt Useful\_types}}{148} hol88-2.02.19940316/Library/prettyp/Manual/prettyp.aux0000640000212700021270000000051505535605247020516 0ustar cammcamm\relax \@input{title.aux} \@input{intro.aux} \@input{language.aux} \@input{functions.aux} \@input{datatypes.aux} \@input{link_to_hol.aux} \@input{debugging.aux} \@input{examples.aux} \@input{algorithm.aux} \@input{holppspec.aux} \@input{references.aux} \@input{syntax.aux} \@input{types.aux} \@input{entries.aux} \@input{index.aux} hol88-2.02.19940316/Library/prettyp/Manual/title.aux0000640000212700021270000000077305535605137020134 0ustar cammcamm\relax \global\@namedef{cp@title}{ \setcounter{page}{3} \setcounter{equation}{0} \setcounter{enumi}{0} \setcounter{enumii}{0} \setcounter{enumiii}{0} \setcounter{enumiv}{0} \setcounter{footnote}{0} \setcounter{mpfootnote}{0} \setcounter{part}{0} \setcounter{chapter}{0} \setcounter{section}{0} \setcounter{subsection}{0} \setcounter{subsubsection}{0} \setcounter{paragraph}{0} \setcounter{subparagraph}{0} \setcounter{figure}{0} \setcounter{table}{0} \setcounter{myenumi}{0} \setcounter{sessioncount}{1} } hol88-2.02.19940316/Library/prettyp/Manual/prettyp.dvi0000640000212700021270000130544405535605247020515 0ustar cammcamm÷ƒ’À;è TeX output 1994.03.04:1015‹ÿÿÿÿ ÌU ýFÓ ”/ß ý‹Ð!ŸK.ë‘S§`óHò"VáG cmbx10ëHThe– ‰‹HOL“prett‘ÿ4‰yp“LibraryŽŸÖx‘`X´ó<ò"VG® cmbx10çA–Ÿ¼General-Purp‘Oose“Prett–ÿr°y-Prin“terŽŸI­Û’Äæ¶ó7ò"Vff cmbx10âR.–…J.“BoultonŽ líZ‘h€’ó0ÂÖN  cmbx12ÛUniv• ersit“y–€of“Cam bridge,“Computer“Lab`oratoryŽ¤’‡ÖNew–€Museums“Site,“P• em“brok“e‘€StreetŽ¡’˜-hCam bridge,–€ó'ò"V ó3 cmbx10ÒCBÛ2“3ÒQGÛ,“England.ŽŸ+9ó’Ñd"August‘€1991ŽŽŽŒ‹* ÌU ýFÓ ”/ß ý‹Ð! dÚŠ’™I¨ž£hó+X«Q cmr12ÖcŽŽŽ’•æó-!",š cmsy10Ø ŽŽŽŽ’¥ÐÁÖR.–ê¨J.“Boulton“1991ŽŽŽŒ‹ ÌU ýFÓ ”/ß‘Ça ý—œí‰Ç>|Ÿ3²ëHCon–ÿ4‰ten“tsŽŸ‰Ç>|ŸFX Û1Ž‘ŸôIn tro`duction’d“Ü1ŽŽ¤(f‘ŸôÖ1.1Ž‘,¦JLoading–ê¨the“library‘Ü©‘ÿýó,·ág£ cmmi12×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘|ŽŽŽ ”/ß ý‹Ð!‘˜5Ö5.1.2Ž‘=1²Con•¬rv“erting–ê¨a“HOL“term‘Ii‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ53ŽŽ¤"X‘˜55.1.3Ž‘=1²Con•¬rv“erting–ê¨a“HOL“theorem‘0‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ54ŽŽ¡‘˜55.1.4Ž‘=1²Useful–ê¨additional“functions‘äÌ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ55ŽŽ¡‘ü‘ß5.2Ž‘˜5Compiling–ê¨a“prett•¬ry-prin“ter‘ÞÄ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ56ŽŽ¡‘ü‘ß5.3Ž‘˜5Linking–ê¨to“the“HOL“system‘­‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ57ŽŽ¡‘˜55.3.1Ž‘=1²Prin¬rt-rule‘ê¨functions‘Eä‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ58ŽŽ¡‘˜55.3.2Ž‘=1²Obtaining–ê¨a“parse-tree‘ò«‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ59ŽŽ¡‘˜55.3.3Ž‘=1²Installing–ê¨a“new“prin¬rter‘ºÜ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ60ŽŽ©ù6‘êñëÛ6Ž‘ü‘ßErrors–€and“debugging’'ëR63ŽŽ¡‘ü‘ßÖ6.1Ž‘˜5Compiler‘ê¨errors‘¯à‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ63ŽŽ¡‘ü‘ß6.2Ž‘˜5Errors–ê¨on“loading“the“compiled“coSŽdeZ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ63ŽŽ¡‘ü‘ß6.3Ž‘˜5Run-time‘ê¨errors‘8i‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ64ŽŽ¦‘êñëÛ7Ž‘ü‘ßExamples’o•ÿ65ŽŽ¡‘ü‘ßÖ7.1Ž‘˜5HOL‘ê¨terms‘…ì‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ65ŽŽ¡‘ü‘ß7.2Ž‘˜5Lisp‘±U‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ68ŽŽ¡‘ü‘ß7.3Ž‘˜5P¬rascal‘/‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ70ŽŽ¡‘ü‘ß7.4Ž‘˜5ELLA:–ê¨A“hardw¬rare“description“language‘ðÓ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ73ŽŽ¡‘ü‘ß7.5Ž‘˜5Arithmetical‘ê¨expressions‘/{‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ76ŽŽ¦‘êñëÛ8Ž‘ü‘ßThe›€prett• y-prin“ting˜algorithm’öîˆ83ŽŽ¡‘ü‘ßÖ8.1Ž‘˜5Requiremen¬rts‘´Û‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ83ŽŽ¡‘ü‘ß8.2Ž‘˜5Bo¬rxes‘Ëý‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ84ŽŽ¡‘˜58.2.1Ž‘=1²Horizon•¬rtal‘ê¨bSŽo“xes‘ܤ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ86ŽŽ¡‘˜58.2.2Ž‘=1²V‘ÿVertical‘ê¨bSŽo¬rxes‘ ä‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ88ŽŽ¡‘˜58.2.3Ž‘=1²Horizon•¬rtal/v“ertical‘ê¨bSŽo“xes‘.h‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ89ŽŽ¡‘˜58.2.4Ž‘=1²Horizon•¬rtal-or-v“ertical‘ê¨bSŽo“xes‘N`‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ90ŽŽ¡‘˜58.2.5Ž‘=1²Building‘ê¨sub-bSŽo¬rxes‘xº‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ90ŽŽ¡‘ü‘ß8.3Ž‘˜5Limitations‘Š1‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ90ŽŽ¦‘êñëÛ9Ž‘ü‘ßPrett• y-prin“ting–€HOL“terms’Ä93ŽŽ¡‘ü‘ßÖ9.1Ž‘˜5HOL‘ê¨t¬rypSŽes‘ä,‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ93ŽŽ¡‘ü‘ß9.2Ž‘˜5HOL‘ê¨terms‘…ì‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ94ŽŽ¡‘˜59.2.1Ž‘=1²Precedence‘ Ö‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ94ŽŽ¡‘˜59.2.2Ž‘=1²T¬rypSŽe‘ê¨information‘®‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ97ŽŽ¡‘˜59.2.3Ž‘=1²Dollared‘ê¨constan¬rts‘n‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ97ŽŽ¡‘˜59.2.4Ž‘=1²SpSŽecial–ê¨pre xes“and“in xes‘㻑ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ97ŽŽ¡‘˜59.2.5Ž‘=1²Uncurried‘ê¨argumen¬rts‘Þj‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ97ŽŽ¡‘˜59.2.6Ž‘=1²Abstractions–ê¨and“bindings‘¢‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ98ŽŽ¡‘˜59.2.7Ž‘=1²F‘ÿVunction‘ê¨applications‘¾Æ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ98ŽŽŽŽŒ‹• ÌU ýFÓŸú™š‘ÇaÛCon• ten“ts’‹bevŽ‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘?m«Ö9.2.8Ž‘e(Lists‘xÊ‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘\pÖ99ŽŽ¤‘?m«9.2.9Ž‘e(Conditionals‘H‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘ |tÖ100ŽŽ¡‘?m«9.2.10Ž‘e(Let‘ê¨statemen¬rts‘(¼‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘ |tÖ100ŽŽ¡‘?m«9.2.11Ž‘e(T‘ÿVerm‘ê¨quotes‘ï+‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘ |tÖ103ŽŽ¡‘$gU9.3Ž‘?m«HOL‘ê¨theorems)~‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘ |tÖ103ŽŽ¤¿ø‘ÇaÛReferences’sÒe105ŽŽ¡‘ÇaAŽ‘$gUSynš tax–€of“the“prett˜y-prin˜ting“language’½LÁ107ŽŽ¤‘$gUÖA.1Ž‘?m«Lexical‘ê¨ob‘§jects‘qI‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘ |tÖ107ŽŽ¡‘$gUA.2Ž‘?m«The‘ê¨grammar‘G´‘ÿý×:Ž– C†‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž“‘ÿý:Ž‘ |tÖ108ŽŽ¤¿ø‘ÇaÛBŽ‘$gUNew–€ML“Tš yp`es“in“the“prett˜yp“Library’½T6113ŽŽ¡‘ÇaCŽ‘$gUML–€F‘þàunctions“in“the“prett yp“Library’ÆÛQ115ŽŽ¡‘ÇaIndex’‘®|150ŽŽŽŽŒ‹C’ ÌU ýFÓŸú™š‘êñëÛvi’‡¢eCon• ten“tsŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ߎŒ‹M ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…1Ž‘ÇaŸ Ì̉Ç>|Ÿ ëHIn‘ÿ4‰tro‘ËvductionŽŸ‰Ç>|Ÿ;*:ÖThis–X}došSŽcumen¬rt“describ˜es“the“facilities“proš¬rvided“b˜y“the“ó(ßê|ŽŽŽ ”/ß ý‹Ð!‘êñëÖin¬rto‘ê¨ÍHOLÖ.Ž©БöSzThere–hare“three“cošSŽde“ les“in“the“library“of“imp˜ortance“to“the“user.‘²ÀThe“ rst“is“calledŽ¤‘êñëÓPP_printer.mlÖ.‘5VThis–à le“mš¬rust“bSŽe“loaded“in“order“to“do“an˜ything“with“the“prett˜y-prin˜ter.Ž¡‘êñëIt–ê¨is“the“main“prett•¬ry-prin“ting‘ê¨program.Ž¦‘öSzThe–òÊ le“ÓPP_parser.ml“Öcan“bSŽe“loaded“after“ÓPP_printer.mlÖ.‘QFIt“is“the“compiler“for“theŽ¡‘êñëprett•¬ry-prin“ting–¾language.‘Ô©It“also“conš¬rtains“a“prett˜y-prin˜ter“for“the“prett˜y-prin˜ting“language!Ž¦‘öSzThe–Ì™ le“ÓPP_hol.ml“Öcan“also“bSŽe“loaded“after“ÓPP_printer.mlÖ.‘Þ³It“con¬rtains“functions“forŽ¡‘êñëcon•¬rv“erting–ÀÞÍHOL“Ötš¬rypSŽes,‘6lterms“and“theorems“in˜to“parse-trees.‘ »ƒIt“also“con˜tains“a“com-Ž¡‘êñëplete›çöprett•¬ry-prin“ter˜for˜the˜ÍHOL˜Ölogic.‘0ËWhen˜loaded,‘'Jthe˜standard˜ÍHOL˜Öprett“y-prin“terŽ¡‘êñëis–'replaced“bš¬ry“these“new“prin˜ters.‘Ê\ÓPP_hol.ml“Öis“required“for“an˜y“extension“to“the“prett˜y-Ž¡‘êñëprinš¬rting–ê¨of“ÍHOL“Öt˜ypSŽes,“terms“or“theorems.Ž¦‘öSzNote– that“ÓPP_parser.ml“Öand“ÓPP_hol.ml“Ödo“not“require“eacš¬rh“other“to“bSŽe“residen˜t“to“w˜ork.Ž¡‘êñëThey–ê¨can“ho•¬rw“ev“er–ê¨bSŽe“residen¬rt“together.Ž¦‘öSzUse–‡Dof“Óload_libraryŽ‘N €Öloads“all“three“of“the“ les.‘´The“folloš¬rwing“session“sho˜ws“ho˜w“theŽ¡‘êñëen¬rtire‘ê¨ÓprettypŽ‘0öÖlibrary–ê¨can“bSŽe“loaded:ŽŸ\tV‘êñ럵‰ffÇ I ‹—bÌÍŸYœ„ðþff ÿzf’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±Ÿýóp®0J cmsl10È1ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`prettyp`;;Ž¤ ‘ÌÍLoading–¿ªlibrary“`prettyp`“...Ž¡‘ÌÍUpdating–¿ªhelp“search“pathŽ¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.............................................................Ž¡‘ÌÍLibrary–¿ª`prettyp`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŸ‘ÌÍ#ŽŽ’Æq°„ðþffŽŽŸÀ‰ffÇ IŽŽŽŸ\Eë‘öSzÖIf–Wthe“user“w•¬ran“ts–Wto“load“only“one“or“t•¬rw“o–Wof“the“three“ les,‘34they“can“bSŽe“loaded“separately‘ÿV.Ž¡‘êñëAs–Øüan“example“of“this,‘¸ÓPP_printer.ml“Öcan“bSŽe“loaded“using“one“of“the“follo¬rwing“ÍML“ÖfunctionŽ¡‘êñëcalls:ŽŸ@‘ü0éÓloadf–¿ª(library_pathname()“^“`/prettyp/PP_printer`);;ŽŸ ™š‘ü0éloadt–¿ª(library_pathname()“^“`/prettyp/PP_printer`);;ŽŸ‘²‘êñëÖwhere–Cbthe“former“loads“`quietly'“and“the“latter“displa¬rys“details“of“the“declarations“madeŽ¡‘êñëwithin–ê¨the“ le.ŽŸ(•¯‘êñëç1.2Ž‘5oExample:‘¾aa›rŠprett–ÿr°y-prin“ter˜for˜set˜theory˜in˜HOLŽŸ u‘êñëÖThis–¾msection“illustrates“the“dev•¬relopmen“t–¾mproSŽcess“for“an“extension“to“the“ÍHOL“Öprett¬ry-Ž¡‘êñëprinš¬rter.‘}/Throughout–VÂthe“example“w˜e“assume“the“user“has“t˜w˜o“windo˜ws.‘}/A‘V§ÍHOL“ÖsessionŽ¡‘êñëis–ê¨running“within“the“ rst“windoš¬rw,“whic˜h“is“represen˜ted“b˜y“a“bSŽo˜x“of“the“follo˜wing“form:ŽŽŽŒ‹Z ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL’Bc3Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaŸõÀ‰ffÇ IŸ &cÌÍŸYœ„ÿffŸüf’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸÿ@T‘ÌÍÓ...ŽŽ’Æq°„ÿffŽŽŸÀ‰ffÇ IŽŽŽŸBä‘ÇaÖThe–ë.other“windoš¬rw“is“an“editor“in“whic˜h“a“ le“named“Ósets.pp“Öis“bSŽeing“edited.‘:qThe“editorŽ©‘Çais–ê¨represenš¬rted“b˜y:Ž¤"Ýú‘ÇaŸí ¤‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ IŸ &cÌÍŸYœ„ÿffŸû¦d‘ÌÍ...ŽŽ’Æq°„ÿffŽŽ¡‰ffÇ IŽŽŽ¡‘ÇaÖW‘ÿVe–ê¨bSŽegin“b¬ry“running“ÍHOL“Öand“loading“three“ les“from“the“library“ÓprettypŽ‘,(NÖ.Ž œ…„‘Ça ÿs’µ‰ffÇ I €ùÌÍŸYœ„Ú•ff þ÷|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸ @T‘?IqÓ_‘ T_–þ¨__“_‘"}ü__“__Ž¤ ‘ Ë|___–>þ|__|“|› T|“|‘¾R|__|˜|__|Ž¡‘ Ë|‘"}ü|› T|–>þ|__|“|__“|__|˜|__|Ž¤‘?IqVersion‘¿ª2Ž¡‘ÌÍ#loadf–¿ª(library_pathname()“^“`/prettyp/PP_printer`);;Ž¤ ‘ÌÍUpdating–¿ªhelp“search“pathŽ¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.......................................()–¿ª:“voidŽ©‘ÌÍ#loadf–¿ª(library_pathname()“^“`/prettyp/PP_parser`);;Ž¡‘ÌÍUpdating–¿ªhelp“search“pathŽ¡‘ÌÍ.............................................................................Ž¡‘ÌÍ......................................................................Ž¡‘ÌÍ()–¿ª:“voidŽ¦‘ÌÍ#loadf–¿ª(library_pathname()“^“`/prettyp/PP_hol`);;Ž¡‘ÌÍUpdating–¿ªhelp“search“pathŽ¡‘ÌÍ.................................()–¿ª:“voidŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽ œkè‘ÇaÖThe–à1 rst“ le“is“the“main“prett•¬ry-prin“ting–à1program.‘zIt“mš¬rust“alw˜a˜ys“bSŽe“loaded“when“theŽ¦‘Çaprett•¬ry-prin“ter– þis“bSŽeing“used.‘™áThe“second“ le“is“a“parser“for“the“prett•¬ry-prin“ting‘ þlanguage.Ž¦‘ÇaThe–ê rst“ le“mš¬rust“alw˜a˜ys“bšSŽe“loaded“b˜efore“the“second.‘8ªThe“parser“generates“a“ le“of“ÍMLŽ¦‘ÇaÖdeclarations.‘«ÉThe–öthird“ le“is“a“replacemenš¬rt“for“the“standard“ÍHOL“Öprett˜y-prin˜ter.‘«ÉIt“hasŽ¦‘ÇabšSŽeen–?written“using“the“prett•¬ry-prin“ter–?describ˜ed“here.‘¾¥This“allo¬rws“it“to“b˜e“extended“withŽ¦‘Çathe›ê¨sp•SŽecial-purp“ose˜syn¬rtax.Ž¦‘(ðThe–ê¨next“thing“to“do“is“to“load“the“library“whose“synš¬rtax“w˜e“wish“to“extend:ŽŸAké‘ÇaŸÎ’µ‰ffÇ IŸX€ùÌÍŸYœ„\Ú•ffŸ­|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#load_library‘¿ª`sets`;;Ž¤ ‘ÌÍLoading–¿ªlibrary“`sets`“...Ž¡‘ÌÍUpdating–¿ªsearch“pathŽ¡‘ÌÍ.Theory–¿ªsets“loadedŽ¡‘ÌÍ.....................Ž¡‘ÌÍLibrary–¿ª`sets`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„\Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŽŽŒ‹f. ÌU ýFÓŸú™š‘êñëÛ4’,w^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖThe–sconstanš¬rt“ÓEMPTY‘røÖis“no˜w“de ned“within“the“ÍHOL“Ösystem.‘Ò:It“represen˜ts“an“empt˜y“set.Ž©‘êñëObservš¬re–ê¨that“no“spSŽecial“syn˜tax“is“attac˜hed“to“the“constan˜t.Ž¤ •(‘êñëŸï‡‰ffÇ IŸ—bÌÍŸYœ„ðþffŸïf’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#"EMPTY:(*)set";;ŽŸ ‘ÌÍ"EMPTY"–¿ª:“termŽŽ’Æq°„ðþffŽŽŸÀ‰ffÇ IŽŽŽ¡‘êñëÖNo•¬rw›ê¨w“e˜en“ter˜a˜small˜prett“y-prin“ter˜spSŽeci cation˜in“to˜the˜editor˜windo“w.ŽŸXxÔ‘êñ럷£Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ IŸu ÌÍŸYœ„yyœffŸ‘7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽŸ ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„yyœffŽŽ¡‰ffÇ IŽŽŽŸXxÓ‘êñëÖThe–ß\name“of“the“prett•¬ry-prin“ter–ß\is“spSŽeci ed“as“ÓsetsÖ.›5There“is“one“rule.˜The“rule“instructsŽ¦‘êñëÍHOL–ê¨Öto“prinš¬rt“Ó{}“Öwhenev˜er“it“encoun˜ters“the“constan˜t“ÓEMPTYÖ.Ž¦‘öSzThere–Š-are“t•¬rw“o–Š-parts“to“the“rule:‘wëa“ó.›»ˆ@ cmti12Ùp‘ÿffattern‘oÝÖand“a“ÙformatÖ.‘pThese“are“separated“b¬ry“Ó->Ö.Ž¦‘êñëWhen–=&prinš¬rting,‘QÅthe“system“compares“the“pattern“to“the“term“whic˜h“is“to“bSŽe“prin˜ted.‘0YInŽ¦‘êñëthe–ë`example,‘+Žthe“pattern“matcš¬rhes“the“term“only“if“the“curren˜t“Ùc‘ÿffontext‘¤Öis“Ó'term'Ö.‘; TheŽ¦‘êñëconš¬rtext–¹Œis“a“string“of“c˜haracters“whic˜h“is“spSŽeci ed“when“the“prett˜y-prin˜ter“is“called.‘¥‹ItŽ¦‘êñëma¬ry–ê¨also“bšSŽe“mo˜di ed“bš¬ry“a“rule“during“the“prin˜ting“proSŽcess.Ž¦‘öSzThe–v7rest“of“the“pattern“represen¬rts“the“tree“structure“of“a“ÍHOL“Öterm.‘So,‘for“the“patternŽ¦‘êñëto–NPmatcš¬rh“a“term,‘§:the“term“m˜ust“represen˜t“the“constan˜t“ÓEMPTYÖ.“The“Ó**“Öin“the“patternŽ¦‘êñëis–1-used“to“matcš¬rh“optional“t˜ypSŽe“information.‘ nW‘ÿVe“shall“not“concern“ourselv˜es“with“thisŽ¦‘êñënotation–ê¨at“the“momen¬rt.Ž¦‘öSzThe–‘§format“consists“of“a“Ùb‘ÿffoxÖ,‘£tthe“compSŽonenš¬rts“of“whic˜h“are“to“bšSŽe“comp˜osed“horizon¬rtallyŽ¦‘êñëwith–’Îno“space“bšSŽet•¬rw“een–’Îthem.‘1RIn“the“example,‘¼Øthe“b˜o¬rx“has“only“one“comp˜onen¬rt,‘¼Øso“theŽ¦‘êñëcompSŽosition–/Âinformation“is“not“required.‘/The“format“instructs“the“prinš¬rter“to“displa˜y“Ó{}Ö.Ž¦‘êñëThe–Üìdouble“quotation-marks“are“used“to“delimit“a“string“whicš¬rh“is“to“bSŽe“displa˜y˜ed“v˜erbatim.Ž¦‘öSzSo,‘0¢whenevš¬rer–ïpthe“pattern“matc˜hes,‘0¢the“format“is“used“to“determine“what“to“displa˜y‘ÿV.Ž¦‘êñëLet's–q'see“this“in“action.‘Ì\First“the“ le“mš¬rust“bSŽe“sa˜v˜ed.‘Ì\Then“w˜e“instruct“ÍHOL“Öto“con˜v˜ertŽ¦‘êñëthe›ê¨prett•¬ry-prin“ter˜spSŽeci cation˜in“to˜a˜ le˜of˜ÍML˜Ödeclarations.ŽŸ! ô‘êñëŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ4ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;ŽŸ ‘ÌÍ()–¿ª:“voidŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ! ó‘êñëÖThere–yïshould“noš¬rw“bSŽe“a“ le“called“Ósets_pp.mlÖ.‘æµThis“con˜tains“t˜w˜o“ÍML“Ödeclarations.‘æµTheŽ¦‘êñë rst–¥Üdeclares“Ósets_rulesŽ‘@È\Öto“bšSŽe“a“list“of“prett•¬ry-prin“ting–¥Ürules“as“understo˜o˜d“bš¬ry“the“prett˜y-Ž¦‘êñëprinš¬rting–ûprogram.‘kfThe“second“declares“Ósets_rules_funŽ‘XrJÖto“bSŽe“a“function“whic˜h“em˜b•SŽo“diesŽŽŽŒ‹pØ ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL’Bc5Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖthe–©KpropSŽerties“of“the“rules.‘#The“names“of“the“idenš¬rti ers“are“deriv˜ed“from“the“name“of“theŽ¤‘Çaprett•¬ry-prin“ter–ê¨spSŽeci cation“giv¬ren“in“the“ le.Ž©©‘(ðThe–RÛfunction“ÓPP_to_MLŽ‘8£Öin•¬rv“ok“es–RÛthe“parser.‘ qxIts“ rst“argumen¬rt“indicates“whether“theŽ¡‘Çaoutput–SDis“to“bšSŽe“app˜ended“to“the“sp˜eci ed“ le.‘iIn“the“example“the“output“is“not“app˜ended,Ž¡‘Çai.e.–­if“the“destination“ le“existed“previously“it“will“bSŽe“o•¬rv“erwritten.‘­ïThe–­second“argumen¬rtŽ¡‘Çais–Z the“name“of“the“source“ le.›‡The“name“of“the“source“ le“m¬rust“end“in“`Ó.ppÖ'.˜The“`Ó.ppÖ'Ž¡‘Çamaš¬ry–¥æbSŽe“omitted“from“the“name“giv˜en“as“the“second“argumen˜t.‘!õThe“third“argumen˜t“is“theŽ¡‘Çaname–wÖof“the“destination“ le.‘šThis“should“either“bSŽe“giv¬ren“in“full,›ŽÌor“if,˜as“in“the“example,˜aŽ¡‘Çanš¬rull–³string“is“giv˜en,‘¾-the“parser“will“replace“the“`Ó.ppÖ'“of“the“source“ le“name“with“`Ó_pp.mlÖ'.Ž¦‘(ðW‘ÿVe–E9can“no¬rw“load“the“ le“of“ÍML“Ödeclarations,‘›Ýand“instruct“ÍHOL“Öto“add“them“to“itsŽ¡‘Çaexisting›ê¨prett•¬ry-prin“ting˜rules.Ž ÎJ‘Ça ÿs’µ‰ffÇ I €ùÌÍŸYœ„Ú•ff þ÷|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ5ŽŽŽŽŸÿ@T‘ÌÍÓ#loadt‘¿ª`sets_pp`;;Ž©‘ÌÍsets_rules‘¿ª=Ž¤ ‘ÌÍ[((`term`,Ž¡‘ Ë(Const_name(`CONST`,Ž¡‘\Ã[Patt_child(Const_name(`EMPTY`,–¿ª[]));“Wild_children])),Ž¡‘ Ë-),Ž¡‘L![],Ž¡‘L!PF(H_box[(0,–¿ªPO_constant“`{}`)]))]Ž¡‘ÌÍ:–¿ªprint_rule“listŽ¦‘ÌÍsets_rules_fun–¿ª=“-“:“print_rule_functionŽŸ'‘ÌÍFile–¿ªsets_pp“loadedŽ¡‘ÌÍ()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽ ¹ ‘Çatop_printŽ‘JšÖis–$an“ÍML“Ödirectivš¬re“whic˜h“giv˜en“a“function“of“t˜ypSŽe“Ó(Ùtyp‘ÿffe‘ûÔÓ->“void)“Öinstalls“thatŽ¡‘Çafunction–qnas“a“prinš¬rter“for“an˜y“ob‘§ject“of“t˜ypSŽe“Ùtyp‘ÿffeÖ.‘wÓppŽ‘9Öis“an“ÍML“Öfunction“whic˜h“prett˜y-prin˜tsŽ¡‘Çain–ôia“w•¬ra“y–ôi(almost)“compatible“with“the“standard“ÍHOL“Öprett•¬ry-prin“ter.‘V$That–ôiis,‘öÚwhen“usedŽ¡‘Çawith‘ZÑÓtop_printŽ‘7ËÖ,‘w–the–ZÑtext“it“prošSŽduces“merges“prop˜erly“with“the“surrounding“text“pro˜ducedŽ¡‘Çabš¬ry–c%other“means.‘ ´The“ rst“argumen˜t“to“ÓppŽ‘EžÖis“a“`rule“function'.‘ ´In“the“example“this“is“madeŽ¡‘Çab¬ry–4ØcompSŽosing“three“`rule“functions'“together“using“Óthen_tryŽ‘12(Ö.‘üEThe“rules“of“Ósets_rules_funŽŽ¡‘ÇaÖare–tried“ rst.‘%üIf“none“of“these“matc¬rh,›¸the“standard“ÍHOL“Örules“are“tried,˜ rst“those“forŽ¡‘Çaterms,‘óuthen–ñ²those“for“tš¬rypSŽesŸû¥2ó |{Ycmr8¸1ŽŽ‘ÀÖ.‘MþThe“second“argumen˜t“is“the“Ùc‘ÿffontext‘öÖmen˜tioned“abSŽo˜v˜e.‘MþTheŽ¡‘Çathird–.pis“a“list“of“parameters,‘?bwhicš¬rh“is“empt˜y“in“the“example.‘8The“fourth“argumen˜t“is“anŽ‘ÇaŸ å ‰ffqÏŸŸ ™š‘ ƒŸü^ÿóÙ“ Rcmr7³1ŽŽ‘óKñ`y cmr10ÄIf–UUno“rules“matcš¸ãh,“default“rules“will“bGe“used“whic˜h“prin˜t“the“ob‘Ž8ject“as“a“tree“structure.ŽŽŽŒ‹}ñ ÌU ýFÓŸú™š‘êñëÛ6’,w^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖob‘§ject–8of“a“tš¬rypSŽe“de ned“within“the“prett˜y-prin˜ter.‘ìeThe“t˜ypSŽe“represen˜ts“a“parse-tree.‘ìeIn“theŽ¤‘êñëexample,‘jdthe–PØterm“to“bSŽe“prett•¬ry-prin“ted–PØis“con•¬rv“erted›PØin“to˜a˜parse-tree˜using˜the˜functionŽ¡‘êñëÓpp_convert_termŽ‘A,áÖ.‘9This–ê´function“is“de ned“within“the“prett•¬ry-prin“ter,‘ê¸spSŽeci cally–ê´the“partŽ¡‘êñëof–ê¨it“concerned“with“prin¬rting“ÍHOL“Öterms.ŽŸ3Ù‘öSzÓEMPTY–ê¨Öis“noš¬rw“prin˜ted“as“Ó{}Ö.Ž¤#GÍ‘êñëŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ6ŽŽŽŽŸÿ@T‘ÌÍÓ#"EMPTY:(*)set";;ŽŸ ‘ÌÍ"{}"–¿ª:“termŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽ©#ó‘êñëÖW‘ÿVe›ê¨ha•¬rv“e˜not˜y“et˜attac“hed˜spSŽecial˜syn“tax˜to˜non-empt“y˜sets.Ž¡‘êñëŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ7ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(EMPTY:(num)set)";;ŽŸ ‘ÌÍ"1–¿ªINSERT“{}"“:“termŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽ¦‘êñëÖThe–Iconstanš¬rt“ÓINSERT‘CÖis“an“in x.‘ÃIt“is“used“to“form“a“new“set“from“a“set“and“the“elemen˜tŽ¤‘êñëto–ê¨bSŽe“added.‘8àW‘ÿVe“can“add“a“rule“to“prett•¬ry-prin“t‘ê¨this.ŽŸn6­‘êñ럤#Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I œ ÌÍŸYœ„ yœff ÿj7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**))‘¿ª->Ž¦‘E [“"{"“*elem“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„ yœffŽŽ¡‰ffÇ IŽŽŽŸnÓ‘êñëÖThe–ê¨new“rule“matc¬rhes“something“of“the“form:ŽŸ8b‘ü0éÓ(INSERT–¿ª*elem)“EMPTYŽŸjï‘êñëÖThe–½˜Ùmetavariable‘£HÓ*elem“Ömatcš¬rhes“an˜y“tree,‘Æ›and“bšSŽecomes“b˜ound“to“that“tree.‘)ÛWhen“Ó*elemŽ¡‘êñëÖis–6Kused“within“the“format,‘I4the“prett•¬ry-prin“ter–6Kis“called“recursiv¬rely“on“the“tree“it“is“bSŽoundŽ¡‘êñëto.‘-^In–È#the“example,‘Ï if“the“new“rule“matcš¬rhes“the“tree“to“bSŽe“prin˜ted,‘Ï the“sub-tree“bSŽound“toŽ¡‘êñëÓ*elem–ê¨Öis“prin¬rted“enclosed“within“braces.Ž©3Ù‘öSzT‘ÿVo–Yprinš¬rt“the“sub-tree,‘Bithe“system“tries“to“matc˜h“rules“to“it,‘BibSŽeginning“from“the“ rst“rule,Ž¡‘êñëÙnot‘]­Öthe–9irule“folloš¬rwing“the“one“just“used.‘%"If“neither“of“our“new“rules“matc˜h“the“sub-tree,Ž¡‘êñëthe–ê¨rules“for“standard“ÍHOL“Öwill“bSŽe“tried.Ž¦‘öSzSo,‘ßlet's›Ü2sa•¬rv“e˜the˜ le,–ßrecompile˜it,“load˜the˜generated˜coSŽde˜and˜link˜the˜new˜rules˜in¬rtoŽ¡‘êñëthe‘ê¨prett•¬ry-prin“ter.ŽŽŽŒ‹Š² ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL’Bc7Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýÅ#Ò‘ÇaŸ»µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ8ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`sets_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ^v‘ÇaÖNo•¬rw›ê¨w“e˜try˜the˜example˜again.ŽŸ+A‡‘ÇaŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ9ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(EMPTY:(num)set)";;ŽŸ ‘ÌÍ"{1}"–¿ª:“termŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ*v‘ÇaÖUnfortunately–ê¨our“rules“do“not“wš¬rork“for“sets“of“t˜w˜o“or“more“elemen˜ts.ŽŸ>Á‡‘ÇaŸÛ’µ‰ffÇ IŸ>€ùÌÍŸYœ„BÚ•ffŸÇ|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ10ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(INSERT“2“(EMPTY:(num)set))";;Ž¤ ‘ÌÍ"1–¿ªINSERT“{2}"“:“termŽŸ‘ÌÍ#"INSERT–¿ª1“(INSERT“2“(INSERT“3“(EMPTY:(num)set)))";;Ž¡‘ÌÍ"1–¿ªINSERT“(2“INSERT“{3})"“:“termŽŽ’Æq°„BÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸ=Žv‘ÇaÖThe–õ=problem“is“that“the“second“rule“only“matcš¬rhes“when“the“set“in˜to“whic˜h“the“new“elemen˜tŽ¤‘Çais–úbSŽeing“`inserted'“is“the“emptš¬ry“set.‘½×W‘ÿVe“can“mak˜e“the“pattern“more“general“b˜y“replacingŽ¡‘Çathe–ê¨part“of“it“whicš¬rh“matc˜hes“ÓEMPTY“Öwith“a“meta˜v‘ÿXäariable.ŽŸv0g‘ÇaŸ¤#Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I œ ÌÍŸYœ„ yœff ÿj7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘E [“"{"“*elem“","“*elems“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„ yœffŽŽ¡‰ffÇ IŽŽŽŸtýV‘ÇaÖW‘ÿVe–ê¨proSŽcess“the“ le“again.ŽŽŽŒ‹• ÌU ýFÓŸú™š‘êñëÛ8’,w^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ýÅ#Ò‘êñ럻µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ11ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`sets_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸd‘êñëÖT‘ÿVry–ê¨the“examples.ŽŸEüµ‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ12ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(EMPTY:(num)set)";;Ž¤ ‘ÌÍ"{1,{}}"–¿ª:“termŽŸ‘ÌÍ#"INSERT–¿ª1“(INSERT“2“(EMPTY:(num)set))";;Ž¡‘ÌÍ"{1,{2,{}}}"–¿ª:“termŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽŸCëû‘êñëÖNot– vquite“what“wš¬re“w˜an˜ted.‘˜JOnce“w˜e“ha˜v˜e“matc˜hed“the“second“rule,‘Riand“sen˜t“out“theŽ¤‘êñëbraces,‘¾¹w•¬re›³½w“an“t˜to˜treat˜an˜ÓINSERT‘³°Öin˜a˜di eren“t˜w“a“y–ÿV.‘&’W“e˜can˜do˜this˜b¬ry˜adding˜an˜extraŽ¡‘êñërule–ê¨whicš¬rh“matc˜hes“in“a“di eren˜t“con˜text“to“the“others.Ž ŽHc‘êñ럣ՉffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I Ã ÌÍŸYœ„Çyœff ÿC7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘\Ã[“'term'::*elem“","“*elems];Ž¡‘ Ë'term'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘E [“"{"“*elem“","“'term_set'::*elems“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„ÇyœffŽŽ¡‰ffÇ IŽŽŽ ŽŒü‘êñëÖW‘ÿVe–óalso“cš¬rhange“the“last“rule“so“that“the“recursiv˜e“call“it“mak˜es“to“proSŽcess“the“remainderŽ¡‘êñëof–ê¨the“set“is“made“in“the“con¬rtext“Ó'term_set'Ö.ŽŽŽŒ‹ œö ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL’Bc9Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýÅ#Ò‘ÇaŸ»µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ13ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`sets_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸwö@‘ÇaŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ14ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(EMPTY:(num)set)";;Ž¤ ‘ÌÍ"{1,CONST(EMPTY)}"–¿ª:“termŽŸ‘ÌÍ#"INSERT–¿ª1“(INSERT“2“(EMPTY:(num)set))";;Ž¡‘ÌÍ"{1,2,CONST(EMPTY)}"–¿ª:“termŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽŸ:÷ä‘ÇaÖW‘ÿVe–n.noš¬rw“ha˜v˜e“no“rule“to“matc˜h“ÓEMPTY‘nÖwhen“it“appSŽears“as“an“argumen˜t“to“ÓINSERTÖ.“Since“w˜eŽ¤‘Çaha•¬rv“e–:=also“cš¬rhanged“con˜text,›N"the“ÍHOL“Örules“no“longer“apply“either.‘'ŸSo,˜ÓEMPTY‘:)Öis“displa•¬ry“edŽ¡‘Çaas–ê¨its“tree“represen¬rtation.ŽŸÉI‘(ðW‘ÿVe–MÞcould“easily“add“a“rule“to“matcš¬rh“ÓEMPTYÖ,“so“that“the“ÓEMPTY‘MƒÖis“just“thro˜wn“a˜w˜a˜y‘ÿV.Ž¡‘ÇaHo•¬rw“ev“er,‘õÕobserv“e–ó™that“wš¬re“w˜ould“still“ha˜v˜e“a“trailing“comma“bSŽefore“the“righ˜t-hand“brace.Ž¡‘ÇaInstead,‘Ô§wš¬re–Ï&can“add“a“rule“to“deal“with“the“last“elemen˜t“of“the“set“in“a“spSŽecial“w˜a˜y‘ÿV.‘/µNoteŽ¡‘Çathat–Õ©the“new“rule“mš¬rust“come“bSŽefore“the“other“rule“whic˜h“applies“in“the“con˜text“Ó'term_set'Ö,Ž¡‘Çaso–ê¨that“it“takš¬res“priorit˜y“o˜v˜er“that“rule.Ž ™â/‘Ça ÿ}#Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I ê ÌÍŸYœ„îyœff ÿ7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**))‘¿ª->Ž¦‘\Ã[“'term'::*elem];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘\Ã[“'term'::*elem“","“*elems];Ž¡‘ Ë'term'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘E [“"{"“*elem“","“'term_set'::*elems“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„îyœffŽŽ¡‰ffÇ IŽŽŽŽŽŒ‹ ¤{ ÌU ýFÓŸú™š‘êñëÛ10’%·^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ýÅ#Ò‘êñ럻µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ15ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`sets_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸx6M‘êñëŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ16ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(EMPTY:(num)set)";;Ž¤ ‘ÌÍ"{1,CONST(EMPTY)}"–¿ª:“termŽŸ‘ÌÍ#"INSERT–¿ª1“(INSERT“2“(EMPTY:(num)set))";;Ž¡‘ÌÍ"{1,2}"–¿ª:“termŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽŸ;7ñ‘êñëÖOur–nÁrules“noš¬rw“w˜ork“for“sets“of“t˜w˜o“or“more“elemen˜ts,‘‡‰but“not“for“sets“of“only“one“elemen˜t.Ž¤‘êñëThis–í0is“bSŽecause“the“last“rule“consumes“the“ rst“ÓINSERTÖ,“leaš¬rving“just“ÓEMPTY‘ìïÖfor“a“one“elemen˜tŽ¡‘êñëset,‘uFand–Ythere“is“no“rule“to“matcš¬rh“ÓEMPTY‘YpÖin“the“con˜text“Ó'term_set'Ö.‘…ŽW‘ÿVe“need“to“c˜hangeŽ¡‘êñëthe–Zlast“rule“so“that“it“matcš¬rhes“in“the“same“situations,‘uòand“displa˜ys“the“braces,‘uòbut“theŽ¡‘êñëtree–ûÞit“passes“on“in“the“cš¬rhanged“con˜text“is“the“tree“it“w˜as“giv˜en,‘@,not“some“sub-tree“ofŽ¡‘êñëit.‘TœW‘ÿVe–ž‘do“this“b¬ry“labšSŽelling“a“no˜de“of“the“tree“with“a“metaš¬rv‘ÿXäariable.‘TœThis“is“denoted“b˜yŽ¡‘êñëÓ|*elems|Ö.‘"The–Ýsub-trees“that“w¬rere“bšSŽeing“b˜ound“to“meta¬rv‘ÿXäariables“no“longer“need“to“b˜e.Ž¡‘êñëW‘ÿVe–ê¨can“therefore“use“Ó*“Öwithout“a“name“to“mean“`matcš¬rh“an˜y“sub-tree'.Ž š+b‘êñë ÿ}#Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I ê ÌÍŸYœ„îyœff ÿ7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**))‘¿ª->Ž¦‘\Ã[“'term'::*elem];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘\Ã[“'term'::*elem“","“*elems];Ž¡‘ Ë'term'::|*elems|COMB(COMB(CONST(INSERT(),**),*),*)‘¿ª->Ž¦‘E [“"{"“'term_set'::*elems“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„îyœffŽŽ¡‰ffÇ IŽŽŽŽŽŒ‹ ­½ ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL‘z‚c11Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýÅ#Ò‘ÇaŸ»µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ17ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`sets_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŸooS‘ÇaŸÛD׉ffÇ IŸ?¶ÌÍŸYœ„CvRffŸÆ༒¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ18ŽŽŽŽŸÿ@T‘ÌÍÓ#"INSERT–¿ª1“(EMPTY:(num)set)";;Ž¤ ‘ÌÍ"{1}"–¿ª:“termŽŸ‘ÌÍ#"INSERT–¿ª1“(INSERT“2“(EMPTY:(num)set))";;Ž¡‘ÌÍ"{1,2}"–¿ª:“termŽŽ’Æq°„CvRffŽŽŸÀ‰ffÇ IŽŽŽŸ2p÷‘ÇaÖHa•¬rving›á~w“ork“ed˜hard˜to˜get˜here,‘ãSour˜rules˜are˜still˜not˜quite˜righ“t.‘5ÒIn˜all˜the˜formats˜theŽ¤‘Çaob‘§jects›‰pdispla•¬ry“ed˜are˜compSŽosed˜horizon“tally‘ÿV.‘9This˜means˜that˜all˜the˜text˜m“ust˜appSŽearŽ¡‘Çaon–ê¼the“same“line.‘9If“the“textual“represen¬rtation“of“the“set“is“longer“than“the“length“of“oneŽ¡‘Çaline–ê¨it“will“o•¬rv“er o“w.‘8àW‘ÿVe–ê¨need“to“spšSŽecify“where“the“set“can“b˜e“brok¬ren“b˜et•¬rw“een‘ê¨lines.Ž¡‘(ðThe–ظobš¬rvious“place“to“break“the“set“is“after“a“comma.‘So“if“the“line“length“w˜as“v˜eryŽ¡‘Çasmall,–ê¨wš¬re“migh˜t“get“output“of“the“form:ŽŸ“®‘$_Ó{1,2,3,4,ŽŸ ™š‘)Æ 5,6}ŽŸú‘ÇaÖW‘ÿVe–ê¨can“ac•¬rhiev“e–ê¨this“form“of“Ùinc‘ÿffonsistent‘ìÖbreaking“bš¬ry“some“simple“c˜hanges“to“our“rules.Ž ‘ù‘Ça ÿ}#Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I ê ÌÍŸYœ„îyœff ÿ7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**))‘¿ª->Ž¦‘\Ã[“'term'::*elem];Ž¡‘ Ë'term_set'::COMB(COMB(CONST(INSERT(),**),*elem),*elems)‘¿ª->Ž¦‘\Ã[“[“'term'::*elem“","]“*elems];Ž¡‘ Ë'term'::|*elems|COMB(COMB(CONST(INSERT(),**),*),*)‘¿ª->Ž¦‘E [“"{"“'term_set'::*elems“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„îyœffŽŽ¡‰ffÇ IŽŽŽŽŽŒ‹ · ÌU ýFÓŸú™š‘êñëÛ12’%·^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖA‘°=b•SŽo¬rx›°lab“elled˜with˜Ó˜Öin˜a˜format˜means˜that˜the˜comp“onen¬rts˜of˜the˜b“o¬rx˜shouldŽ¤‘êñëappšSŽear– “void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽŽŽŒ‹ À0 ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL‘z‚c13Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß þF¯‘Ça ÿ9‡‰ffÇ I ‚—bÌÍŸYœ„†ðþff þƒf’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ20ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªtest“=“"INSERT“1“(INSERT“2“(INSERT“3“(INSERT“4“(INSERT“5“(INSERT“6Ž¤ ‘ÌÍ#(EMPTY:(num)set))))))";;Ž¡‘ÌÍtest–¿ª=“"{1,2,3,4,5,6}"“:“termŽ©‘ÌÍ#set_margin‘¿ª15;;Ž¡‘ÌÍ72–¿ª:“intŽ¦‘ÌÍ#test;;Ž¡‘ÌÍ"{1,2,3,4,5,6}"Ž¡‘ÌÍ:‘¿ªtermŽ¦‘ÌÍ#set_margin‘¿ª14;;Ž¡‘ÌÍ15–¿ª:“intŽ¦‘ÌÍ#test;;Ž¡‘ÌÍ"{1,Ž¡‘L!2,3,4,5,6}"Ž¡‘ÌÍ:‘¿ªtermŽ¦‘ÌÍ#set_margin‘¿ª12;;Ž¡‘ÌÍ14–¿ª:“intŽ¦‘ÌÍ#test;;Ž¡‘ÌÍ"{1,Ž¡‘L!2,Ž¡‘L!3,4,5,6}"Ž¡‘ÌÍ:‘¿ªtermŽ¦‘ÌÍ#set_margin‘¿ª72;;Ž¡‘ÌÍ12–¿ª:“intŽŽ’Æq°„†ðþffŽŽŸÀ‰ffÇ IŽŽŽ û¦‘ÇaÖThe–§rules“are“not“doing“what“wš¬re“w˜an˜t.‘"\This“is“bSŽecause“instead“of“ha˜ving“all“the“elemen˜tsŽ¤‘Çaof–r®the“set“appšSŽear“at“the“same“lev¬rel“of“a“single“b˜o¬rx,‘Š­they“o˜ccur“at“di erenš¬rt“lev˜els“in“a“c˜hainŽ¡‘Çaof–€ nested“bšSŽo¬rxesŸû¥2¸2ŽŽ‘ÀÖ.‘VT‘ÿVo“b˜e“able“to“express“a“relationship“b˜et•¬rw“een–€ Ùal‘™™l‘¾œÖthe“elemen¬rts“of“the“set,Ž¡‘Çawš¬re–²!need“to“bSŽe“able“to“grab“them“all“in“one“call“to“the“prin˜ter,‘½oso“that“w˜e“ma˜y“place“themŽ¡‘Çaall–ê¨at“the“same“bSŽoš¬rx“lev˜el.‘8àThere“is“a“spSŽecial“pattern“whic˜h“allo˜ws“us“to“do“this.Ž¡‘(ðThe–lBÙlo‘ÿffoping‘yÄÖconstruct“consists“of“t•¬rw“o–lBpatterns.‘ ½­The“ rst“is“enclosed“within“squareŽ¡‘Çabrac•¬rk“ets.‘¶tIt–„is“follo•¬rw“ed›„b“y˜the˜second˜pattern.‘¶tThe˜com“bined˜pattern˜tries˜to˜matc“h˜theŽ¡‘Ça rst–ZÆpattern“zero“or“more“times,‘vÍand“when“the“ rst“no“longer“matcš¬rhes“it“tries“to“matc˜hŽ¡‘Çathe–(ˆsecond“exactly“once.›ø+This“probably“requires“further“explanation.˜W‘ÿVe“bšSŽegin“b¬ry“lo˜okingŽ¡‘Çaat–ê¨the“rule“for“our“example.Ž‘ÇaŸ »º‰ffqÏŸŸ ™š‘ ƒŸü^ÿ³2ŽŽ‘ÄThe–UUnesting“is“not“explicit“in“the“rules,“but“oGccurs“bš¸ãy“w˜a˜y“of“the“recursiv˜e“calls“to“the“prin˜ter.ŽŽŽŒ‹Åó ÌU ýFÓŸú™š‘êñëÛ14’%·^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ýâ’²‘êñ럣ՉffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I © ÌÍŸYœ„­yœff ÿ]7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍrulesŽ© ‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term'::[COMB(COMB(CONST(INSERT(),**),*elems),<>COMB(**))]Ž¦‘E COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**))‘¿ª->Ž¦‘E [“"{"“[“**[“*elems“","]“*elem]“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„­yœffŽŽ¡‰ffÇ IŽŽŽ ÅÓ´‘êñëÖThe–Œ/Ó<>“Öwithin“the“ rst“part“of“the“lošSŽoping“pattern“is“used“to“lab˜el“the“sub-tree“whic¬rh“willŽ¤‘êñëbšSŽe–lpused“on“the“next“matc¬rh“attempt“(the“next“time“round“the“lo˜op).‘¾7This“will“t¬rypicallyŽ¡‘êñëappSŽear–åEwithout“anš¬ry“pattern“follo˜wing“it.‘7This“w˜ould“indicate“that“no“restriction“is“bSŽeingŽ¡‘êñëplaced–6oon“the“sub-tree“to“bSŽe“used“on“the“next“matcš¬rh“attempt.‘5Ho˜w˜ev˜er“in“the“example,Ž¡‘êñëÓ<>– šÖis“follo•¬rw“ed› šb“y˜ÓCOMB(**)Ö.‘ÚµThis˜spSŽeci es˜that˜the˜sub-tree˜m“ust˜ha“v“e˜a˜ÓCOMB‘ ŒÖas˜its˜roSŽotŽ¡‘êñënoSŽde.Ž¡‘öSzThe–UÀloSŽoping“part“of“the“pattern“matcš¬rhes“a“c˜hain“of“ÓINSERTÖs.‘=The“represen˜tation“of“a“setŽ¡‘êñëis–£èsucš¬rh“a“c˜hain.‘!KHo˜w˜ev˜er,‘²the“last“ÓINSERT‘£ÖÖin“the“c˜hain“is“not“matc˜hed“b˜y“the“loSŽoping“partŽ¡‘êñëof–°ƒthe“pattern,‘¼$bšSŽecause“the“sub-tree“to“b˜e“used“on“the“next“matc¬rh“attempt“do˜es“not“ha•¬rv“eŽ¡‘êñëÓCOMB‘)MÖas–)]its“roSŽot“(This“is“assuming“that“the“cš¬rhain“of“ÓINSERTÖs“is“terminated“b˜y“an“ÓEMPTYÖ).Ž¡‘êñëF‘ÿVor–nthose“ÓINSERTÖs“whicš¬rh“are“matc˜hed“during“the“loSŽop,‘ŽÞthe“elemen˜ts“bSŽeing“`inserted'“areŽ¡‘êñëbSŽound–ê¨as“a“list“to“the“meta¬rv‘ÿXäariable“Ó*elemsÖ.Ž¡‘öSzWhen–ê¨the“loSŽoping“terminates,“w¬re“are“left“with“something“of“the“form:ŽŸ™š‘ü0éÓ(INSERT–¿ª*elem)“EMPTYŽŸ‘êñëÖwhicš¬rh–ê¨as“w˜e“ha˜v˜e“seen“bSŽefore“is“matc˜hed“b˜y“the“remainder“of“the“pattern.Ž¡‘öSzW‘ÿVe–¶ubind“the“last“elemen¬rt“separately“bšSŽecause“it“needs“to“b˜e“treated“di eren¬rtly“in“theŽ¡‘êñëformat.‘8à(The–ê¨last“elemenš¬rt“is“not“follo˜w˜ed“b˜y“a“comma).Ž¡‘öSzThe›ÞÓ**[“*elems“","]˜Öin˜the˜format˜expands˜to˜a˜sequence˜of˜bSŽo•¬rxes,‘à•one˜for˜eac“hŽ¡‘êñëelemenš¬rt–*ÔbSŽound“to“Ó*elemsÖ,‘Q2in“whic˜h“the“elemen˜t“is“follo˜w˜ed“b˜y“a“comma“(on“the“same“line).Ž¡‘öSzThere–"is“a“lot“more“to“bšSŽe“said“ab˜out“these“lo˜oping“patterns“and“expanding“b˜o¬rxes,‘!butŽ¡‘êñëwš¬re–éÓshall“not“go“in˜to“it“here.‘8™Instead“let's“see“if“the“new“rules“really“do“do“what“w˜e“w˜an˜t.ŽŽŽŒ‹Î ÌU ýFÓŸú™š‘ÇaÛ1.2.‘ €Example:‘a›€prett• y-prin“ter˜for˜set˜theory˜in˜HOL‘z‚c15Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ýÅ#Ò‘ÇaŸ»µ‰ffÇ IŸ€ùÌÍŸYœ„ƒÚ•ffŸ†|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ21ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`sets`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`sets_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(sets_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`term`“[]“(pp_convert_term“t));;Ž¡‘ÌÍ-–¿ª:“(term“->“void)ŽŽ’Æq°„ƒÚ•ffŽŽŸÀ‰ffÇ IŽŽŽ mE‘Ça ÿt‰ffÇ I  —bÌÍŸYœ„ðþff þøf’¯ð „ ׸莒°¨ô„¸è®dŽ’¶Í°ŸýÈ22ŽŽŽŽŸÿ@T‘ÌÍÓ#test;;Ž¤ ‘ÌÍ"{1,2,3,4,5,6}"–¿ª:“termŽ©‘ÌÍ#set_margin‘¿ª14;;Ž¡‘ÌÍ72–¿ª:“intŽ¦‘ÌÍ#test;;Ž¡‘ÌÍ"{1,2,3,4,5,Ž¡‘L!6}"Ž¡‘ÌÍ:‘¿ªtermŽ¦‘ÌÍ#set_margin‘¿ª12;;Ž¡‘ÌÍ14–¿ª:“intŽ¦‘ÌÍ#test;;Ž¡‘ÌÍ"{1,2,3,4,Ž¡‘L!5,6}"Ž¡‘ÌÍ:‘¿ªtermŽ¦‘ÌÍ#set_margin‘¿ª72;;Ž¡‘ÌÍ12–¿ª:“intŽŽ’Æq°„ðþffŽŽŸÀ‰ffÇ IŽŽŽ ¸né‘ÇaÖThere–c¶is“one“more“thing“to“saš¬ry“bSŽefore“lea˜ving“the“example.‘¤ The“prett˜y-prin˜ter“for“ÍHOLŽ¤‘ÇaÖterms–Ômuses“a“parameter“called“`ÓprecÖ'“to“hold“the“precedence“of“the“paren¬rt“opSŽerator.‘ö/IfŽ¡‘Çaa–cyrule“došSŽes“not“explicitly“mo˜dify“this“parameter,‘­it“is“passed“on“uncš¬rhanged“to“recursiv˜eŽ¡‘Çacalls–A«of“the“prinš¬rter.‘=èThe“braces“of“the“set“notation“prev˜en˜t“an˜y“am˜biguit˜y‘ÿV,‘Wkso“w˜e“do“notŽ¡‘Çaneed–b?to“knoš¬rw“the“precedence“of“the“paren˜t“opSŽerator.‘ Ÿ¦If“within“a“set“w˜e“consider“theŽ¡‘Çaseparating–ecommas“to“ha•¬rv“e–ethe“lo•¬rw“est–epSŽossible“precedence,‘ƒžthen“the“elemen¬rts“of“the“setŽ¡‘Çashould–D³not“appSŽear“enclosed“within“parenš¬rtheses.‘GW‘ÿVe“force“this“b˜y“making“`ÓprecÖ'“ha˜v˜e“itsŽ¡‘Çahighest–ÂNpšSŽossible“v‘ÿXäalue“(whic¬rh“corresp˜onds“to“the“lo•¬rw“est–ÂNprecedence)“for“all“recursiv¬re“callsŽ¡‘Çaof–ê¨the“prin¬rter.ŽŽŽŒ‹Ø• ÌU ýFÓŸú™š‘êñëÛ16’%·^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß þ0’²‘êñë ÿO£Õ‰ffÇ IŸ ~·ÌÍŸYœ„ØSffŸù7u‘ÌÍÓsets.ppŽŽ’Æq°„ØSffŽŽ¤À‰ffÇ I E ÌÍŸYœ„Iyœff þÁ7u‘ÌÍprettyprinter–¿ªsets“=Ž¤‘ÌÍabbreviationsŽ© ‘ Ëmax_prec–¿ª=“{apply0“max_term_prec};Ž¡‘ÌÍend‘¿ªabbreviationsŽŸ'‘ÌÍrulesŽ¦‘ Ë'term'::CONST(EMPTY(),**)–¿ª->“[“"{}"];Ž¡‘ Ë'term'::[COMB(COMB(CONST(INSERT(),**),*elems),<>COMB(**))]Ž¦‘E COMB(COMB(CONST(INSERT(),**),*elem),CONST(EMPTY(),**))‘¿ª->Ž¦‘E [“"{"“[“**[“*elems“withŽ¦’6zÿprec–¿ª:=“max_precŽ¦’%<end‘¿ªwithŽ¦’üþ[","]Ž¦’ÉAa*elem‘¿ªwithŽ¦’üþ[prec–¿ª:=“max_precŽ¦’ë¿]end–¿ªwith]“"}"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„IyœffŽŽ¡‰ffÇ IŽŽŽ ŸmN‘êñëmax_precŽ‘7¨Öis–Hma“v‘ÿXäalue“suitable“for“use“within“the“prett•¬ry-prin“ting–Hmlanguage.‘ÌIt“is“deriv¬red“fromŽ¤‘êñëthe–BUv›ÿXäalue“of“the“ÍML“Öiden¬rti er“Ómax_term_precŽ‘Ný÷Ö.‘?èThe“v˜alue“of“Ómax_term_precŽ‘S@LÖis“the“largestŽ¡‘êñëpšSŽossible–5¸precedence“v‘ÿXäalue“(lo•¬rw“est–5¸precedence)“for“a“ÍHOL“Ö`op˜erator'.‘The“transformationŽ¡‘êñëfrom‘ê¨Ómax_term_precŽ‘RòÖto‘ê¨Ómax_precŽ‘5Ò Öis–ê¨explained“in“Chapter“3.ŽŽŽŒ‹à` ÌU ýFÓŸú™š‘ÇaÛ1.3.‘ €CA UTION!’UÑ17Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç1.3Ž‘@ åCA‘ÿr°UTION!ŽŸ¾è‘ÇaÖThe–_˜previous“section“illustrates“hoš¬rw“the“ÍHOL“Öprett˜y-prin˜ter“can“bSŽe“extended.‘—¯It“shouldŽ¤‘Çanot–uëbšSŽe“hard“to“see“that“the“same“metho˜ds“could“b˜e“used“to“Ùmo‘ÿffdify‘ƒmÖthe“ÍHOL“Öprett¬ry-Ž¡‘Çaprinš¬rter.‘·F‘ÿVor–E-example,‘fEconsider“the“follo˜wing“prett˜y-prin˜ter“whic˜h“pSŽerforms“an“exceedinglyŽ¡‘Çaundesirable‘ê¨transformation.ŽŸ^g ‘ÇaŸ·S1‰ffÇ IŸ ÌÍŸYœ„yœffŸù7u‘ÌÍÓbad.ppŽŽ’Æq°„yœffŽŽ¤À‰ffÇ IŸu ÌÍŸYœ„yyœffŸ‘7u‘ÌÍprettyprinter–¿ªbad“=Ž¤‘ÌÍrulesŽŸ ‘ Ë'term'::CONST(F(),**)–¿ª->“[“"T"];Ž¡‘ÌÍend‘¿ªrulesŽŸ'‘ÌÍend‘¿ªprettyprinterŽŽ’Æq°„yyœffŽŽ¡‰ffÇ IŽŽŽŸ_Ñä‘ÇaÖW‘ÿVe–I can“makš¬re“use“of“this“in“a“ÍHOL“Ösession.‘ TFirst“w˜e“en˜ter“ÍHOL“Öand“load“the“libraryŽ¡‘ÇaÓprettypŽ‘;Ö.Ž „u‘ÇaŸ”µ‰ffÇ I Í€ùÌÍŸYœ„ÑÚ•ff ÿ8|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ1ŽŽŽŽŸ @T‘?IqÓ_‘ T_–þ¨__“_‘"}ü__“__Ž¤ ‘ Ë|___–>þ|__|“|› T|“|‘¾R|__|˜|__|Ž¡‘ Ë|‘"}ü|› T|–>þ|__|“|__“|__|˜|__|Ž¤‘?IqVersion‘¿ª2Ž¡‘ÌÍ#load_library‘¿ª`prettyp`;;Ž¤ ‘ÌÍLoading–¿ªlibrary“`prettyp`“...Ž¡‘ÌÍUpdating–¿ªhelp“search“pathŽ¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.............................................................................Ž¡‘ÌÍ.............................................................Ž¡‘ÌÍLibrary–¿ª`prettyp`“loaded.Ž¡‘ÌÍ()–¿ª:“voidŽŽ’Æq°„ÑÚ•ffŽŽŸÀ‰ffÇ IŽŽŽ ƒ_‘ÇaÖNo•¬rw›ê¨w“e˜loSŽok˜at˜the˜de nition˜of˜ÙfalseÖ.ŽŸ(üÚ‘ÇaŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ2ŽŽŽŽŸÿ@T‘ÌÍÓ#let–¿ªtest“=“F_DEF;;ŽŸ ‘ÌÍtest–¿ª=“|-“F“=“(!t.“t)ŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ(_‘ÇaÖThe–ê¨new“prett•¬ry-prin“ter–ê¨can“bSŽe“compiled,“loaded“and“linkš¬red“in˜to“the“ÍHOL“Ösystem:ŽŽŽŒ‹僠ÌU ýFÓŸú™š‘êñëÛ18’%·^Chapter‘€1.‘ €In tro`ductionŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ýË£Ò‘êñ럴’µ‰ffÇ I Œ€ùÌÍŸYœ„Ú•ff ÿy|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ3ŽŽŽŽŸÿ@T‘ÌÍÓ#PP_to_ML–¿ªfalse“`bad`“``;;Ž¤ ‘ÌÍ()–¿ª:“voidŽ©‘ÌÍ#loadf‘¿ª`bad_pp`;;Ž¡‘ÌÍ..()–¿ª:“voidŽ¦‘ÌÍ#top_print–¿ª(\t.“pp“(bad_rules_fun“then_tryŽ¡‘ÌÍ#‘m9žhol_thm_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_term_rules_fun‘¿ªthen_tryŽ¡‘ÌÍ#‘m9žhol_type_rules_fun)–¿ª`thm`“[]“(pp_convert_thm“t));;Ž¡‘ÌÍ-–¿ª:“(thm“->“void)ŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŸ\)‘êñëÖThe–åresult“is“a“theorem“whicš¬rh,‘æ'although“pSŽerfectly“v‘ÿXäalid“in“the“underlying“represen˜tation,ŽŸ‘êñëappSŽears–ê¨to“the“user“in“a“vš¬rery“unpleasan˜t“form.ŽŸ!©‘êñëŸïµ‰ffÇ IŸ€ùÌÍŸYœ„Ú•ffŸî|y’¯ð „ ׸莒°¨ô„¸è®dŽ’¹M±ŸýÈ4ŽŽŽŽŸÿ@T‘ÌÍÓ#test;;ŽŸ ‘ÌÍ|-–¿ªT“=“(!t.“t)ŽŽ’Æq°„Ú•ffŽŽŸÀ‰ffÇ IŽŽŽŽŽŒ‹í¹ ÌU ýFÓ ”/ß ý‹Ð!‘ÇaâChapter‘…2Ž‘ÇaŸ Ì̉Ç>|ŸGëHThe› ‰‹prett–ÿ4‰y-prin“ting˜languageŽŸÖx‰Ç>|Ÿ:UTÖA‘ç†description–çÈof“the“synš¬rtax“and“informal“seman˜tics“of“the“prett˜y-prin˜ting“language“follo˜ws.Ž¤The–5¸language“is“describSŽed“top-doš¬rwn,‘H|and“the“description“is“in˜tended“to“pro˜vide“detailedŽ¡information–LbabSŽout“language“constructs.‘^The“information“is“in¬rtended“for“reference“or“forŽ¡use–ê¨when“the“examples“do“not“proš¬rvide“sucien˜t“information.Ž¡‘ aA‘ÞTprett•¬ry-prin“ter–Þ“spSŽeci cation“consists“of“the“name“of“the“prett•¬ry-prin“ter–Þ“and“a“list“ofŽ¡ÙrulesÖ.‘8àThe–ê¨rules“maš¬ry“optionally“bSŽe“preceded“b˜y“Ùde–ÿffclar“ations‘è…Öand/or‘ê¨Ùabbr“eviationsÖ.Ž© Ó‘[ú ::=‘ T"prettyprinter"–¿ª“"="Ž¤ ™š’ ö˜Ž¡’·š"end"‘¿ª"prettyprinter"Ž¦‘P{L::=‘ TŽ¡‘~xœ|– T“Ž¡‘~xœ|‘ T‘¿ªŽ¡‘~xœ|– T“‘¿ªŽ©'â ç2.1Ž‘-C„Naming–Ÿ¼a“prett–ÿr°y-prin“terŽŸâ#ÖThe– •name“givš¬ren“to“a“prett˜y-prin˜ter“is“used“to“obtain“the“names“of“the“ÍML“Öv‘ÿXäalues“generatedŽ¤b¬ry–ê¨the“compiler.‘8àIn“fact“the“compiler“generates“ÍML“ÖcoSŽde“for“declarations“of“these“v‘ÿXäalues.Ž¡‘ aIf–íÌthe“prett•¬ry-prin“ter–íÌis“called“ÓxxxxÖ,‘î”then“the“ÍML“Ö le“generated“b¬ry“the“compiler“will“de-Ž¡clare‘q5Óxxxx_rulesŽ‘@_Öas–q5a“list“of“rules“for“the“prett•¬ry-prin“ting–q5program.‘dThe“program“normallyŽ¡uses––|a“function“derivš¬red“from“the“rules,‘§Qand“suc˜h“a“function“is“declared“within“the“ÍML“Ö le.Ž¡Its–ê¨name“is“Óxxxx_rules_funŽ‘TeôÖ.Ž¦ç2.2Ž‘-C„DeclarationsŽŸâ#ÖThe–Fëdeclarations“are“a“list“of“bindings“of“an“idenš¬rti er“(whic˜h“is“restricted“to“the“iden˜ti ersŽ¡allo•¬rw“ed–ê¨in“the“prett•¬ry-prin“ting–ê¨language)“to“a“piece“of“ÍML“ÖcoSŽde.Ž¤ Ó‘"}ü::=‘ T"declarations"‘¿ªŽ© ™š’ ö˜"end"‘¿ª"declarations"Ž¡‘"}ü::=‘ T‘¿ª";"Ž¦‘~xœ|‘ T–¿ª";"“ŽŽŸ$ý’烈Û19ŽŽŒ‹ñ ÌU ýFÓŸú™š‘êñëÛ20’Ä\¶Chapter–€2.‘ €The“prett• y-prin“ting‘€languageŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÓ‘?–¿ª"="“Ž©ç‘êñëÖThe–KøÍML“ÖcošSŽde“m¬rust“b˜e“function“v‘ÿXäalued.‘\ÐThe“iden¬rti ers“b˜ecome“ÍML“Öiden¬rti ers,‘dLb˜ound“toŽ¤‘êñëthe–œv‘ÿXäalue“of“the“ÍML“ÖcošSŽde.‘§½They“b˜ecome“a¬rv‘ÿXäailable“for“use“within“blo˜c¬rks“of“ÍML“Öco˜de“laterŽ¡‘êñëin– the“prett•¬ry-prin“ter– spSŽeci cation.‘‘¾R::=‘ T"abbreviations"‘¿ªŽŸ ™š’‹èƒ"end"‘¿ª"abbreviations"ŽŽŽŒ‹ùÄ ÌU ýFÓŸú™š‘ÇaÛ2.4.‘ Rules’zð21Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘Çaç2.4Ž‘@ åRulesŽŸd‘ÇaÖThe›»œprett•¬ry-prin“ting˜rules˜are˜ordered.‘)1An˜earlier˜rule˜has˜priorit“y˜o“v“er˜a˜later˜rule.‘)1So,‘ÅifŽ¤‘Çarule–È×Y›¸8Öis“a“spSŽecial“case“of“rule“×X‘ñƒÖ,‘(×Y˜Öwill“only“ev¬rer“bšSŽe“used“if“it“app˜ears“b˜efore“×X‘ KÖin“theŽ¡‘Çalist– ýof“rules.‘ÛàThis“is“bSŽecause“×X‘€Öwill“matcš¬rh“an˜y“tree“that“×Y‘½mÖw˜ould“matc˜h.‘ÛàF‘ÿVor“ev˜ery“treeŽ¡‘Çaor–usub-tree“it“has“to“prinš¬rt,‘,¨the“prett˜y-prin˜ter“bSŽegins“searc˜hing“from“the“bSŽeginning“of“theŽ¡‘Çalist–ê¨for“a“rule“whicš¬rh“matc˜hes.Ž©˜Á‘ÇaÓ‘J»¢::=‘ T"rules"–¿ª“"end"“"rules"Ž¤XÜ‘Ça‘3¼ú::=– T›¿ª";"“|“˜";"˜Ž¡‘Ça‘P{L::=‘ T–¿ª"->"“Ž¤ ™š’‘?ý|‘ T‘¿ª"->"Ž¡’³½ù"<<"–¿ª“">>"“ŽŸ¿B‘ÇaÖA‘2ârule–3normally“consists“of“t•¬rw“o–3parts.‘û­The“Ùp‘ÿffattern‘ÀÖis“used“to“matcš¬rh“the“tree“to“bSŽe“prin˜ted,Ž¤‘Çaand––†to“bind“sub-trees“and“nošSŽde-names“to“v‘ÿXäariables.‘ÕThe“Ùformat‘ºÊÖsp˜eci es“what“to“displa¬ry‘ÿV.Ž¡‘ÇaIt–íEcan“mak¬re“use“of“the“sub-trees“and“nošSŽde-names“b˜ound“to“the“v‘ÿXäariables.‘@¸There“is“anŽ¡‘Çaoptional–5third“part“to“a“rule“whic¬rh“pšSŽerforms“transformations“on“the“v‘ÿXäariables“b˜et•¬rw“eenŽ¡‘Çamatc¬rhing–ê¨and“passing“the“v‘ÿXäariables“to“the“format.ŽŸ$T®‘Çaâ2.4.1Ž‘E`âPŠ=atternsŽŸAë‘ÇaÖA‘Zpattern–ZCconsists“of“a“Ùc‘ÿffontext‘~‡Öin“whic¬rh“the“rule“is“suppSŽosed“to“apply“and“a“tree“structureŽ¡‘Çato–îbšSŽe“compared“with“the“tree“to“b˜e“prinš¬rted.‘̳There“is“also“an“optional“test“whic˜h“can“bSŽeŽ¡‘Çaused–ůto“reject“the“rule“under“conditions“whicš¬rh“cannot“bSŽe“expressed“b˜y“the“tree“structure.Ž¦‘ÇaÓ‘?–¿ª"::"“ŽŸ ™š’‘?ý|‘ T–¿ª"::"““"where"“Ž©"T®‘ÇaÛ2.4.1.1Ž‘F‡aCon textŽŸAë‘ÇaÖA‘¶(conš¬rtext–¶\is“represen˜ted“b˜y“a“string“Ó'...'Ö.‘›ýIf“the“string“is“empt˜y‘ÿV,›éIi.e.“Ó''Ö,˜the“rule“canŽ¡‘Çaapply–in“anš¬ry“con˜text.‘òIf“the“string“has“an˜y“other“form,‘@ the“rule“can“only“apply“in“a“con˜textŽ¡‘ÇacorrespSŽonding–Ô“to“that“string.‘1„The“initial“conš¬rtext“is“set“when“the“prett˜y-prin˜ting“functionŽ¡‘Çais‘ê¨called.Ž¦‘ÇaÛ2.4.1.2Ž‘F‡aT‘þàests–€in“patternsŽŸAë‘ÇaÖA‘Ûütest–Ücan“bSŽe“used“to“reject“a“rule“evš¬ren“when“the“con˜text“matc˜hes“and“the“tree“matc˜hes.ŽŸ˜Á‘ÇaÓ‘P{L::=– T“|“ŽŽŽŒ‹× ÌU ýFÓŸú™š‘êñëÛ22’Ä\¶Chapter–€2.‘ €The“prett• y-prin“ting‘€languageŽ‘êñëŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘êñëÖA‘u™test–u½is“either“a“blošSŽc¬rk“of“ÍML“Öco˜de“(see“Section“2.2.1)“or“an“idenš¬rti er“whic˜h“m˜ust“ha˜v˜eŽ¤‘êñëbšSŽeen–E'de ned“as“an“abbreviation“for“a“blo˜c¬rk“of“ÍML“Öco˜de“(see“Section“2.3).‘H^In“either“caseŽ¡‘êñëthe–ê¨blošSŽc¬rk“of“ÍML“Öco˜de“mš¬rust“ev‘ÿXäaluate“to“a“function“of“t˜ypSŽe:Ž©!o‘ü0éÓ(string–¿ª#“int)“list“->“print_binding“->“boolŽŸ‡Õ‘êñëÖThe–M~ rst“argumenš¬rt“to“suc˜h“a“function“is“a“list“of“parameters,‘f4represen˜ted“b˜y“pairs.‘abTheŽ¡‘êñë rst–rÍelemenš¬rt“of“a“pair“is“the“name“of“the“parameter.‘ìThe“second“elemen˜t“is“the“parameterŽ¡‘êñëv‘ÿXäalue.‘TThe–žsecond“argumenš¬rt“is“the“binding“of“meta˜v‘ÿXäariables“to“sub-trees“and“noSŽde-namesŽ¡‘êñëresulting–Š–from“matc¬rhing“the“tree.‘«The“result“is“a“BoSŽolean“v‘ÿXäalue“indicating“whether“theŽ¡‘êñëtest–ê¨is“successful“or“whether“it“fails.Ž¡‘öSzSo,‘®=the–Sìtest“is“an“ÍML“Öfunction“whicš¬rh“can“examine“the“v‘ÿXäalues“of“the“prett˜y-prin˜tingŽ¡‘êñëparameters–ØN(e.g.“precedence)“and“the“bindings“of“metaš¬rv‘ÿXäariables.‘ ÑThe“con˜text“is“alsoŽ¡‘êñëa¬rv‘ÿXäailable–ê¨for“testing.‘8àIt“appSŽears“in“the“parameter“list“as“a“pair“of“the“form:Ž¦‘ü0éÓ(`CONTEXT_xxxx`,n)ŽŸ‡Õ‘êñëÖwhere–ê¨Óxxxx“Öis“the“currenš¬rt“con˜text,“and“Ón“Öis“an˜y“n˜um˜bšSŽer“(it“do˜es“not“matter“whic¬rh).ŽŸ »%‘êñëÛ2.4.1.3Ž‘±ëMeta v‘ÿ@ariablesŽŸÀ‘êñëÖBefore–ê¨considering“patterns“for“tree“structures,“it“is“wš¬rorth“considering“meta˜v‘ÿXäariables.Ž¦‘êñëÓ‘"}ü::=– T"***"“|“"***"‘¿ªŽ¦‘êñ둾R::=– T"*"‘þ¨|“"*"‘>þŽ¦‘êñë– T::=“"**"‘>þ|“"**"“Ž¦‘êñë‘"}ü::=‘ TŽ¤ ™š‘ij‡|‘ TŽ¡‘ij‡|‘ TŽ¡‘ij‡|‘ T‘¾R";"‘¿ªŽ¡‘ij‡|‘ T‘þ¨";"‘¿ªŽ¡‘ij‡|‘ T–¿ª";"“ŽŸ‡Õ‘êñëÖThere–S×are“three“kinds“of“meta•¬rv›ÿXäariable.‘šMeta“v˜ariables–S×of“the“form“Ó***...“Ömatcš¬rh“an˜y“noSŽde-Ž¤‘êñëname–9Øand“if“the“Ó***“Öis“follo•¬rw“ed›9Øb“y˜an˜iden“ti er,‘]5the˜no•SŽde-name˜is˜b“ound˜to˜a˜meta¬rv‘ÿXäariableŽ¡‘êñënamed–ÄMas“the“iden•¬rti er.‘ ÅÐMeta“v‘ÿXäariables–ÄMof“the“form“Ó*...“Ömatcš¬rh“an˜y“sub-tree.‘ ÅÐÓ**...Ž¡‘êñëÖmatcš¬rhes–ê¨a“list“of“sub-trees.‘8àThe“list“can“bSŽe“empt˜y‘ÿV.Ž¡‘öSzConsider–ê¨the“follo¬rwing“tree:Ž¦’¿¥}ÓcondŽ¤ ™š’¿¥}/–¿ª|“\Ž¡’¨¦Õtrue–¿ªone“zeroŽŽŽŒ‹ ÌU ýFÓŸú™š‘ÇaÛ2.4.‘ €Rules’yp23Ž‘ÇaŸff‰æfÇ>|ŽŽŽ ”/ß ý‹Ð!‘ÇaÖThe–Û#pattern“Ó*x“Öwill“matcš¬rh“this“tree“and“bind“the“whole“tree“to“the“meta˜v‘ÿXäariable“Ó*xÖ.‘3´TheŽ¤‘Çapattern–vøÓ***x(*,*,*)“Öalso“matc¬rhes“the“tree“and“binds“Ó***x“Öto“the“name“ÓcondÖ.‘PThe“same“isŽ¡‘Çatrue–å³for“Ó***x(**)Ö,–æ±Ó***x(*,**)Ö,“Ó***x(*,**,*)Ö,“bSŽecause–å³Ó**“Ömatc¬rhes“zero“or“more“sub-treesŽ¡‘Ça(Ùchildr‘ÿffenÖ).‘8àThe–ê¨pattern“Ócond(**)“Öalso“matc¬rhes,“but“no“binding“oSŽccurs.Ž¡‘(ðÓcond(*x,*y,*z)–IÞÖmatc¬rhes“the“tree“and“binds“Ó*xÖ,–¡«Ó*yÖ,“Ó*z–IÞÖto“Ótrue()Ö,–¡«Óone()Ö,“Ózero()‘IÞÖre-Ž¡‘ÇaspšSŽectiv¬rely‘ÿV.‘ ¶Ótrue()–ÛïÖmeans“a“tree“with“ro˜ot“no˜de“lab˜elled“with“Ótrue“Öand“no“c¬rhildren.Ž¡‘ÇaÓcond(*x,*y)–ê¨ÖdošSŽes“not“matc¬rh“as“this“pattern“is“for“a“no˜de“with“precisely“t•¬rw“o‘ê¨c“hildren.Ž¡‘(ðThe–öpattern“Ócond(true(),**x)“Ömatcš¬rhes“the“tree“and“binds“the“meta˜v‘ÿXäariable“Ó**x“Öto“aŽ¡‘Çalist–3îof“t•¬rw“o›3îelemen“ts.‘²The˜ rst˜elemen“t˜is˜the˜tree˜Óone()Ö.‘²The˜second˜elemen“t˜is˜the˜treeŽ¡‘ÇaÓzero()Ö.Ž¡‘(ðIf–more“than“one“Ó**...“Ömetaš¬rv‘ÿXäariable“is“used“for“matc˜hing“the“c˜hildren“(for“exampleŽ¡‘ÇaÓcond(**x,**y)Ö),–ê¨all“but“the“ rst“ha•¬rv“e–ê¨to“matcš¬rh“precisely“one“c˜hild.Ž¡‘(ðThe–˜¿name“of“a“metaš¬rv‘ÿXäariable“(if“presen˜t)“should“bSŽe“though˜t“of“as“separate“from“the“Ó***Ö,Ž¡‘ÇaÓ*Ö,‘Ž¥or–mÙÓ**Ö.‘ÂsThe“latter“spšSŽecify“what“kind“of“ob‘§ject“is“to“b˜e“matc¬rhed.‘ÂsThe“name“binds“theŽ¡‘Çamatc¬rhed–ê¨ob‘§ject.‘8àThe“upshot“of“this“is“that“Ó***x“Öand“Ó*x“Ö(for“example)“are“not“distinct.ŽŸ —‘ÇaÛ2.4.1.4Ž‘F‡aP atterns–€for“treesŽŸÀ‘ÇaÖIn–describing“metaš¬rv‘ÿXäariables“(see“Section“2.4.1.3)“it“w˜as“necessary“to“describSŽe“simple“pat-Ž¡‘Çaterns.‘8àThe–ê¨full“syn¬rtax“of“patterns“for“trees“is:Ž© †‘ÇaÓ‘"}ü::=‘ T–¿ª"("“")"Ž¤ ™š’‘?ý|‘ T–¿ª"("““")"Ž¡’‘?ý|‘ TŽ¡’‘?ý|‘ T