(* SML file and specification for NFU* sequent prover *)

(* this is a Standard ML program *)
fun Flush() = TextIO.flushOut(TextIO.stdOut);
fun say s = (TextIO.output(TextIO.stdOut,"\n"^s^"\n");Flush());

fun getstuff() = (TextIO.input(TextIO.stdIn);());


fun versiondate() = 
say "Feb. 1, 2007:  this program has the savetheory command\nto save theories in a form readable by the new prover.\nfixed error in Jan 10 version\nTheory save saves the current proof not just the theorem list.\nSaves proofs in script format.\nJan 29 fixed bug in definitions.\nfixed stupid bug in line number counter storage.\nApr 9 installed working directories.";

(* directories *)

val DIR = ref "";

(* this might not work right in Linux; change to "/"? *)

fun dir "" s = s |

dir t s = t^"\\"^s;

fun setdir s = dir (!DIR) s;

fun SetDir s = DIR:=s;

fun runtext s = Meta.use(setdir(s^".txt"));

fun runscript s = Meta.use(setdir(s^".mlg"));

(*

Apr 9 2007:

updated to support working directories.  
This really only matters for accessing
the start of Joanna's proofs.

When I write demo mode for marcel.sml I should also install it here.

*)


(*

Feb 5:  updated to support indexing of line numbers at which unknown
variables are introduced; it exports this data to the new prover rather
than using it itself.

*)

(*

Feb 1:  serial numbers for propositions in proofs and for proof lines
were completely muddled in savetheory; fixed.

*)

(*

Jan 29:  changed the savetheory command to strip out the "definitions"
of declared notions from PROPDEFS and TERMDEFS; they cause a bug in
the new prover's matching procedure!

*)

(*

Jan 23:  full theory loading and saving i hope...

Jan. 23: this version saves the proof in progress (but not the proofs
in the theorem list) as a script; the new prover can now read Joanna
Guild's proof files but could no longer read them if she proved her
current big theorem.  The intention is to extend the proof restore
script so that it builds the theorem list as well as the proof in
progress.

*)

(*

Jan 11:  fixed error which lost stratification information for all predeclared
operators in saved theories to be read by new prover.

*)

(* Jan 10, 2007:

The savetheory "name" command saves the current theory to files
name.thy1 and name.thy2 which can be read by the loadtheory command of the
new version.

There are some modifications to marcelsequent, mostly inessential, involved
in making this work.

I'm setting about installing theory export so that work can be transferred
to the new version marcel.sml.

*)

(* Dec 27

marcellandau may be broken for good?  It looks like another line
numbering change.  I should laboriously run yet another script
analysis I suppose -- or start a new development of these results.

This version now issues warnings when Start is run in a context
where the current proof is not complete.  This may be annoying or might prove useful...

mnemonic td for ThmDisplay is installed.

just comments

perhaps Ui's circularity condition could be liberalized by taking into
account Ui's for which no substitution has been proposed: these cannot
lead to circularity (yet).  For ai's there can be no analogous
liberalization.  But I'm not sure this is a good idea.

The prover should issue a warning if a Start command is issued when
no theorem has been proved?  "Proof not completed" or some such thing.
This will have a virtuous effect on log files!

The prover should not lock a lemma if the theorem application
fails (as for example if the theorem does not even exist) FIXED
but only for the case where the theorem actually doesnt exist!

The prover should not create a proof with a bad lemma in
it when a proof of an unproved sequent is attempted (see if
I can replicate this behavior; it happened when I misplaced
the proof of POSINV after the beginning of the incomplete proof of
MTIMESCONV.)  FIXED

rewriting with biconditionals would be useful.

Generalized set notation would be fairly easy to implement
and useful (it would give a rough and ready set notation) but
perhaps this should be reserved for the total rewrite.  The
same kind of binding of expressions might be useful with quantifiers
as well.

Commutative matching has significant practical appeal though it
is dangerous in combination with unknown variables.

Automatic search for application of theorems -- same issue.
Automatic and manual are both needed, depending on whether unknowns
are involved.

*)

(*

Dec 21:  conflict between notation for order relations < (probably > as
well) and the notation for the ordered pair.  This may be intractable...
How to keep the preparser from processing < when it is intended to start
a pair?  Alternative notation << when < is present?

I changed the primary notation for pairs.  [T,U] is now the standard
notation.  [T,U,V], for example, is read and displayed as [T,[U,V]].
The old notation is still parsed if no connectives < or > are present,
but the new display style is used throughout.

Idea that script files should reprocess term arguments and display them
in the latest display format? (for future reference)

*)

(*

Dec 20:  fix usethm or seqmatch so that it checks that all sequents in the
theorem have been matched!!! I can prove anything!!!  Emergency!

*)

(* Dec. 19 notes on Dec. 18 prover release

Upgraded SetEquals so that it works on the left as well as on the right,
to support a more familiar and less cumbersome style of equality reasoning.

*)

(*

Dec. 4:  

should have fixed all hanging errors caused by the fact that
primitive declared notions and defined notions are conflated.

Blocked unknown variables from definitions (FreeVar n is not "all defined"
if n <= 0).  What are the effects of ordinary free variables appearing
on right sides of definitions?  Perhaps they should not (but notice
that alldefined is also used to check axioms, which we do want to have
contain free variables).

Certain expansions should be carried out when the definition expansions
are blocked by primitive notions; these blocks currently stop anything
from happening.  Of course we do have ways to do these things now
using cuts and rewrites.

Should I alternatively push definition transparency by having alphaprop
and alphaterm expand definitions as well?

had to install matching of bound variables to free variables as
a special case.  In the reimplementation they should be two different kinds
of variables.  It would make life much easier (maybe).

I still have to handle matching of projections to free variables as a
special case...  Done (or at least attempted); this is a truly hideous
piece of cut-and-paste...  marcellandau.txt works again, which
indicates we have at least a first approximation.  The interaction
between fake projection matching and unknown variables may be weird: I
have to look at this.  Part of the problem here is that intelligent
pair matching is itself quite baroque; its interaction with a new
baroque feature may be expected to be weird...

Do I even want transparent definitions?  (matching of DefTerm(s,L) or
DefProp(s,L) with its definiendum).  Situations might arise where this happens
in the analysis work?

*)

(*

Dec. 2: 

The unification algorithm has unanticipated power:  for example, it will
compute left sides of theorems given right sides.

Make sure that right sides of definitions do not include unknown variables;
this could cause no end of trouble.DONE

The prover was actually proving theorems which had unification variable
hierarchy errors:  I fixed this by having it run "undo" when this error
message was reported.  This appears to work and might be a good model for
what to do when some other errors are reported?  I had to insert backup()
into Start and StartSequent; I wonder whether other user commands are
reliably reporting backup information?  I checked this, and they seem to.

The variable hierarchy (circularity) error could probably be restricted
to the variable Un itself and free variables with index >= n.  This would
allow new unknown variables to be introduced by unification, an effect
which is probably sometimes useful.

The next free variable index should also be restored by undo?  Maybe
some other stuff?

I was wondering why SetUnknown doesnt raise bound index, but I
note that witnessrule doesn't do this either.  It appears that the
bound index is only raised when substitutions are made into variable
binding contexts, and of course substitution is invoked when witness
or su is actually executed.  So I think it is all right.  I did a test;
it appears to work fine as it is.

This reminds me that I should at some point look at the indexing of
bound variables when definitions are instantiated; this might be
possible to improve (the indices seem to be too large).

Some liberalization of the current restraints on "unification",
allowing introduction of new variables of high index, might be of
interest.  There is a difference in the status of free variables and
unknown variables from the standpoint of circularity which might
eventually be exploited.  But there is something certainly to be said
for a conservative approach.

Should the old equality rules be disabled (or should disabling them be
provided as an option?)

I should install the conventional set/class rules as an option (under
which stratification would be disabled), since this is easy.

A notational extension which would be handy is function abstraction or
more generally a more flexible ability to introduce binding
constructions on terms as well as propositions.  The generalization of
set notation to allow general terms {T | U} would go some way in this
direction.  The new unknown variable machinery makes it easier to
represent the rules for this general construction in an economical
way.  One could then express (x |-> T) as {<x,y> | y = T}, which is
not _too_ bad.  Except for the fact that this would require yet
another tweak to the parser, this idea seems on the whole not bad.
(But be careful about substitution:  the variable binding here is weird).

A rewrite and documentation of design decisions is getting to be crucial; the
designer himself needs to think carefully to remember how some of this stuff
works.

*)

(* Dec. 1

This is an extremely dangerous version:  it has full unification, but it
does not have an occurs check (circular substitutions are possible?)  I need
to look carefully to see how to install the check to preserve soundness.

It now has the check; but I think the check could be weaker -- it really
perhaps only needs to check for free rather than unknown variables which
violate hierarchy.

The Guild file needs fewer su's...

Look through proof documents and see how autopruning is doing; I'm not
sure that it is maximally efficient.

*)

(*

check for infinite loop problems caused by definition expansion
of primitive notions:  I have encountered problems caused by conflation
of defined concepts with primitives in a couple of places.

The bug had nothing to do with automatic unknown evaluation, but it did reveal
a misconception about what can be done with unknown variables as presently
understood.  Matching of terms with unknown variables can be used to generate
automatic rewrites but not as easily as equations.

I have an idea:  matching any term t to Ui, set Ui to the version of t
with new unknowns replacing all free variables (a function we already have)
then match t to t'.  This should handle everything.

Nov. 30:  fixed automatic rewriting of unknowns to free variables --
it didn't check index order.

started working on a function to reset variable indices (to be used
by su) but it requires a scan of the entire proof for unknown variables.

*)

(*  November 29:

now attempting correct approach in rwr and its kin.  It appears to work:
the substitutions for Ui's are aborted if the term is not to be rewritten
due to the mask value.  A similar abort should be installed for failed
commands; one way to do this would be to cause alphaterm to reset USUBS
when it comes out false?  But is there a way to do this safely?

This version has the automated evaluation of unknowns, but the display
doesn't work quite right.  Display problem fixed, but does this really
work?  

It does need a repair for local rewriting:  I want it to discard 
matches as well as not making substitutions when it does the test
in the rewrite commands.  The behavior in Done, re, use theorem
commands is just fine.  Failed commands (those that do not have 
the intended effect) will have bad side-effects.

Does backup restore the variable counters?

modified rewritefree so that its treatment of unknown variables is
more closely analogous to its treatment of the usual free variables.

test3.mlg and test3.prf reflect latest state of marcellandau.  Was it
the upgrade in de() that caused the line numbers to shift?

marcellandau now appears to run perfectly well with line sorting on.
I think it was the bug that was causing the problem!

I would like to perfect forms of reference that would reduce problems
with legacy proofs...

Outline of the technique for doing automatic matching.  In alphaprop,
cause Ui to be regarded as actually equal to anything satisfying the
variable index limits, and record things to which the Ui's are
supposed to be equal (using alphaprop to determine whether multiple
things matching the same Ui are "the same").  When the client command
succeeds, fire all the substitutions off (doing the highest index ones
first, so that lower index variables in higher index substitution
terms get replaced).

*)

(*
Nov. 28:

we need ThmCut2 which serves up proofs of hypotheses before proof of
conclusion.

a reason to implement scripting:  get the demo feature that Watson has;
useful for presentations.  Could I get the reportcommand function to do
the same thing from a use file?  set the reportcommand to log to the console
and pause.  Except it would be better if commands were reported before
being executed; so we could get a demo mode without scripting...

*)

(* Nov. 26:

a silly bug allowed AutoPrune to "prove" theorems which were not
proved; fixed this by applying autorotate after bubbles.

Fixing this bug seems to have made it unnecessary to run nobubbles
before running marcellandau.

*)

(* Nov. 24: 

made the DefEquals (de()) command a little more effective: it applies
definitions on both sides of an equation if appropriate.  The other special
equality rules should be checked to see if they need similar fixes.

there is some quick and dirty declaration checking in the precedence
setting commands now.

I should install numerical constants shortly.

Would it be useful to rewrite propositions with biconditionals and
have "unknown" propositions as well as "free" propositions?

user commands to display precedences (and maybe arities?) useful.

I did impose the additional restriction that special character identifiers
must be infixes (must be operations of arity 2).  But the notation
+(x1,x2) is supported (and must be used when + is defined or declared). 
The arity restriction and the expectation that infix notation will actually
be used instead of prefix notation reduces the load on the parser.

slight refinement of automatic pruning for equations.

Installed special character strings as identifiers.  Some strings
conflict with keywords and cannot be declared: see the keyword
function.  Attempts to define these should crash with parse errors?
More guarding is needed, of course.  The old notation is still
supported, but do note that declaring operators called "*" or "#" will
massively break the parsing of the old notation.  of course, one wants
to declare at least "*" so its time to abandon it except as the
internal notation output by the preparser (use capitalized identifiers
(and the new special identifiers) only).  One probably cannot declare
identifiers which start with keywords, either...so more careful
checking is actually needed.  Interactions between the keywords and
declared special identifiers can probably cause really horrible parser
crashes still!

arity checking is installed:  if a declared or defined operator is used
with the wrong number of arguments, a parse error will be reported.  It might
further be a good idea to force special character identifiers to be arity 2
in all cases, but I have not done this so far.  Undeclared operators are
not arity checked.

projected today:  arity checking, declaration checking in precedence setting
commands, special character identifiers; maybe numerals?

consider set format {f(x1) | P}:  I do have an idea about the rules for this,
and it will make life easier... [one thing it does is create an only slightly
long winded notation {<x1,...x1...>|x1 E A} for a function with domain A.]
x1 E {T | P} is proved by showing x1 = T' and P' where all free variables
in T are replaced by unknowns in T and P to get T' and P'.  Using the hyp
x1 E {T | P} uses T' and P' with new free variables.  Note that updating
binding variables in this notation would also be technically tricky.

Unification as a way to set values of unknown variables is a further
natural automation.

*)

(* Nov. 23:

Still needed: declaration checking in precedence commands.  Arity
checking for declared predicates and functions.  Testing of infix
parser.  Are the brackets a permanent feature?  Special operator string
identifiers, so we can have a+b instead of a Plus b.

The complete infix parser and display is installed -- in intention.
An important feature is that for the moment brackets [] must be used
to group infix operations; parentheses are used only for grouping
propositions.  A string beginning with a parenthesis is a proposition,
not a term.

The new system reads the old syntax perfectly, apparently.  It displays
terms with binary operations differently, though.  The default precedence
has all operators with the same precedence and grouping to the right.
An option to suppress infix display might be useful?

Special character identifiers are not yet supported.  They present
difficulties because of possible conflicts with primitive operators
of the logic (look at the trouble E already caused!)

This version has infix operator precedence setting commands for users
and infix display.  It remains to retool the parser to handle infix
notation.

we need arity checking for defined predicates and operations.  This is
easy; just do it.

remember to install logging for user commands for setting precedence!
Though logging is not really needed until the parser handles infix notation.

user precedence for binary functions as infixes is set up along with
infix display using precedence.  This now appears to work.

now to tackle infix notation.

the idea is to have the same kind of precedence as Watson, with the same
user-friendly precedence setting commands.

Do precedence before trying to set up special character identifiers.

First do the precedence list and user commands to set precedence.

*)

(* Nov. 22:

Note that the ThmCut command gives an answer to a question Joanna Guild asked:
it is better for free variables in theorems to be ai's because the ThmCut
command will replace these with unknowns but leave free xi's as they are.

note that the command classical() mentioned in these notes and recorded
in the documentation has actually been suppressed:  it is not defined.

work order from me to me:  work out a way to automatically eliminate
intermediate formulas in chains of instantiations of universal premises?

work order from me to me:  work out a way to present formulas in theorems
in desired order?  The navigation facility that Bailey asked for might include
some stuff along these lines:  reorder formulas in any sequent in current
proof?

The StartSequent command is installed.  Abbreviation is ss.  This is so
new that it does not appear in the updated documentation.  It takes two
lists of strings to be parsed as propositions as arguments and sets up
the sequent with the first list as left side and the second list as right side
to be proved.

set NameSequent to automatically prune.  Good luck! This will not
happen if nobubbles() is run.  One effect of this is that it is
impossible to record a sequent as a theorem which has redundant
premises or conclusions.  Such sequents can be proved but they cannot
be recorded as theorems.

did some fine-tuning of autoprune function.  It should now handle re()
correctly; I don't think it did until now.  Also, it would have done
truly weird things with bad proof trees; it now treats bad "axioms"
at top of tree like goals, as it probably should (not that such things
should ever appear!)

QUERY:  should NameSequent automatically invoke autoprune?

found the mystery match error.  Iff was missing from freevarfoundp.

The documentation (marceldocs.pdf) is updated with references to all
commands at this point (except StartSequent just introduced).

Certain commands which determine prover behavior and which should not be
reset during proofs should be put in a "preamble" in any log file.

I should follow my own lead in Watson and set up log files so that I can
do "theory management".

The "theorem cut" idea is a major move I think, not just for equational
reasoning.

The numerical mask in the rewrite commands appears to work now.  I still
might want global rewrite of one side of an equation as a command?

I note that the line sorting (bubble) does not seem to work correctly
when there are more lines per node (as ThmCut permits).  Check this out
and debug it. NO PROBLEM

Pruning does not seem to work quite correctly with rewrite intensive
proofs; check this.  No, it does.  It just is not automatically
invoked when I think it is.  

NO, bubble sorting is working correctly: the problem is that I think
autoprune is being invoked automatically when in fact it must be
invoked manually.  Think about whether it should be automatic -- perhaps
it should be invoked whenever NameSequent is run.

note that an axiom seems to have been imported inside a proof: this
should not happen; modify the security stuff appropriately.

*)

(* Nov. 21:


ThmCut appears to work.

I do not understand why adding "other cases" to subsfree/subsfreep
and freevarfoundp/t removed an ML match error in SetUnknown.  
Something is weird; I dont
see what other cases there are. FOUND/FIXED

The numerical mask in rwr and rwl, etc. does not work and should
be fixed.  Alternatively, one could introduce ability to completely
rewrite the right or left side of an equation (and presumably give 
up on the mask).DONE -- FIXED I THINK

we attempt installation of ThmCut, a command which facilitates introduction
of instances of theorems.  In a certain sense, ThmCut (if it works) allows
new rules to be introduced.

The ThmCut command appears to work.  This presents major pedagogical issues
because I need to explain unknown variables.  Of course, I also haven't
seen how this interacts with set definitions, and so forth.  Bugs in
SetUnknown will doubtless appear (the mystery match error for example).

*)

(* Nov. 17 work orders:

Bailey suggests some kind of display of the proof tree.  This seems horrible,
but I should think about it.  How about this:  display a node, above it its
parent and below it its children, and provide movement commands -- go up
or go to child n -- so that you can navigate around the proof and get a
feel for its structure perhaps better than from showall.

Fix things so that I can put formulas in theorems in the order I want!
Perhaps I should be able to directly edit the theorem.

The automatic implementation of theorem instances can be done as
follows: suppose the theorem has just one formula on the right.  Then
introducing an instance of that formula on the left is reducible to
the original by cut.  A general "theorem cut" creates a new goal for
each sequent in the theorem: prove that each hypothesis holds, and
then show that the conclusion follows from each conclusion of the
theorem.  Then the assignments of particular terms can be handled with
SetUnknown (which has a proper global effect).  So applying a theorem
with n formulas has the effect of producing n new goals (also one proved
theorem).

The Rewriteleft (rwl) and Convrewriteleft (crwl) rules now work differently.
oldrwl and oldcrwl have the old behavior (a global rewrite of files with
the old commands will keep them working).  The new versions use the equation
in position 1 on the left side to rewrite the formula in position 2.

I also noticed that the new equality commands would raise ML
errors if they were applied in inappropriate contexts, and fixed this.
I hope that this isn't true of any of the other commands...

I modified guildproject.txt with oldrwl and oldcrwl; that update should
be posted at the same time as this version.

change the order of arguments in the left rewrite rules.

Unfortunately, this will break legacy proofs...

keep old version as oldrwl oldcrwl, and do global rewrites on old files.

Automate the process of introducing instances of theorems.  If all
hypotheses (left formulas) of a theorem can be matched (so the first
argument will look like the first argument of UseThm) introduce a
specified right hypothesis (with subs dictated by the match; the right
argument) on the left and all other right hypotheses (with subs) on
the right.  Subs not dictated by the match can be changed into unknown
variables and then set by the user!  This should be very powerful.  I think
all right hypotheses other than the specified one also need to be matched!
So there are three arguments:  a list of the left hyps to match the theorem,
a list of right hyps to match the theorem and a specified right hyp which
does not need to be matched?DONE -- new command ThmCut

Put the documentation in Bailey's space.DONE

*)

(* Nov. 14:

Recall that it would be a good idea to have the ability to sort the
tree by line number (at each node).  Displayed proofs tend to be
_backwards_ which is rather distracting. This is now attempted:  see
functions called "bubble" DONE

Some legacy proofs (such as marcellandau.txt) will not work with 
the automatic reordering of line numbers.  For these, run nobubbles()
first.  The problem is that if autoprune is run in the middle of the proof
to extract a result, the order of goals is changed, so things are now
served up in a different order.

returning to full speed after illness.

Fixed security error on axioms (I hope); they couldn't be used
because they didn't report saved definition data?

Also increased security of axioms by requiring that all concepts
used in axioms be declared or defined.

Should implement StartSequent but it is harder than I thought!DONE Nov 22

New commands GetLeft2 (gl2) and GetRight2 (gr2) are needed to bring
equations (other than the one in first position) into _second_
position in left or right list so that rewriteleft rules can actually
be used!  This means that at least in a technical sense any order on
premises or conclusions can be achieved by combining gr and gr2 or gl
and gl2.  These are now implemented.

New version of Cut Rule (Cut2, abbreviated cc) presents the proof
of the cut formula as a conclusion before its use as a lemma.  It may
actually be the preferable form of the two.  Abbreviations for the cut
rules are probably deprecated because they are "major moves".

For other implementation agenda, see file guildproject.txt

*)

(* Nov. 1:

For Bailey, introduce a StartSequent command; this is easy, just haven't
gotten around it it... [Reminder:  see if you can fix NextGoal
to behave rationally]:  StartSequent is DONE

still can't define binary predicates with infix format on left:
though you can define Neq(x1,x2) as ~x1=x2 and it will display
this as x1 Neq x2 for ever after, you can't do it in the definition...
There is a good reason why this is difficult, and a fix really isn't needed.

set up analysis axiom file analysis.txt (logged in analysis1.mlg)
with Joanna Guild in mind.  Discovered various bugs in autologging which
are fixed...NOW USING guildproject.txt

*)

(* Oct. 31:

By dint of reordering functions, got the prover to report errors inside pleftrule
and prightrule to log files, which they were not doing originally.  The
difficulty is the difference between the two Say functions.

one more modification:  suppressed automatic Look executed by
the error message processor, which can have weird results.  I may
end up wanting it back.

wish list:

still of course infix functions.

automatic elimination of intermediate instantiations of universal
hypotheses or existential conclusions.

Commands that "move and fire":  Gl n for gl n; l();  Gr n similarly;
Triv m n for gl m; gr n; Done(); DONE

(*  new shortcuts installed *)

fun Gl n = (gl n;l());

fun Gr n = (gr n; r());

fun Triv m n = (gl m;gr n;Done());

notice that these will not appear in logs; the log will show
the subcommands.

Stratification of definitions is kludgy.  Fix it (also see if I can
fix the updating of bound variables in definitions; other functions
seem to keep them manageable).FIXED

My attempt here is to make the definition functions simply ignore the 
type list argument except in the case of primitive concepts.

OK, the problem with stratified definitions is solved.  Note that the
type list argument is now redundant in the definition operations, except
in the case of primitive predicates and functions, in which case it is
needed to supply intended types.  This suggests that there ought to be
two different commands (a definition and a primitive declaration command)
for each type.

*)

(* Oct. 30:

arrange for comments to persist.

The logcomment command remains the same; the new hardcomment command
puts a hardcomment command in instead of an ML comment (so the same
comment will appear if the log script is run and that is logged:  comments
made with logcomment do not persist in this way since they become ML comments
in the log file).

Sequents posted as theorems are now displayed in the log just before
the NameSequent command.

Many more error messages (but still not all) are now reported to the screen
and the log.

*)

(* Oct. 27:  fixed error in line number error reporting --
repoted line too small by one *)

(* Oct. 26:  made the error message from SetUnknown more informative.

with the first release of "unknown variables"  it would be very easy
to prove

(Ex1.(Ax2.x1=x2))

which is not the sort of thing one wants to be able to prove...

Explicitly maintaining a list of dependencies of ai's and other Ui's on Uj's
could make this restriction less onerous (there are cases where it is
not actually a problem) and also facilitate further upgrades.

*)

(* Oct. 25:  

summary of Oct. 25 modifications:

   DefSent now works on capitalized identifiers.  This was an oversight;
   DefProp and DefTerm already did.

   The unknown variables update as originally implemented was unsound:
   the term replacing a Ui when SetUnknown is run cannot contain any
   aj or Uj with j>=i (because this term has to have made sense when the Ui
   was introduced)

   A command NextGoal() (ng()) provides a better (but still somewhat weird)
   way to page through all goals in current proof.  This will eventually
   cover the whole proof, but some goals may be repeated during the
   traversal.

   There are some improvements in error reporting.  A minor bug
   in the packaged proof proof2() was detected and fixed (a string
   was not entirely consumed by the parser due to an extra closing 
   parenthesis).

attempting installation of a NextGoal command which will serve up the next
goal without proving the current one.  I'm pretty sure that this now
works:  execution of NextGoal() (ng()) will move you to the "next"
goal in a rather eccentric order (move the current goal to last position
in all branches it lives in, then display the first term of the next
top-level branch; this will traverse the whole proof eventually, though
some goals will repeat before the whole proof is traversed; just returning
to the current top level goal is not sufficient evidence of full traversal).
It's better than the old Rotate but still confusing.

A different technique would be traversal by line number...

repaired an omission:  DefSent will now work with capitalized sentence names.

The unknown variables update as currently presented is unsound!  A
quick fix would be to not allow any substitution of an expression with
a free variable with index of higher absolute value than i for Ui; a
more sophisticated fix would involve recording which ai's actually
depend on the Ui's.  We install the quick fix for now.  FIX INSTALLED

The point is that Ui can really only be replaced with objects that were
already defined when it was introduced:  this precludes replacing it with
any term containing a free or unknown variable with higher index.  This means
from the standpoint of proof strategy that you should be sure to introduce
all the ai's you can before introducing a Ui.

it is perhaps worth noting that rewritefree will work on unknowns as well
as free variables.

We need a command which will serve up the next goal.  The nonlocal
nature of SetUnknown means that it would better to be able to page through
current goals. 

*)

(* Oct. 22:

The "unknown variables" upgrade is installed, in its simplest version --
I think.  There is no real effect unless the unknowns(); command is run,
which enables it.

If unknowns(); is run the effect is that there is a left rule for the
universal quantifier and a right rule for the existential: witnesses
Ui (with a "new" index i) to the quantified sentences are introduced.
The added power of the Ui's is that one can globally (throughout the
proof!) at any later time replace Ui with the term t with the command

SetUnknown i t;

(su works in place of SetUnknown)

The advantage is that one can run through the obstruction of universal
hypotheses or existential conclusions and get hints as to what the
witnesses to be manually introduced must be, while retaining the
ability to add the witnesses later.  The disadvantage is that the
effects of SetUnknown are global (they run throughout the proof!)  so
one may need to use showall() to look at all goals before attempting a
SetUnknown command.

There may of course be new bugs!

A fact about the implementation which should be taken into account
when thinking about bugs is that there is no addition to the underlying
data type:  the variable Ui is implemented as FreeVar ~i (and the error
term was changed from Freevar ~1 to FreeVar 0).

Since it involves rewrites to every sequent at all levels of the entire
proof, all bound variables get renamed -- even in the theorem as you
originally typed it in! (this has been fixed).

plan installation of the "unknown variables" upgrade.

1.  Parser displaying and parsing Ui - FreeVar ~i should be easy
2.  Modify free variable upgrade -- use absolute value
3.  Define new left and right options for existential conclusion,
universal hypotheses, probably guarded by a new toggle (to avoid confusion)
This could be omitted for now.
4.  Write the global substitution command.

Eventually, think about version in which existential conc and univ hyp
can be discarded after rule is applied, but this is quite complicated.


*)

(* Oct. 20:

Theory version enhancements:  there is a function extensional() which
assumes full extensionality (NF) and a function nopairs() which eliminates
the pair.  Running constructive(), extensional() and nopairs() puts
you in constructive NF.  I removed classical() on the theory that
relaxation of restrictions is more perilous from the security standpoint
than tightening them.

comments now also induce a snapshot of the current sequent in the log file.

the constructive logic toggle is now installed.  I need to check that no
special rule actually generates alternatives on the right, but I believe
that the only rules that do this are right or and right equality, which
are in prightrule.

The new rules keep copies of implications and negations on the left, and
whenever a rule is applied the right sequent is cut down to its first
element alone before the rule is applied.  It is the user's responsibility
to use gr to bring his favorite alternative to the front after applying
or (or equality) right rules, before the next rule is applied.

This is not a full user service yet, because no security is available to
ensure that classical and constructive proofs are segregated from one
another.  But one can restrict oneself to a constructive proof style to
see what it is like.

constructive() turns on the restrictions
and classical() turns them off.

Mr. Bailey, unless you are interested in intuitionistic logic, 
this note is not for you :-)

*)

(*

Oct. 19:

Proof logging is implemented!

To start a log in file FILENAME.mlg, issue the command
startlogging "FILENAME";
to stop logging issue the command
stoplogging();

The command 

logcomment "My remarks";

will post a comment to the file then insert a snapshot of the current sequent.

The file FILENAME.mlg will be a file of ML commands with useful comments.

You can run it by typing

use "FILENAME.mlg";

When error messages are issued and logging is on, a line number is reported.
Log files have line numbers inserted as comments.  So if you run a log
file and start logging just before you run it, the prover will tell you
where in the log file the errors are!

I built the log file for marcellandau.txt and ran it; it worked.  I need
to go look at the errors but haven't yet done so.

You can insert a comment in your log file by typing 

logcomment "COMMENT";

Features which should be added:  there should be commands to insert
the sequent display as a comment into the log file.  Theorems should
be displayed in comments in the log file after they are proved.

There are extensive musings all dated Oct. 19 which I broke up into
separate comments.  The practical effect is that infix predicates are
now in place and I have plans for several further upgrades.

*)

(* Oct 19:  extended musings about implementing alternative logics
and/or set theories.

STRATEGIC remark: As far as possible, alternative logics should be
handled by installing toggles in this version.  The point being that
all alternative versions simultaneously would be customers for certain
kinds of upgrades.  One upgrade which several of the alternative
versions could use is sorted variables (regular set/class theory could
use set variables, and the Kiselewicz theory needs a series of regular
variables), but the main version might have some use for this
machinery too (or could use a toggle to suppress it).

Note that constructive logic seems to reduce to only allowing zero
items or one item on the right; the rule change for or on the right is
clear; whereas if on the right escapes (and so is not equivalent to
the defined notion not P or Q).  The rule change for or on the right
(forcing the user to choose an alternative) seems to be the only change
needed!  This means that an INF version of the prover is extremely easy.

Summarize remarks about alternative versions:  a version for standard
theory of classes and sets involves (simplifying!) changes to rules.
Suppress stratification of course.
From a E t and P(a) deduce a E {x | P(x)}; t is a user supplied term.
From a E {x |P(x)} deduce P(a) as usual.  {x|P(x)} = {x|Q(x)}
reduces to P(a) == Q(a) (where a is new) [I should check that places where
I use bound variables as new objects don't allow conflicts; I think
they might, and this practice should just be suppressed!]  This will
be a very simple system with the ability to extend to standard set theory
by addition of axioms (but it is inherently second order; quantification
is automatically over classes).  A version for NF is quite straightforward
(NoClasses; simplication of rules for equality) and the further addition
of the modifications for constructive logic will give an INF prover.  Given
Thomas's difficulties, maybe an INF prover would be useful?

The NF and constructive upgrades are easy enough that they might be
worth installing as toggles on the main system?  What does anyone know
about the virtues or otherwise of constructive NFU?  Constructive NFU
with a pair?  How does this differ in strength from constructive type theory?

A piece of old business is a Kisielewicz version:  this is not difficult
in principle (it would involve extending the parser a bit and checking
for presence of one membership relation or the other; it would also
perhaps need a class of regular variables; the set and class version would
benefit from a class of set variables too).  But it involves some labor.

A version for positive set theory also seems easy.  {x|P(x)} should be
taken to refer to the closure; so positive formulas P(x) will be
treated in a privileged way, but all abstracts will be handled.  The
axiom of infinity can be introduced in the form ~Omega E Omega.
Sophistication would come in in making it clear when defined notions
could be used in (generalized) positive formulas.

Some theoretical reflection on constructive version of this logic
would be useful.  I think that the current version with the or rule on
the left forced to drop one alternative, and the cut rule forced to
use the cut formula alone on the right is precisely the correct logic,
but under certain circumstances formulas need to be kept for cut
elimination to be possible.  Is it sufficient to "keep" negative
formulas when they are moved from right to left?  The point being that
a procedure for getting a contradiction might need to be used more
than once in the proof.  In the classical calculus, there is no
difficulty.  This might be a question about reversibility; I justify
the places where I "keep" universal or existential formulas on grounds
of reversibility.  The same considerations suggest that implications
should be kept on the left; an implication might be used more than
once: the issue is that information passed over from the left to the
right (by implication and negation only) is sometimes discarded by the
proof-by-cases rules; since we can in this case keep it around, do so.
So this is a further modification for a constructive version:
implications and negations on left are preserved?  (look at what the
implication antecedent rule does in constructive logic - it may look
much more like MP).

So my conjecture is that the constructive upgrade requires that implication
and negation be preserved on the left, and replacement of the rule for or
on the right with rules requiring a choice of one alternative or the other.
This is a slight modification.

*)

(* Oct. 19:  remarks on intended upgrades

comments about auto-logging

I really only need to insert spaces after Done and UseThm(2) (things
that close branches of the proof).  The comment command, which inserts
a comment from the user, will also of course insert a return, so a responsible
user will create a sensibly chunked log file anyway.  To create
log files, I first need to identify all the user commands and set each
one up to report itself to the log file (or to standard output in debugging
mode).  Proved theorems can be displayed to the log file too, and there
should be a button the user can press which will insert the current
sequent display.  The idea of line numbers being incremented each
time a user command is executed, inserted whenever a carriage return
is placed in the log, reported in error messages is vital.

I need to go through this file and put Say instead of say (force
pauses) where appropriate.  This should be mostly error reports though.

"Unknown" variables:

The "unknown" upgrade is fresh in my mind and makes sense:  it should
remove certain roadblocks in proving theorems with universal hypotheses
or existential conclusions (because it allows the prover a chance to
show the user what witness is needed!)  At the same time, some technique
of flagging classes of rules would be handy; I'd like an option to
turn off the unknown commands.

Evil idea:  the underlying representation of Ui could be FreeVar(~i);
oddly this actually seems to be intellectually sound, and it minimizes
the need for new code (subsfree will do the work of substitution of terms
for unknowns).  But we will need a NEXTUNKNOWN counter; or could the
NEXTFREE be updated with absolute values?  Yes!

Further parser upgrades:

Decision: strings of special characters (including * and #) will be
identifiers.  Strip will check for * or # being followed by a declared
lowercase identifier, and in this case preempt.  This means that * and
# have to be used with care (identifiers that end in these characters
should be followed by spaces).  It also means that the old notation
(the underlying notation) cannot be used for "special" identifiers: **
will be read by the parser as **, not as * (the strip function will
prefix a * and not take into account the presence of a defined
function * ).  Note that these will be general purpose identifiers
which can appear in any context.  Something needs to be done to guard
the propositional connectives...  They can just be guarded as
individual items, just as E was guarded in the end.  One will need to
put spaces between & and following ~, for example.

what about identifiers for numbers?  Eventually we'll want
infinite-precision integer arithmetic...

The final parser upgrade:  infix function notation (binary operators)
with precedence.

*)

(* Oct. 19:  reports change to parser:  infix notation for defined
predicates is installed.

first aim is to implement infix identifiers.

This is done!

There remains the implementation of special character strings as
identifiers.  There is an obstruction:  * should probably change to @
or some such thing, since we presumably want * for multiplication.
The preprocessor could deal with this, though, if we decide that at
this point we no longer enter any defined function in undeclared format.

If special character strings are automatically scanned by strip and
prefixed with a special character ( * or #) and if getalpha and the
capitalization functions know what to do then there is very little to
do?  But note that legacy code requires that we leave the old
applications of * and # alone: these are easily recognized, as they
are immediately followed by letters (so * used as multiplication must
be followed by a space?)

*)

(*

Oct. 18:

Fancy identifier upgrade:  things formerly written "#test" or
"#test" can now be written Test (if they have been defined/declared
properly) and will be displayed in this way.  Definitions in the old
style will still work.  One exception is that "#e" will remain
"#e" and cannot be called "E" (and will not be displayed in this way).
There are no longer any restrictions on the forms of identifiers except
for the four forms E, Ex, Ea, Ep which can only be used in the old syntax.

Existing old files should work, though the display will look different
("A" instead of "#a").  Files without definitions will look the same.

This is the full "fancy identifier" upgrade.  Left sides of function
and predicate definitions can contain the identifier to be defined in
capitalized form.  The only identifier shapes that are blocked are the
four E, Ex, Ea, Ep, and these can be declared using the old syntax
(but will be displayed in the old syntax too).  Identifiers are protected
by spaces from absorbing following v,x,a,p, which was not the case
for earlier versions, so identifiers can now have names ending in 
v,x,a,p.  Witness macroing is present but perhaps has not been tested
as much.

The next intention is to allow defined binary predicates to be used
in infix form.  After this comes the somewhat harder task of allowing
defined binary functions to be used in infix form (and to allow strings
of special characters to be used in this way).

A parallel intention is to introduce unknowns Ui.  Another parallel intention
(complex) is to install auto-logging.

newest version allows any identifier except E, Ex, Ea, Ep (to
protect the membership operator).  User needs to put in spaces to
avoid problems with following v,x,a,p after identifiers.  Preparser
respects these spaces now.

Display of #e, #ex, #ea, #ep needs to be prevented from taking
forbidden forms.  So now declarations of these will still work but they
will not be "capitalized" by the preprocessor.

Some solution so that left sides of definition commands can be capitalized
is needed.  This has now been attempted.

*)

(*

Oct. 17: attempting to install updates which led to a crash in earlier versions...

reinstalled nice identifier notation.  Repaired potential parser bug.

This version allows the use of capitalized identifiers (drop * or #
and capitalize); the prover itself determines which sort of identifier it
is dealing with.  The old notation is still supported (though not displayed),
and for the moment still must be used on the left sides of definitions.

Some forms of identifiers which need to be blocked from declaration
are not formally blocked yet.  E should not be declared; neither
should anything ending in v, a, p, or x (A itself is not a problem).
Some of the latter are forbidden by the current definition.  I believe
all blocked expressions except E itself will be handled by the final
letter restriction, which can probably be implemented by modifying
getalpha0.  But that was about the time the previous version collapsed
into chaos so I'm not trying that yet.

Witness macros are supported: the command WitnessMacro n s gives the nonce
name s (which must be a capitalized identifier) to an.  The WitnessUnMacro
s command clears this macro.  The wums() command clears all these macros.
They are macros rather than definitions because this is entirely a parser
and display function:  what appears in proof structures is an all along.

*)

(*

Oct. 12:

I found and repaired a major error in the handling of the bound
variable counter.  The difficulty is that substitution of xn into an
environment requires that we set the bound variable counter at least
to n at the outset; otherwise bound variables will increment through
the value n and some bound variables will be replaced!

I have now installed error reporting.  When a file is run it stops and reports
errors when Done fails, UseThm or UseThm2 fails, or when NameSequent does
not succeed in proving a theorem.  This error reporting was EXTREMELY
HELPFUL in fixing marcellandau.txt and identifying the errors in it (and
seeing that prover debugging was needed).  

When NameSequent notices an error, it should restore the THEOREMS list
to its prior state?  This still leaves open the possibility of NameSequent
failing because a line does not exist?  This isn't likely to happen
but I should look at it.

Now I get all kinds of ugly error messages from marcellandau.txt but
I still haven't found the problem with the proof of NumbersNotEmpty.
I really hope it isnt another bug in pairing (or the same bug actually
unfixed).  But perhaps reporting will help. FIXED!

*)

(*

a "start sequent" command would also be useful (so premises 
can be supplied in a list)

make sure top line of left sequent has a return in front of it.

Is it possible to get the prover to drop unused universally quantified
sentences in pruning?  And could it automatically always drop intermediate
universally quantified sentences when chains of assignments are made?

Install automatic logging! (and pauses when Done or UseThm fails).

For educational applications, consult a math ed faculty member?  Note
that the system deals with many formal aspects of math in general.  It does
need support for more general math syntax.

marcellandau.txt needs to be fixed somewhere.  NumbersNotEmpty is now
the first proof that breaks.  Work on ways to make debugging scripts
easier.  When a theorem fails to be applied or Done fails it should
pause for input with a message.  The same thing should happen when it
fails to NameSequent successfully.  Something needs to be done to
rationalize the new index problem.

It is easy to modify this to get the theory of sets and classes:  modify
the rules for membership so that a E {x|P(x)} converts to P(a) & set(a);
keep the strong form of the equality rule for sets.   Then use axioms to get
ones favorite set theory.  This is doable during this M502 run:  they should
be able to prove theorems.

a better understanding of "witness variables":  write them Xi, and 
understand a proposition with Xi in it as an ensemble of all possible
propositions with different substitutions for that Xi.  Further,
adopt convention that constants ai of higher index than an Xj actually
depend on that Xj (and so should be diversified when Xj is set to a 
specific value).  When an Xj is specified it should perhaps be specified
everywhere it occurs?  This is not logically necessary but treatment of
variables that depend on it will be better.  The original terms with Xj
will normally stick around along with the specified terms.  (when renaming
variables, use a fixed offset for Xj and all higher numbered variables
everywhere that Xj occurs, so that aj's affected will be indexed in the same
way in different propositions).

Now unification makes perfect sense:  we are trying to find out whether
two sets of propositions have an intersection.

The idea with use of Xj is to facilitate delay of choice of a witness until
it is clear what witness is needed.

The bit masking in the new equality rules does not work correctly.

*)

(* Oct. 11:

This version fixes a truly sophomoric bug in matching.

*)

(*

new and horrible idea for use of variables which would allow r()
and l() to apply to propositions requiring witnesses.

Introduce witness variables w1, w2... which can be replaced with anything.
Further, in any given proposition in which w[i] appears, all a[j] for j>i 
actually depend on w[i].

w[i]'s may be replaced with any term (but before substitution all w[k]'s
and a[k]'s depending on wk's get new indices)

a command setwitness k would replace wk and reindex aj's for j>k to
new indices.

matching commands which try to fit w[i]'s would then be a natural idea.

Notice that witnesses not depending on w[i] but with higher indices
may be created elsewhere in the proof.  They can be introduced
into a proposition by substitution for some w[j] in that proof
(indicating that all w[i]'s and dependent a[i]'s in a proposition must
be reindexed above the free variable counter before substitution
happens).

the old witness commands should be preserved...

left rule and right rule should have toggles -- we already see that
being able to turn off expansion of definitions might be useful, and one
might want to avoid these witness variables.

*)

(* Oct. 4:

new command DefSent intended for use defining sentences.

updates suggested by student comments.

Proofs could easily (?) contain an indication of the exact formal rule applied.
Look into this.

Auto-logging was (is, of course) implemented in Watson and could probably 
be implemented here.  Each user command needs to be suitably "packaged"?

Should I use a list of numbers instead of a bit mask on the equality rule?
Might be a more humane approach...  But -1 does have such nice behavior!

I should arrange for prover to say something reassuring when it is finished.
DONE:  it says Q. E. D.

Prover must check that parsed strings are completed. DONE

Ability to define premises is needed (predicate functions without arguments).

Rewriting with universally quantified equations should be a target.

A major task:  write function which checks proof trees for validity.

Ability to have defined statements:  useful for axioms.DONE

Ability to have names in other formats!  perhaps use capitals:  when it
sees a capital letter it scans for whole word and types it correctly.
(Bogus is either #bogus or *bogus; so not both of those should exist?)
This would preserve compatibility and greatly improve readability...

ability to suffix numerals to names would also be handy.

found and fixed(?) bug in stratification of primitive terms

*)

(*

Sept. 29:  sitting down with the intention of enabling new equality rules.

I did so.  The prover now has rules for using equations on the left to
rewrite on either right or left and recognizes reflexivity of equality
as an axiom.  Of course this is all theoretically redundant but should
be helpful for teaching.  Should the left and right rule application
to equations be disabled?  Or should I just explain it?

The rewrite rules use bit masks to determine where to make substitutions and
where not to do so.

I have a definite sense of danger about variable counters in some places;
think about this carefully.  I am strongly tempted to rework much or all of
this from first principles if I have the energy, particularly to get more
general syntax.

I made a change in the top version of substerm and subsprop; this is in
principle very dangerous...checks should be run.

Introduction of a rule for Hilbert symbols would be just good clean fun,
and I have a general idea for management of Hilbert symbols to avoid blowup
(basically, every Hilbert symbol is associated with an automatic definition;
it only ever appears once unless one deliberately expands it).

*)

(* June 27, 2006:

I need to overhaul marcelsequent for use in Math 502.

Points to consider:

enhancing parsing to allow standard notation -- eliminate * and #,
support infix relations and operations.

preparing a version that supports the set constructions of Zermelo
set theory rather than NFU.

The Kisielewicz extension and the extension to support s.c. sets remain
of interest but not useful for this purpose.

Should I write a sane general parser and slot it in?  Can this be done?
if it could, we could get infixes and general binders at a stroke.

I should look for baroque and/or weird features of this system?
The numbered variables do probably need to be eliminated, since they
are never used and apparently don't quite work.

if i do a full parser update should i use bracket abstraction in
implementation?  Could bracket abstraction be used for stratification
checking?  Beware problems with propositions.  Issue of separate treatment
of propositions and terms and the effect on operator precedence.

*)

(* Oct. 21:

some meddling with user commands and mnemonics while writing
the command reference (marceldocs.tex).

*)

(*  Oct. 20:

This update has been carried out:
When one free variable is globally rewritten to another, the higher-indexed one
should always be rewritten to the lower-indexed one.  This will probably
break some existing proofs; if it is to be done, it should be done right
away!DONE

A possible extension of the theory:  reduce x E <y,z> to
(p1(x) E y and p2(x) = *empty) or (p2(x) E z and p1(x) = *empty)
Add related reductions of x E p1(z) and x E p2(z), and something
to ensure that the pair of sets is a set.  Reductions of equations
between pairs/projections and sets to handle this?  Reductions of
projections and pairs of sets?  This all works if the pair is
a Quine pair in the underlying model of set theory with automorphism
in NFU.  It is mostly of technical interest.

Note that I need to be careful in my premise that mathematical objects
are usually sets:  they might sometimes be pairs.  The idea above would
ensure that pairs of sets are sets.

*)

(* Oct. 19:

the prover currently automatically depairs; I changed it so that it
automatically applies deproj as well.  This shouldn't make any difference
in practice, since the prover always carries out these operations when
substituting as well.  The projection operators and the pair have
execution behavior...

Found a bug in matching of pairs:  the prover didn't know that it could
use surjectivity of pairing to match a pair to a non-pair.

I need to test the stratification algorithm to see if I can get it to
break;  I don't think that it is as good as I thought.  More sophisticated
backtracking might bring it up to speed.  It also may be fine as is,
but I need a principled justification of this.  Alternatively, I could
just bite the bullet and write a complete one?

The current algorithm will work correctly as long as each proposition
in which a variable x1 appears in {x1|phi} is connected.  This is nice,
but not as nice as "as long as phi is connected".

*)

(*

Oct. 18:

fixed problem which would have caused locked theorems to override older
lemmas of the same name.

Lock, NoLemmas and ShowLemmas commands added.

Lock <theorem> makes it so that the theorem <theorem> cannot be changed
and will not be copied into saved lemmas.  It is still displayed in the
verbose proof display mode.  The fact that a lemma is a locked theorem
will be evident from the fact that its "path" will not lead up to
the current theorem.

NoLemmas() turns off, and ShowLemmas() turns on the display of lemmas in
proofs.

I am still interested in reducing copying of sublemmas, but notice
that Lock can be used to avoid this where proofs are of significant size.

in marcellandau.txt, I am through with the monstrosity of Axiom 4,
and, because of the monstrosity, I am running into trouble with theorem
display and saving caused by the current very careful model.

I need to have a display mode which doesn't show lemmas and I probably
need the option of not saving truly gigantic proofs!DONE

two ideas:  provide the option of locking a theorem.  Locked theorems
cannot be changed and are not copied into saved lemma structures.DONE

Also, less critically, inside the lemma structure check for lemmas
which appear in more than one sublemma and bring them up a level.
This happens with FiniteCardinals, which appears twice in the proof
of AXIOM4.  But note that locking FiniteCardinals would have the same
effect.

The idea of extending RewriteFree to projections of free variables 
has suggested itself several times.  Note that this can actually be
achieved with the current RewriteFree with a cut...

*)

(*

Oct 14:  

The last stratification algorithm was wrong for a stupid reason
(which caused it to stratify the Russell class...) this is fixed...

Fixed yet another new bug caused by the changes which try to keep
the bound variable indices down:  classmatchprop and classmatchterm
were not raising the indices enough.  This is over-fixed: the usetermdef
and usepropdef functions also check.

fixed the problem with safeadd, safedelete and error messages
when theorems are added.  safedelete only complains about deleting
s if s is actually present (that was the source of the observed error)
and safeadd now really is safe (it won't add s if s is a current lemma
 or axiom; this was not actually prevented by the earlier code, though
the error message would be issued).

Should the no classes system prove that abstracts without extensions
are equal to the empty set?  The current approach is sound (it proves
nothing whatever about bad abstracts (except that they are urelements
if they are provably bad).

*)

(*

Oct 8:  I should add an option for suppressing display of proofs of
lemmas in showall.

Why does NameSequent issue the error message when NumbersNotEmpty is proved
(that it cannot change the current lemma NumbersNotEmpty)?
Does it do the same thing at FiniteCardinals?  Probably it does:
it has to do with the updating of the definition security list;
the safedelete embedded in safeadd cannot be carried out; I don't
think that anything is actually hurt by this, but it should be cleaned
up somehow.

*)

(* Oct. 7:

Parse error security installed in user commands.  Also, definitions
will not be applied in the presence of the wrong number of arguments.

Perhaps explicit types on bound variables should be removed.
This is a lot of work, but an unused feature is a potential hazard.

Well-formedness considerations:  there is no security against parse
failure in the system, nor against the use of defined operators
with the wrong number of arguments (which might cause an ML exception!)
Bogus length definitions are now not evaluated (originally the
argument list was curtailed or padded with variables, as I discovered
when I tried it!)

What about axiom security?  Does anything prevent one from using
a theorem when an axiom in its lemma base has been superseded?
Axiom security is now enforced by not allowing axioms to be changed.

It ought now to be possible to declare primitive notations by giving
a definition in the form of a reflexive equation:
*s(x1) = *s(x1) is the form of the definition of a primitive
successor operation, for example.  Primitive object and predicate
operators can be declared with user-defined stratification.  This
appears to work.

The definition security demands are dormant, since nothing actually
changes definitions at the moment, except the dramatic cleardefs()
which entirely clears them!  Any command which does change a definition
must clear the current theorem at least (saved proofs are actually
secure).

We should now have definition security (except for saved proofs on
the desktop).  Whenever a theorem (or subtheorem) is saved, the definitions
should be saved to a list by the name of the theorem.  When the theorem
is used, definition compatibility is checked; definitions may be recovered
if compatible with the current environment, but any conflict between names
of current definitions and those in the saved environment leads to
the execution of the theorem being blocked.

Saved proofs should also be definition-secure; in fact, they are too
definition-secure, simply restoring definitions exactly as they were
when the proof was saved.

Showall and saveproof now include term and proposition definitions in
their display.

stuff to do:

   prepare docs.

   install x:A with rules for stratification, formation of sets,
   definition in terms of s.c. sets.

   install definition security and primitive notions.  This should
   be the top priority, given recent work on lemma security.DONE
   mod undoubted bugs.  Hard to test.

   install aliasing; this might be a case of definition.  No,
   better if it is purely notational.

   install rewriting rules:  rules which allow rewriting with
   universally quantified equations or biconditionals are good, as are
   rules which allow rewriting with theorems?  How about the
   Watson recursion?  How about the full Watson model incorporated
   into this system?

   Notation extensions:  restricted sets and quantifiers?
   use all of =, E, : as restrictors?  Allow numeral suffixes
   on names; allow lower case initial names for defined predicates,
   upper-case initial names for defined objects.  Restricted
   quantifiers can be a completely notational feature (no special 
   representation
   inside the prover is needed).

   Commutative matching seems natural.  Perhaps also associative matching?
   But note that fancy (non-unique) matching is funny with rewriting.

   Perhaps the simplest way to handle definition security is to turn
definitions into a kind of theorem, then make arrangements to adapt
the existing lemma security to this purpose.  Also consider introducing
primitive notions.

Notice that changes in bound variable indexing have no effect
whatsoever on running proof scripts.  But any changes in free
variable indexing are a major headache.  Proposition:  integrity
of proof scripts (and intelligibility of proof scripts) is enhanced
if the user sets his own names for witnesses.  Introduce aliases
for witnesses?  Cheap trick:  introduce a command which defines
its argument (in the normal term def sense) as the most recently
introduced free variable (something determinable by consulting
the counter).

_Now_ the variable counters are tamed:  the final step was to
reset the counter to the highest bound variable locally in use
in sequent commands that introduce new quantifiers.  There is still
a possibility of bugs.  I fixed one possible bug by making sure that
the witness commands reset the global free variable counter appropriately
(since the substitution commands no longer do this globally).

The bound variable counter is not completely tamed (my first attempt
introduced bugs) but it does seem to be reduced...

The bound variable counter seems to be completely tamed by replacing
substerm and subsprop (outside the mutually recursive occurrences inside
each other) with versions which reset the bound variable counter to 0.
The counter iterations inside the two functions seem to handle everything
that needs to be taken into consideration without further ado?

I believe that the new stratification algorithm (mod bugs) should be
valid for any formula in which all set abstracts are "connected" (any
pair of variables are linked by a chain of atomic formulas):  this means
that disconnected formulas occur only at the top level and can be freely
rearranged into an order in which all stratification information can
be extracted.  (disconnection occurs in sets as well but connectedness
guarantees that rearrangement within the set definition is sufficient for
stratification).

What about adding the connective x:A (x E A and sc(A))?  In the context
"x:A and phi", x does not need a type:  {x:A | phi} exists no matter what
phi is.  sc(A) is a rather daunting assertion (it would be nice to have
a simpler axiom that implied that x:A -> sc(A)).  Introducing this
will make floating types more of a problem in some cases?

I'm thinking about taming the bound variable counter (try tying bound
variables to the term under consideration?)

*)

(* October 6:

I tackled the problem of incompleteness of the stratification algorithm.
The new algorithm can stratify a term or proposition correctly
if this can be achieved by reordering subformulas.  So the question is,
can we always achieve stratification by reordering subformulas and
proceeding greedily?  Probably not:  crucial type information can
no doubt be cleverly embedded in terms in such a way as to make life
impossible (I think I see how to do this).
But I think the new algorithm is smarter than the old one.  Also,
one can always embed hints (suitable tautologies) to get things
to type correctly.  In practice, the current algorithm should work
just fine; should I contemplate a complete one, though?

For bad things to happen in the stratification algorithm, one must
have disconnected terms in Marcel's sense, which seems not likely to
happen in practice.

I am contemplating writing documentation.

I have modified trytoprove (and thus Start) so that it does not clear
current secured lemmas and saved proofs (and retained trytoprove2 and
FreshStart which do.)  Am I right about this?  Why did I doubt lemma
security for saved proofs?  I do not see any obvious difficulty.

I have modified namesequent so that it modifies the current proof to
use the saved lemma to justify the specified sequent; this means that
we have a more compact saved proof: there is a genuine savings with
just two occurrences of the lemma.

I should modify stratification so that it will try reordering sentences
if necessary; likewise commutative matching seems to be worthwhile
(associative as well?).

More extensive introduction of rewriting?

Definition security (and saving of definitions with proofs).

*)

(* Sept. 15:

I think that showproof would have gone into an infinite loop if
it encountered an axiom.  This should be fixed.  the fix works...

I provide a command noclasses() to limit SetEquals to stratified sets.
I also added a warning about unstratified membership rule application
on the left to match the one on the right.  With noclasses(), the
system is now exactly NFU (with surjective pair).  I should use the
ability to reorder terms to make stratification more reliable.  Note
that even in NFU, SetEquals is not redundant, because only SetEquals
allows one to prove that two empty set abstracts are equal.  The
current version without classes does not allow one to prove anything
about unstratified abstracts whose expected extension is a proper
class except that they have no members (they are not necessarily equal
to the empty set):  this makes the theory strictly weaker than the
version with proper classes, but perhaps bad set abstracts should
be equal to the empty set?

getproof now should have the effect of opening the theorem proved
(which must be top level) so that all the top-level lemmas used in
that proof are at top level.  The only use for this command is
presumably to run NameSequent and extract lemmas; the opening
of the theorem is necessary for proof references to be handled
correctly.  All lemmas of the opened theorem are secure in the
resulting environment.  I have NOT tried out this command, just
written the function openprefix which should do the environment
opening.  (I have in fact never used this command; the new command
ShowProof lets me look at proofs of theorems).

The lemma security system seems to work exactly as desired.  When a
theorem T is proved, it copies all lemmas L to T.L.  This process is
recursive, except that lemmas T.L1...Ln.M1...Mm are not recorded if
T.M1...Mm exists (this reduces the redundancy of sublemmas); the
system knows to look at higher levels for missing lemmas.  There can
still be redundancy if lemmas share sublemmas which are not used at
the top level; live with it :-) Users cannot change any theorem with a
period in its identifying string.  This means that lemma names can
freely be reused without fear of corrupting old proofs.  Whenever a
new theorem T is added, the old T and all old T.L are erased.

Theorem printouts now include a printout of every lemma used at the first
place where it appears.  Warnings are issued whenever it is necessary to
look up a level for a lemma; this is not a signal of anything wrong.
The message "Proof reference error!" indicates that an expected lemma
is missing!

For further security, names bound during the current proof should not
be able to have their bindings changed at all.  This is now installed:
it is impossible to make any changes in a lemma which has already been
proved.  namesequent, usethm and usethm2 make a name secure until the
next trytoprove command.  Lemma security requires that saved proofs be
cleared when trytoprove is executed; there isn't any way to get lemma
security for saved proofs that I can see.  So saved proofs should be
strictly backup attempts for the current proof.  Later remark: this
does not seem necessary (or even advisable).  There should be an
environment clearing command, but there seems to be no reason why
trytoprove should invoke it.  This also implies that loading proofs of
theorems should require that the environment be reset so that lemmas
can be guaranteed to have the correct reference?

Ideas:  I could introduce x:A (x is an element of A and A is strongly
cantorian) as a predicate (this is a fairly cheap parser modification)
and extend stratification to handle x:A&phi nicely.  The more complicated
issues of introducing terms or formulas on the left of the bar in
set builders could be left for another day.

I could introduce "wild cards" which could be used as witnesses -- and
which, when instantiated, would be instantiated globally throughout the
proof.  I'm somewhat doubtful about the nonlocal aspects of this.

Automation of simple reasoning is needed.

Security for definitions hasn't been touched; cleanup of redundant lemmas
needs to be perfected.  Recorded proofs are definitely imperfect without
definitions being printed.

Note that rewriting the first instance of a term using an equation
is in principle a complete rewriting tool, as long as converse rewriting
is also supported.  In practice, allow targeting the nth term and
also every term.  Rewriting with universal equations (or biconditionals)
is another issue.  In all rewriting, take care with genealogy.

*)

(* Sept. 14:

I made it so that the saved proofs contain values of the counters.

Other mods:  the old counters are put onto a stack when they
need to be saved and updated, because depair is nested badly
in substerm.  There shouldn't be a problem.  Do saved proofs need
to remember counter values?  Probably.

The system is secure because any proof of a theorem refers to its
internal copies of any lemma rather than to any renamed version of
that lemma which may be floating around.  Users have no access to
the names with periods in them...  The data structure may not be the
best!  Definition security (and display in saved theorems) has
not been addressed; this is actually more important than lemma
security in this environment.  Theorems should have definition
signatures, and are simply incompatible with theorems with
differing signatures.  During proofs, record what definitions
are actually used and put them in the definition signature:
print out all the definitions in the definition signature in the
displayed proof.

New version still appears to be mildly buggy:  it does not
avert all redundant copies of lemmas.  But it does seem to work
in general.  Contemplation of the addprefix algorithm may lead
to enlightenment about this:  it is supposed to not add something
of which a tail is present, and to remove anything of which it is
a tail once it is added.  But it doesn't quite work out.

New version is better:  the system now avoids adding A.B.C
when A.C is present (and makes deliberate use of the "look
for lemma at higher level" warning).  This eliminates some
but not all duplication: have the addition of A.C also eliminate
all entries A.B.C with the same value.

The structured theorem security system now exists but has
problems.  I would like to eliminate unnecessary duplicate 
copies of theorems (the system knows where to find the theorems
if duplicates are not stored):  any theorem A.B.C should
be replaced by A.C where A is a single prefix and B and C are
any strings of prefixes.  Addprefix might be fixed to avoid this?

This now should have a secure theorem naming procedure
(although theorems can freely be renamed!), because lemmas
are renamed with the parent theorem name as a prefix
(recursively).  The theorem display procedure shows 
proofs of all lemmas.

is it necessary to save and restore counters when saving and
loading incomplete proofs?

Commands that save and restore counters now actually use a stack:
the original idea does not work, because depair can be embedded in
substerm which in turn can be called by alphaprop.

used equality instead of alpha term in genealogy testing for
rewritefree; repaired.

I've now handled the most obvious kind of rewriting.  Rewriting one
term or proposition with an equation or biconditional seems to
be next step; rewriting with universally quantified propositions
or with theorems is yet another issue.  Rewriting directives
would be yet another amusement.

Security of proofs should be a high priority -- in fact, maybe now
is the time.PROGRESS...

Automatic proof should get some attention.  Write versions of
pright and pleft which ignore definitions.  Write procedures
which automatically apply left and right (delaying branching).

Structural decisions need to made about theorem and definition
security.  The tack I take here is that a saved theorem is completely
self-contained:  all definitions and lemmas that it uses are 
saved with it.  (should I do this by elaborating the current
theorem list or by creating parallel lists?  The latter is of
course easier).  This means that a theorem being proved needs to keep
track of what definitions and theorems are used.  Is it sufficient
to keep lists of strings during the proof development?  This requires
that no changes can be made to theorem lists during a proof --
or at least that these lists can be checked.  

My notion is that addtheorem should only work if it makes no change
or if there is no theorem with the indicated name.  Deletion of theorems
from the list is permitted, guarded from the needs of the current
proof (the exception of adding theorems whose form does not change
makes it easier to run scripts).

Another idea: when a theorem is proved, it creates its own theorem and
definition lists which are loaded whenever it is accessed.  The list
of local theorem and definition lists will have a slot (indexed by the
null list) where the current list is saved.  This process should not
be recursive; lemmas used in the proof of a theorem need to be OK with
the same theorem and definition list (their list gets loaded if they
are "opened", and they cannot be opened if there is any conflict; all
their stuff gets loaded into the stuff for the theorem being proved).

This still causes global reservation of names.  Perhaps a theorem
can be used without opening all its lemmas (definitions still need
to be checked).  Then lemmas could be deleted from the master theorem
list without problems:  maybe lemmas are renamed with the theorem
name as a prefix when the theorem is saved!  This leaves
open the possibility of keeping everything on the master theorem
list!  (use the format theorem1.theorem2 and don't allow theorem
names with . in them).  Invariant:  as long as theoremname is on
the list, all theoremname.xxx must stay on the list.  Deleting a
theorem also deletes all theorems with that theorem name as a prefix --
but does not delete saved copies which are clients of other theorems.
So, when a theorem is saved, copies of the lemmas it uses are stored
with its name as prefix.  When a theorem is deleted, all theorems
with that prefix are also deleted.  When a theorem is used, only
its definitions need to be checked for compatibility.  When a theorem
is "opened" (when its proof is to be reviewed) all its clients are
opened (replacing any later versions):  all theorems with that
prefix are copied onto their name without the prefix (first of course
one must delete existing theorems with that prefix).

A scripting language and automatic scripting would be helpful.

*) 

(* Sept. 13:

Repaired (?) bug in matching which doesn't allow
a1 to match <p1(x),y> (because first p1(a1) matches p1(x)
so a1 matches x -- and it cannot match both x and <p1(x),y>).
I did this by introducing an internal difference between the
p1(x), p2(x) which match the components of a pair with which
x is matched and the real p1(x) found in a term.  The latter
but not the former will cause x to match a when p1(x) matches
p1(a).

Introduced rule for eliminating free variables by rewriting if
they are equated to something on the left.  Extended PairEquals
and ProjEquals to act appropriately on the left.  Corrected
genealogy where rewrite rules are involved; any rule where
proposition interact is problematic; check that autoprune does
the right thing.  Check that the new ProjEquals does the right thing.
Old files should not be affected by the extension of PairEquals
and ProjEquals, because these functions still do the same thing
whenever they would have applied under the old definitions (the old
behaviors are preferred).  Note that rewritten statements get the
rewriting equation added to their genealogies...

Definitely add rules for handling equations involving pairs on the
left.  Definitely add elimination of free variables in equations
on the left by universal rewriting.

I wonder if printed proofs would be human-readable if one followed some
fairly simple guidelines:  have a setting which only shows certain kinds
of steps, as, for example, branches, cuts, and witness steps?

Ideally, a checker which could read machine output would be reassuring.
Locally, I find no problems with the autopruning though:  the machine
proofs are locally quite convincing -- but indigestible!

*)

(* Sept. 12:

New user command Witness2 is almost as Witness but prefers to
instantiate on the right.

I repaired the bug in RightRules and LeftRules which caused a loop
when applied to a1=a1.  The problem had to do with genealogy updating
(and I should check that there are no other places where something
similar happens).

One should have the option of restraining RightRules and LeftRules
from unpacking definitions (restrict to logic).  One also might
want procedures which automatically work on things on both sides
(more tactics to come!); for example, rules which don't branch.

*)

(* note on Sept. 9:

Finished the marcellandau.txt proof that natural numbers are finite
cardinals.  I hope that this will make it easy to prove Axiom 4!

I'm going to try to put my wish list here.

Graceful way to quit from showall.

Some ability to search sequents for matches to given conclusions, at least.

Rewriting -- at least when we have a1 = something we should be able
to completely eliminate a1 everywhere.  More general rewriting with
= or == would also be useful (or universal ==, etc).

I need to test the idea of lemma mining:  look at the proof and
see if there are repeated proofs that jump out.  But do notice that
autopruning and search for matching sequents saved a lot of effort.
Tools to  make it easier to build matches would be nice.

The definition facility needs to send messages in all cases.
The system needs to issue a warning when bad expressions are embedded
as witnesses (preferably not do it!)

Commutative matching would make things easier.

The system should warn of unstratified sets too.  I should consider
making the logic have NFU and NF variants without the classes.
A neater way to handle sethood assumptions?

How to add an extra assumption to a large proof without having to
reengineer the entire file?  Could this be done with a cut, then some
manipulation at the end?

*)

(* note on Sept 8:

security for theorem names is needed:  perhaps it is permissible to
add a theorem a second time, but only if it is unchanged (this is so
that scripts can be run without trouble).  But renaming theorems corrupts
proofs, until we have arrangements for definitions and lemmas to be saved
with proofs.

commutative matching for theorems is a practical necessity
(include equality, not just propositional operators).  A lot
of our operators are commutative, and why multiply theorems
(or cuts) unnecessarily?

AutoPrune has a use which I didn't remember when I wrote it
(though I think I had thought of something like this:  it allows
the extraction of lemmas on the fly!  (you don't have to go
back and set up a lemma as a separate theorem -- just prune your
proof and find the appropriate sequent, with irrelevancies taken out)

*)

(*  Sept. 6, 2005:

does the stratification algorithm commute with substitution?
Very likely not!  Watch for difficulties caused by substitution
of complex terms into sets known to be stratified which confuse
the stratification checker?  (always write sets in a way which
quickly reveals strat info).

Should I set up options for reasoning in NF?  The difficulty is
that the strong equality rule for classes allows one to show
that there are urelements.

The ability to declare primitives seems to be important
for standard mathematical practice.  In the Landau implementation,
I could use the suite of definitions to prove the axioms, but it
would seem more to the point to be able to declare one and Nat
as primitive ideas and introduce the axioms?

Installed <-:  this should be useful for stratification problems.
The idea is that one should be able to present text in whatever
order best shows the prover the stratification which is needed.
All logical connectives now have freedom of order (the other
binary connectives are all commutative); membership is not commutative,
and this may prove difficult sometimes, but the converse relation
to membership can be introduced by definition.

I'm working on recording proofs; I think that NameSequent needs
to work by line number, so that it can be run in a "batch file"
without having to choose the right sequent from each proof by hand.

Later comment: I guess this is not a bug: it is necessary to give
hints to the stratification algorithm because it works on the fly.
But it may yet be a bug...  <- would be handy in this example!

This is a reason to incorporate <- into the language, for easier
manipulation of order of terms.

I found a clear bug in stratification.  This definition

DefineTerm "*empty" "{x1 | ~x1=x1}" nil;

DefineTerm "*sing(x1)" "{x2|x2=x1}" [1,0];

DefineTerm "*zero" "*sing(*empty)" nil;

DefineTerm "*union(x1,x2)" "{x3|x3 E x1 v x3 E x2}" [0,0,0];

DefineTerm "*s(x1)" 
"{x2|(Ex3.(Ex4.x3Ex1& ~x4Ex3&x2=*union(x3,*sing(x4))))}" [0,0];

DefineTerm "*nat" "{x1|*zero E x2 & (Ax3.x3Ex2 -> *s(x3)Ex2)->x1Ex2)}" nil ;

gives a stratification failure at the last step, but the identical

DefineTerm "*empty" "{x1 | ~x1=x1}" nil;

DefineTerm "*sing(x1)" "{x2|x2=x1}" [1,0];

DefineTerm "*zero" "*sing(*empty)" nil;

DefineTerm "*union(x1,x2)" "{x3|x3 E x1 v x3 E x2}" [0,0,0];

DefineTerm "*s(x1)" 
"{x2|(Ex3.(Ex4.x3Ex1& ~x4Ex3&x2=*union(x3,*sing(x4))))}" [0,0];

DefineProp "#ind(x1)" "*zero E x1 & (Ax2.x2Ex1 -> *s(x2)Ex1)" [0];

DefineTerm "*nat" "{x1| #ind(x2) -> x1 E x2}" nil;

works just fine?!

This works, too:

DefineTerm "*nat" "{x1|(Ax2.x1Ex2->x1Ex2&*zero E x2 & (Ax3.x3Ex2 -> *s(x3)Ex2)->x1Ex2)}" nil ;

(* giving a hint... *)

*) *)  *)

(* August 24: 

Definitely the next thing to do is to bind definitions to proofs.
For printed proofs, this is easy:  develop the commands which
print all definitions and prepend their output to saved proofs.
For saved proofs, this isn't much harder:  make lists of definitions
and theorems used in the course of a proof, and save these with the
saved proof.  When a saved proof is retrieved (or used in a proof), do a merge
of these lists with the current lists -- not allowing use of the
saved proof in the current environment if there are conflicts.
Once this is done, it will be safe to have commands to remove
unwanted definitions and theorems; further, machinery for nonce
definitions and lemmas becomes possible?  [I think that saved theorems
are different:  we need them to document the saved proof, but we
are indifferent to name conflicts unless we actually call up
the theorem -- there's no problem if we apply the theorem]
Axioms need to be treated like definitions.

This now includes a complete much shorter proof (with a cut)
of Cantor's Theorem.

I added definition display commands.  There is a nonce cleardefs()
command with the Cantor proof.

There is a persistent annoyance that prover output contains
comment openers, which makes commenting of proofs difficult.

I added LeftRules() and RightRules() persistent commands (which
apply rules on the appropriate side as long as possible) but there
is a bug with this.

New thoughts:

   rewriting rules for equality are probably wanted.

   A rule introducing the choice function *choose({x1|P(x1)})
   would be of interest.  Can *choose work on unstratified
   abstracts without contradiction?

Added commands LeftRules and RightRules which perform left or right
rules respectively as long as possible...This introduces a whole new
topic which I may not be that interested in.  NOTE:  I found a
crash with RightRules:  there's something tricky going in which
I have to fix.  In the course of installing LeftRules and RightRules,
I _think_ I made it so that mistaken rule applications do not
create new sequents in proofs.  But this doesn't seem to work correctly
in the crashed situation (look at |- a1=a1 and apply RightRules()).
It has something to do with the weird extra membership rules?

added user commands for definition display, ShowTermDef and ShowPropDef.

observation:  a user definition-clearing command cannot be
allowed unless definitions are somehow attached to saved theorems
and will be resurrected when theorems are loaded;
note that there might be possible conflicts where a theorem could
not be loaded because its definitions conflict with the current
environment? 

It's actually quite clear and has already come to my attention that
definitions must be attached to saved proofs.

*)

(*  August 23, 2005:

Further modification:  the right rule for membership in set abstracts
now issues a warning when the set abstract is not stratified
(because the sequent you get is weird!).

aims:  install backup and prepare to make autoprune official.

Backup is installed (try the user command Undo()), 
and the autoprune2 function of the previous
version is now the user command AutoPrune().  There is no automatic
use of autopruning.  Add a Forward() command as well, so that
one can repent of Undo if one makes no changes...

Next:  for the Windows environment, it would be useful to be able
to limit the number of propositions which are displayed (and scroll
through the displayed propositions).

This is now fully installed:  one can scroll independently through the left
and right sides of a sequent, and set the number of propositions to be
displayed.  See the list of sequent display control commands under
user commands.

This is ready to be the official version.

Official version posted:  now some further thoughts.

In proof reporting, the system should probably also print out
definitions (this may be a recursive process, since definitions
can themselves contain defined terms).

I plan to develop a new proof of Cantor's theorem, making use of the
sequent-saving and theorem-storing aspects of the prover.  This will appear
at the end of this file among the examples...

One should consider control of definitions and theorems:  the possibility
of nonce definitions and lemmas which will not persist should be considered,
and there should be tests for overwriting of existing theorems (which
don't seem to be present in namesequent, for example).

Pending is the adaptation of marcelsequent to the universal parser,
which should allow introduction of infix term notation and make it
notationally easier to proceed to the introduction of s.c. sets
and the stronger set idiom that these make possible. (x : A for
"x is an element of A and A is strongly cantorian", and {x:A\phi}
as a new set-building form).  This will of course require an extension
of the stratification function.

*)


(* August 22, 2005:

inessential modifications (moving code around preparatory to the 
final update of marcelsequent)

It does not appear to be a good idea to automatically autoprune whenever
a command is carried out.  This makes packaged proofs at least very slow.

It would be a good idea to install the ability to undo.  I've encountered
this in practice; an unfortunate rule application can double your work
at a stroke...

*)

(* August 18, 2005:

This "autoprune" update appears to work.  It needs to be tested with
small examples to make sure that the autoprune feature really does what
it is supposed to; then we can consider using it all the time?

FURTHER:  there is now another autoprune algorithm.  I think I have the
genealogy handling down, but I'm not sure I have the pruning quite right.

Idea:  it may be desirable to extend the genealogy of universal or
existential statements when they are copied, so that they don't persist
past the point where they are needed.  This causes a dramatic apparent
improvement!

so "autopruneit()" is the function to use.

BUG REPORT:  there seems to be a bug in the printout function:
the last sequent isn't reported in the example I'm looking at.  Look
at this later.  No, this was just an output flushing issue.

Two agenda items:

implement autopruning

The plan is to attach to each proposition in a proof a list of serial
numbers which will give its genealogy:  at the end, throw out all 
propositions which are not in the genealogy of some matched proposition
(or some proposition in a goal sequent).  The proof by matching procedure
should automatically prune the sequent it proves.

This will be a major headache because it involves adding a major change in
the sequent type.  It should be worth it...

then

install the universal parser

I should be reviewing what new features are needed for the sabbatical
aims.  I might want students to test it?  Hudson?


*)

(* June 23:


changed the right rule for membership so that it asks for the
proof of existence of a set with an unstratified definition before
trying to prove that the proposed "element" of this set satisfies
the defining condition.  This averts panic.

Is there an autopruning algorithm which can work from a given proof
in the current format without adding annotations?  Work from the leaves
inward:  all one needs to keep at each stage is something which justifies
the things kept at the higher levels.   It would help if we kept for each
proposition a record of the propositions at the previous step which
justify it.

*)

(* Feb 25 comments:

autopruning is taking shape in my mind and is a good idea.  The
idea is to record genealogies for each sequent when it becomes stable;
keep genealogies for sentences in sequents and manipulate them in parallel
with the manipulations of the sequent until it is stable.  It would be
of great interest to see what autopruning does to the vast Cantor proof!

Better memory management is important; think about installing it.

Theorems ought to have their free variable indices increased past the end
of the current free variable list before being applied.  I should check
what the matching commands currently do to the free variable counter.

Second order logic installation is a good idea and I should pursue it.
It would immediately give a natural equality rule, for example.

The witness rule could take two parameters, the predicate name with argument
list and the form of the predicate witness, and use the matching function
to carry out the instantiation?  The parser will need to handle quantifiers
over predicate variables; this is not a major modification.  The data structure
becomes more complicated, though.

Should I enforce consistent arity for predicate variables?

Fancy indentation as well as auto line breaks would be nice but is not
terribly important at this stage.

How hard will it be to install all these updates in the ksequent version?

*)

(* Feb. 23 comments:

I do not think it is a bug; matching is working correctly.  It does
suggest that it would be useful to be able to rename variables in
theorems.  I should make my point clear by including a successful
proof of the result I have trouble with in the example.

Implementation of second-order logic would make the issue moot, since
there would then be a natural rule-based treatment of equality.

*)

(* Feb. 20 comments:

Something is wrong with UseThm, or more fundamentally with matching.
An example at the end indicates what doesn't work; there seem to be
unjustified name conflicts between variables appearing in theorems
and variables in target class matches.  I need to work on this.

I fixed the user cut function, which didn't work.

I installed support for defined constants (DefTerm with null list).
For example, 

DefineTerm "*empty" "{x1|~x1=x1}" nil

will define the empty set, which will be displayed as "*empty".

An eccentricity:  to avoid ambiguity, defined strings now may
not end in v or contain va or vx.  This avoids ambiguities about
where a defined string ends when followed by the disjunction symbol.

I think automatic pruning would be very useful.  This would seem
to require that records be kept of when a sequent is used.  Recording
the "genealogy" of a sequent might work?

Also, the memory use of the system is absurd at present; the use
of reference cells to handle copied sequents is important.

Experience with student users seems to suggest that the system is
working OK for them.

*)

(* Feb 19 (final):

The final version of Feb. 19 completes the installation of a number
of student-oriented improvements which we now summarize:

operator precedence is installed: users need not insert redundant
parentheses (but may) and the system always displays as few
parentheses as possible.

Pretty-printing:  the system now inserts reliable line breaks.
There shouldn't be any problems with output overrunning the margins
on the printer.

A and E are now the shapes of the quantifiers, though & and v are
still accepted as input forms of the quantifiers.

Relation notation is now supported: the system understands Pn(t,u) and
t Rn u to be synonymous, and always displays the latter.

All unproved nodes of a proof are shown by "showall", so it's
possible to look at the structure of the proof in a more helpful way.


*)

(* Feb. 19:  fixed a bug in precedence -- parentheses toward the right
were not handled correctly. 

The last version of Feb. 19 neither requires nor displays redundant
parentheses (but it deals correctly with extra parentheses supplied by
the user).

*)

(* Feb. 18:

Further updates which might be desirable:  is there a more
approachable way to handle equality rules?  Is there a nice
way to cut this down to a "mere" second-order logic prover?
(actually, there's nothing mere about it -- a new quantification
idiom is needed).

Idea of declarable names for automatically numbered variables:
these could be identified to parser by a leading symbol.  So we
could get very nice display along with not too bad input language
fairly cheaply.

setting up for major overhaul.  This is motivated by the needs of
Math 387 students, but some of these are useful in any case.

Order of operations is now fully installed.  Things of the same order
of precedence group to the right.

The display can be left as it is (and it is the same:  all parentheses
are displayed).

Use of "A" and "E" for quantifiers is probably better.  Maybe set it
up as an option; at least preserve the ability to read old code.

The current version reads "&" and "v" as alternative versions of "A"
and "E" (so it runs all old proofs) but it displays "A" and "E".

It is _somewhat_ pretty-printed (not beautifully, but it should avoid
overrunning lines)

All unproved nodes of a proof (not just the goals) are now shown by
showall();  This helps with extraction of counterexamples from proofs,
and also may make Rotate more useful.

I didn't add capital V for disjunction.

Relation notation is installed:  P1(x1,x2) is synonymous with x1 R1 x2,
and it is the latter form which is displayed.

Notation is now quite close to what we use in class.

*)

(* Feb. 10:

propositional connectives now flanked by spaces in the display.  This means
that there is more need for pretty-printing.

Short term desiderata:

The stutter in Start has been fixed.

Line numbers are debugged.  They start with 1 instead of 2, and they
are reset when Start is run.

Should capital V be accepted for disjunction?

Have the parser check for left over parts of term, so that it doesn't
return part of the input without reporting an error.

Introduce relation variables R1, R2, etc, for more flexible notation.
Query:  does x R1 y mean the same thing as P1(x,y)?  It could reasonably
be set up that way.

Set up order of operations and probably even pretty-printing to at
least a minimal extent; the additional spaces seem to require this!
Redundant parentheses should be allowed, too.

See if additional letters can be allowed as predicate, relation, variable
and constant symbols.  This might be done by a definition process without
enhancing the parser?

Equality rules without sets?

Long term:

Rebuild Watson on top of this platform: add the equational reasoning
capability of Watson, with access to hypotheses of sequents,
applicable in any sentence in a sequent.

Isolate second-order logic; make a version with just SOL?

Rules for restricted operations.  Think about the bounded set theory
with closure operation that I've been defining.  Also, the rule for
Hilbert symbol.

*)

(* Feb. 6:

changes recommending themselves after first lab.

Find and remove the "stutter" in Start (it repeats Look).  Done.

Is there a reason why Start doesn't reset line numbers?  
There might be a reason.

Add one-letter mnemonics for commands.

I added the one-letter mnemonics.  Look in the user command section.


*)

(* Feb. 5, 2004 notes (note this is just about a year later):

The command

saveproof "boojum";

saves the current proof to a file called boojum.prf

This is the first of several improvements I should make for students'
benefit. 

Other improvements needed:

It would be nice to be able to display all counterexamples to 
a propositional non-tautology; it is unclear whether I can display
more than one.

Order of operations would be very handy!  There are other ways the
display could be improved.

Another observation:  notice that sequent proofs are HUGE objects.
This can be ameliorated by clever use of pointers, so that stuff isn't
copied over and over again.  The printed proof of Cantor's theorem
is a horrifying case in point!


*)

(* Feb. 7 notes (no changes in code):

I want to leave this for the moment to get to other things --
successfully completing the Cantor proof (with associated bug fixes)
seems enough for now.

Remaining issues:  perhaps equality should be either recoverable from
its set theoretical definition or the witness rule should have a case
for equations.  The latter is probably the cleanest solution.  The
pruning rules seem very handy.  A rule for eliminating a list of items
should also be written -- (map doesn't quite work :-)

pruning is handy strategically -- it should be possible to 
produce sequents worth saving for reuse as theorems?  automatic
pruning is still an interesting idea, but implementation would be
complex. 

The typed bound variable constructions (sets and quantifiers) should
be installed.  Note that once the typed sets are installed (with NFU*
comprehension) it is possible to PROVE the strong equality rule (so
I will wait for this rather than install it directly).

I had much less trouble with defined terms in the last pass -- I don't
know if this is because of better proof strategy or because of the
extensions of definitional expansion that I put in.

A careful analysis of the current stratification algorithm to make
sure it is sound would be useful.  Class matching (which I have not
used in this proof, except implicitly in definitions) should also be
analyzed and tested.

Petty annoyances: I should probably fix the witness rules so that
accidental witnessing on the left when witnessing on the right is
intended will not be a problem.  There might be ways to keep bound
variable indices lower while still preserving the simplicity of
the definition of substitution (it might be possible to reset
the bound variable counter more often?)  It is still the case that
one might need to use type indices to convince the system that
a definition is stratified.  There ought to be a definition command
which aborts the definition if stratification fails -- we do want the
ability to define unstratified operators, though.

The new ability to save past proofs is nice -- an undo feature
(however limited) would be _extremely_ handy.  More error messages.

The ability to view unproved steps other than goals, and the ability to
convert such a step back to a goal, would be nice for construction of
pretty proofs.  This would be a kind of general undo feature, and is easily
implemented.

Proof scripts might be more easily modified if lines in sequents had
absolute addresses -- maybe.  The assignment of the absolute addresses
in the first place still might be a problem.  The current scheme may
still be the way to go.

The ability to define binders (in effect, operations taking classes to
terms and propositions) would be very handy.

How can this system be made smarter?

Can cut elimination be proved for this system?

The feature that user commands are all collected in one place in the
code (there are a few outliers which should be brought into the right
place) is nice: it should be improved by embedding instructions for
users.

Is there a paper in this project?  Is this grist for a grant proposal?

Relations to Watson:  there are two possible approaches.  Watson term
manipulations could be added as a feature of this system.  Alternatively,
it might be possible to develop automated translation between the two
systems, since they have the same underlying logic.

*)

(* Feb 6 version notes:

I set the Cantor proof back to the beginning -- I have now completed
it.  There are a lot of redundant commands in the proof, though!
Note that it is entirely cut-free...

Running command 

proofsofar(); 

runs the entire Cantor proof.  After
that one can read the proof by running 

showall(); 

and then hitting the enter key repeatedly.  (the first time or two that
you hit enter, it might not show anything -- just keep trying).

I added commands backupproof and restoreproof for backing up 
old versions of proofs.

I enabled the DefEquals command to work on the left as well as
the right.

I introduced commands PruneLeft and PruneRight for removing unnecessary
propositions from sequents.  The sheer number of items was beginning to
be a serious burden in the Cantor proof.  It would be nice if there
were a sound way to make it possible to retrieve pruned items if it
turned out that they were needed after all.  Enabling the system to
hide some from view might work.

I'm still thinking that equalities ought not to be expanded
to quantifications, or at least the equality itself ought to be
left visible.  Once an equation has been used, if one wants to
use it again one needs to look for its Leibniz form, which is 
harder to recognize.

*)

(* Feb. 5 notes:

More fluent definition expansion would be useful.

The ability to reverse definition expansions (and the expansion of
=) would be convenient.

An idea:  instead of pruning propositions from sequents, how about
hiding some from view?

*)

(* Feb. 4:

attempting extension of rules for handling blocked complex terms on
the right to the left.

modified these rules so that universal quantification is used on right,
existential on left (so that witness rules are not needed).

These have been tried out in the Cantor's theorem proof (which is still
not finished).

*)

(* Feb. 3:

Attempting proof of Cantor's theorem in last comment.

Found stupid error in definition of classmatchprop!

and a stupid bug in alphaprop...

This is going to be valuable just as a shakedown cruise...

*)

(* Jan 31:

I spent time on trying to create a more sensible stratification algorithm,
but it didn't work (the results are found in marcelsequentalt.sml;
maybe something can be salvaged).

The version change is due to editing out blocks of old code in the
stratification algorithm; there should be no change in behavior.

Pruning of proofs looks harder than I thought.

*)

(* Jan 30 thoughts on future upgrades:

The stratification procedures used by the definition commands are
weaker than the ones used by the stratification checker of the prover;
this can always be obviated by explicitly typing variables (this might
be considered appropriate in defined constructions).  The
stratification could be upgraded easily for defined terms and somewhat
less easily for defined predicates.

The pruning of unused propositions from sequents is the most obvious
current desideratum which has been thought through to some extent.
A more drastic kind of pruning would involve searching for sequents
already proved which would justify sequents in proofs and allow their
proofs to be eliminated.  This seems to be hard.

Adding typed quantifiers and set abstracts would add a good deal of
practical power.  Note that adding typed quantifiers will have the unexpected
effect of allowing the strong equality rule to be proved using the current
set-based equality rule.

The ability to save theory files with definitions and theorems begins
to be of some interest.

Related is the idea of being able to print out proofs (since this system
actually generates and stores (locally) readable proofs).  The complementary
piece of software which parses and checks these proofs would also be amusing.

Integration with the Watson equational approach is a longer-term thought.

Smarter matching (sequent matching without need of line numbers, ACI matching
for appropriate logical connectives).

Other kinds of terms:  epsilon-terms, case expressions.

Creation of other versions:  a version for Zermelo-style set theory, or
a version for double extension set theory.  Positive set theory also
might support a version.

*)

(* Jan 30 release notes:

bug fix in safeseqmatch (updating of environment probably not carried
out correctly in old version).

Installed UseThm2, which matches conclusions of sequent before hypotheses
(this could make a difference because of the dynamic character of class
matching).  Order of matching within each side can be controlled by
reordering the propositions in the theorem.

The stratification algorithm no longer does any definition expansion at all.
The DefineTerm and DefineProp user commands now require stratification
information (a list of types -- in the case of DefProp, the types of
the arguments, and in the case of DefTerm, the type of the term followed
by the types of the arguments -- in both cases, the types are actually
relative).  If the defined operator is not stratified, a message will be
issued that stratification failed.  Unstratified operators can be
used only if all their arguments are constant; stratified propositions
and terms are typed using the relative types generated at declaration time.

This is all quite complicated, and its dynamic character may cause bugs...

The stratification algorithm for a set abstract only requires types to
be assigned to variables which are actually "connected" to the variable
representing the general element in the obvious sense -- so {x| x E y & z E z}
is actually accepted, though it would not be accepted in any context in which
one was forced to type z (this could not appear inside a set {z | ........})

The code for stratification in the hard cases was also substantially rewritten
to make it easier to understand...

Defined predicates are also handled.

*)

(* Jan 29 notes:

I intend to finish up loose ends in the dynamic stratification algorithm.

*)

(* Jan 28, 2003, version update:

dynamic stratification is now installed -- the system will attempt
to stratify set abstracts in which terms are not explicitly typed.
I do not know whether the algorithm used is complete.  It probably
isn't.  Enough repetitions would make it complete, except for
disconnected propositions; I don't know if this will be needed in practice.

New dynamic version should work perfectly, except that it can be
fooled by bound variables in defined constructions if they don't type
just right, because repetition doesn't really have the desired effect.
If definitions are written carefully, this will not be a problem?  Another
idea is to store expansions of definitions in a list so that the same
one will always be used.  It is also an argument for developing opaque
stratification for defined terms.

I haven't even thought about defined predicates in this connection!

*)

(* Jan 28 notes (no changes):

replace * with ! in order to avoid comment problem with ML?  Haven't
decided.

More error notification.  Automatic removal of error-generated
duplicate sequents.  User commands to allow pruning of unwanted stuff
from sequents, plus automatic pruning at the ends of proofs.  User
pruning is dangerous, though.  Undo facility?  I'm not sure how this
would work:  make sure undo can't be applied if the command just issued
was a successful Done() (because the effects would then be uncontrollable).

Automatic stratification handling would be nice.  It can probably be done
dynamically (and explicit typing of bound variables can then be eliminated --
a laborious process...)  But note that explicit typing does not have to
be removed...

Because of the dynamic character of class matching, control of the order
in which things are matched (in seqmatch, for example) would be handy.
A variant in which the conclusions are matched first would be useful.

*)

(* Jan 27, 2003:

This file now contains a complete proof that objects are equal iff their singleton
sets are equal.  It is rather long...but it is completely cut-free and makes no
use of matching.

Try proving Cantor's theorem?

Fixed _serious_ bug in stratification -- I don't know how I
failed to notice it!

put in message command "say" and versiondate command; 
installed some error messages and announcements.

wrote "usetermdef" function.  Installed rules for term definition expansion --
in fact, term definitions are at the moment only expanded in contexts where
they are elements.  But maybe they should also be expanded in situations where
they might usefully be pairs or projections (in equations).  Special right
equality rule added for defined terms.

defined stratification for defined notions by making definitions
"transparent".  I allow matching to expand definitions as well; in the
case of match failure, expand the definition.  Both of these may
prove to be unhealthy decisions -- if situations arise where
definitional expansion will cause huge blowups.  I don't know how
likely this is.

Note that if proofs are automatically pruned (unused sequents
omitted), it might be worthwhile to have the prover look for
previously proved results that cover newly proved sequents
retroactively.

I should add the facility for storing proof documents soon.  A related
facility would _check_ proof documents...

*)

(* 

installed definitions of predicates and term constructions.

installed sequent rule for expanding defined predicates.

installed ability to declare sequent axioms.

fixed a bug in class (predicate) matching.  The matching remains
dynamic -- the order in which matches are attempted makes a difference
in how well class matching works.

Much checking is required of things like new variable management
in the presence of definitions.

The axiom facility combines with class matching to allow declaration
of a very powerful equality axiom.  But the same thing could probably
be done with a modification of the sequent rules.

The next tasks are to install rules for expanding defined terms,
then to install stratification rules for defined terms and predicates.
Independently, there is the issue of identifying unused sequents and
pruning them out of proofs.

*)

(*

parsing of defined terms and predicates is handled.  I don't know
what is already installed for these -- I have to find out...

*)

(* proof serial numbers are installed 

simplification of sequents to further shorten proofs would be nice.
Get rid of propositions in sequents which are not actually used?
First approximation:  install a field in sequents which records
whether they have been used or not.

Add a new kind of node to handle references to stored theorems.
This will allow proofs of this kind to be handled as well.

*)

(*

The display could be improved by supplying each node with a serial
number, then having proved nodes reference the numbers of the nodes
on which they depend.  This would give a readable (if long) proof as
final output.

This version is in the middle of installation of defined propositions
and terms.  (which is now completed, at least in a preliminary form).

Definition facility next...

Class matches should now treat pairs intelligently.  Class matches
set by the user are now cleared when the match is complete:  the CLASSMATCHES
reference list for user-set class matches is cleared after the "safe"
match commands, unlike the TERMMATCHES and PROPMATCHES reference lists
for computer-generated matches, which are cleared at the beginning
of "safe" matching commands and are available for view afterward.

The system still needs smart matching for pairs.  It now has smart
matching for pairs, except in the classmatch function where I have
an idea for implementation.  Of course this needs to be tested.

A provisional version of class matching has been installed.  It is
complex enough that it needs considerable testing!  I can already tell
that this class matching algorithm crashes if a class symbol is
applied to a list of arguments which includes the same class symbol.
I may have fixed this -- I'm not sure.  The class matching did pass
the first test I applied.  Notice for debugging that the environment
variables PROPMATCH and TERMMATCH which record matching information
persist after a match is completed -- they are cleared before the next
"safe" (i.e. top-level) match command.  So one can look at them.
Note further that for a class definition (formula) to match anything,
all its formal parameters must actually occur in its definition.

To handle complex situations, it would be helpful to be able to set
class matching manually (this would amount to a rudimentary class
definition facility!)

The functions of the proof which care (pair reduction and sequent termination)
can now tell that terms which are identical up to alpha conversion are in fact
the same term.  Functions safealphaprop and safealphaterm check terms for
equality up to alpha-conversion.

There is now at least a mock-up of the full reasoning capabilities of the system.
Proved sequents can now be stored and used to prove goals by matching.

latest planning thoughts:

upgrading sequent matching to get ACI matching for propositional connectives?

longer term:  the Watson approach to rewriting (and the Watson internal programming
language) may be exportable to this environment.

The proof structure ought to contain an extra field for annotations
(containing a description of the justification of the step).
DONE:This has been otherwise implemented.

Once the sequent storage and matching facilities are available,
the reasoning strategy of this system will be implemented.  Initially,
make sequent matching mechanistic:  describe the subsequent to be
matched (by giving a list of left items and right items in the correct order,
using the numerical indices).  The matching of propositions and terms
ought to take advantage of known properties of logical connectives (ACI for
conjunction and disjunction, for example).STILL TO BE ATTEMPTED

The definition facility is needed for the ability to represent mathematical
concepts.  The additional term and proposition constructions (epsilon-terms,
restricted quantification and set abstraction, type judgments) are also needed
more for this side of things.

Substitution into set abstracts may require type shifts.

*)

(* the style of proof will be sequent, with Marcel's system with
cut-elimination as the jumping off point.  Stratification will be
handled by providing explicitly numerically typed variables, and
requiring that they be used for all variables bound in set abstracts
not restricted to s.c. types.  Variables bound in s.c. sets (both in
quantifiers and in sets) will be supported, giving NFU*. (Restriction
to s.c. sets is not yet supported) *)

(* the user will see a sequent which he is trying to prove.  Whenever
a higher level sequent is proved, he will be offered the chance to
name it (not yet implemented).  The ability to view and use stored
sequents will be needed eventually. *)

(* facilities for definition of set and propositional operations will be
needed.  The forms of definitions should make it clear whether they define
stratified objects.  Note that I do want the ability to define unstratified
object and proposition constructions.  Defined objects will be propositions
or terms with free variables into which substitutions are to be made --
perhaps rule applications should automatically unpack definitions when needed
(making the definitions invisible to the sequent engine) *)

(* latest version has comments in various places which can be used as
documentation -- in particular, the syntax in which propositions and
terms are written is described under the display functions and the user
commands are collected and commented at the end of the file *)

(* peculiarities of the theory that is implemented are discussed 
through the file -- look at the pleftrule and prightrule commands, for example *)

(* new things needed:

definition facility: use something like the substitution approach
taken in PM: a defined object will be represented by a term or
proposition containing free variables, with the number of free
variables indicating the number of arguments and the index order of
the variables indicating the order of the arguments.  The definition
facility will require that the notion of free variable be defined
(this hasn't been needed yet, because binding variables are always
given fresh names in my definition of substitution).  The syntax of
use of defined notions will be like that of class variables at present
-- note that the binding convention for explicit applications of
defined terms (all bound variables in the defined term are bound in
the construction) prevents abstraction into such terms.  Defined terms
with type should have instances automatically retyped (finesse in the
definition of substitution might handle this).

Binding constructions using s.c. types are needed -- for example,
{x:A|P1(x1)}.  x:A means "x is an element of A and A is s.c."  There
is no stratification requirement for comprehension for these
constructs, and they are stratified when the leading variable is
untyped (though subformulas involving typed variables do need to obey
the rules).  This implements NFU*, which Solovay has shown to be
equiconsistent with Zermelo + sigma2 replacement.

epsilon-terms are needed.  These are readily typed (in the relative
sense) and are needed to best handle term constructions.  The equality
criterion (epsilon x.phi) = (epsilon x.psi) iff psi(epsilon x.phi) and
phi(epsilon x.phi) (when both extensions are nonempty) makes it the
choice function of an order.  That equality criterion can only be
allowed for stratified epsilon terms, as we cannot have a well-order
with respect to all formulas.  It would be convenient to preserve the
ability to use epsilon-terms with unstratified propositions, but it
needs to be done carefully!  What are the correct sequent rules for
epsilon-terms?

Infix notation for relations (sets or classes of pairs). (x.R.y) is the current
idea.  Both set and class relations would be wanted.  How about infix term
operators?  Alternatively, this could be an alternative form of the "defined
operation" notation. (x.R.y) = R(x,y) = (plug in x and y for the two free variables
of R).

Normalization of bound variables for more efficient sequent finishing and matching.
(this is a c1 style operation).  This is needed immediately to get the pair
and projection equality rules to work correctly.

Functions for checking validity of proof structures and perhaps performing transformations
like cut elimination.

For use of theorems already proved (or exploitation of symmetries in free standing
proofs) proposition, term and sequent matching are needed, so that we can tell when
a sequent can be justified by an already proved sequent.  

How does rewriting fit in with this system?  Can it be interfaced with Watson in some
way?  Is there a nice way to develop a tactic language?

*)

(* inner types:

sequent at the center -- a sequent is a pair of lists of propositions.

a proposition is a

   i.  negation of proposition

   ii.  conjunction of two propositions

   iii.  disjunction of two propositions

   iv.  implication between two propositions

   v.  equivalence of two propositions

   vi.  xor of two propositions

   vii.  equation of two terms

   viii.  membership of one term in another

   ix.  defined operator on list of terms or propositions. (stratified or otherwise)

   x.  propositional variable? (probably, initially)

   xi.  type declaration of a type?  (s.c set)

   xii.  type judgement?

   xiii.  universal quantification (over a type is a special case)

   xiv.  existential quantification  (over a type is a special case)

  
a term is

    i.  an untyped variable

    ii.  a "fresh variable"  (has index which automatically gets set)

    iii.  a typed variable (natural number types should suffice)

    iv.  a stratified set (variable has type)

    v.  a subset of a type

    vi.  a defined operator (stratified or otherwise)

will there be complex types?  or are type names terms (sets) as well?
    
The only type rule is that formulas with typed variables inside stratified set
abstracts must obey stratification rules.  This means that the system will never
need to deduce whether something is stratified or not on a non-local basis.
Note that variables in restricted set abstracts will not need any types at all --
this supports NFU* comprehension.

sequents enter into proofs: a proof consists of a base sequent to be
proved and a list of proofs.  A complete proof is either a base
sequent whose two sets meet (or which has a known proof, when this
comes on line) with the empty list of proofs or a base sequent with
a list of complete proofs whose base sequents are related to the
main base sequent by a rule.

The navigation metaphor:  one should be able to look at any sequent,
have coordinates for its propositions on both sides, and be able to apply
any rule to any of the propositions to generate new propositions.  The simplest
thing is to have the rules automatically generate the subproofs and present the
"first" one.  Should we have the ability to "skip" a subproof?  Whenever a proof
is completed, one should be able to record it with a name.

Idea: to skip a subproof, record it as a lemma with a name; it is then
an obligation that one can call up by name, but so far as the current
proof is concerned it justifies the subproof. (not implemented).
(the new implementation allows subproofs to be recorded as theorems
and used in the proof of the main theorem).

*)

(* list utilities *)

fun drop s nil = nil |

   drop s ((t,u)::L) = if s = t then drop s L else (t,u)::(drop s L);

fun drop2 s nil = nil |

   drop2 s (t::L) = if s=t then drop2 s L else (t::(drop2 s L));

fun find x nil = nil |

find x ((y,z)::L) = if x=y then [z] else find x L;

fun foundin x nil = false |

foundin x (y::L) = x=y orelse foundin x L;

fun safefind default x L = if find x L = nil then default else hd(find x L);



(* autologging stuff *)

val LOGFILE = ref (TextIO.openOut("default"));

val LOGGING = ref false;

val LINENUMBER = ref 0;

fun Say s = (say s;
if (!LOGGING) then (say ("In line number "^(makestring(!LINENUMBER)));TextIO.flushOut(!LOGFILE)) else ();getstuff());

fun startlogging filename = (LINENUMBER:=0;LOGGING:=true;LOGFILE:=
    (TextIO.openOut(setdir(filename^".mlg"))));

fun stoplogging() = (TextIO.flushOut(!LOGFILE);
TextIO.closeOut(!LOGFILE);LOGGING:=false);

fun nextline() = LINENUMBER:=(!LINENUMBER)+1;

fun writelogline s = if (!LOGGING) then TextIO.output((!LOGFILE),s) else ();


(* command line items *)

datatype Item =

   Mnemonic of string |  (*name of command*)

   IntegerArg of int |  (* integer argument *)

   IntegerListArg of int list | (* list of integers *)

   StringArg of string |  (* string argument *)

   StringListArg of string list; 

fun removefirst s = if s = "" then "" else implode(tl(explode s));

(* functions for uniform display of command lines *)

fun itemdisplay (Mnemonic s) = s |

   itemdisplay (StringArg s) = "\""^s^"\"" |

   itemdisplay (IntegerArg n) = makestring n |

   itemdisplay (IntegerListArg nil) = "[]" |

   itemdisplay (IntegerListArg (n::L)) = "["^(makestring n)
                          ^(if L = nil then "" else ",")
                          ^(removefirst(itemdisplay(IntegerListArg L))) |

   itemdisplay (StringListArg nil) = "[]" |

   itemdisplay (StringListArg (s::L)) = "["^(itemdisplay(StringArg s))
                          ^(if L = nil then "" else ",")
                          ^(removefirst(itemdisplay(StringListArg L)));

fun linedisplay [Mnemonic m] = m^"(); " |

   linedisplay [x] = (itemdisplay x)^"; " |

   linedisplay (x::L) = (itemdisplay x)^" "^(linedisplay L);

(* format for a user command to log itself:

if logging [increment the line number
writelogline (the command)[a return followed by the line number if Done
or UseThm(2)]]

*)

fun linenumber() = "(* "^(makestring(!LINENUMBER))^" *)  ";

fun nextlinenumber() = "(* "^(makestring(1+(!LINENUMBER)))^" *)  ";


datatype Proposition = PropVar of int*(Term list) |

   In of Term*Term |

   Equals of Term*Term |

   Not of Proposition |

   And of Proposition*Proposition |

   Or of Proposition*Proposition |

   If of Proposition*Proposition |

   ConvIf of Proposition*Proposition |

   Iff of Proposition*Proposition |

   Xor of Proposition*Proposition |

   All of int*int*Proposition |

   Some of int*int*Proposition |

   DefProp of string*(Term list) |

(* the parenthesis is an artificial gadget to handle precedence issues *)

   Parenthesis of Proposition

and Term = 

   FreeVar of int |  

   BoundVar of int*int | 

   Set of int*int*Proposition |
        
   Pair of Term*Term | 

   Proj1 of Term | 

   Proj2 of Term |
        
   DefTerm of string*(Term list) |

(* Fake is a hack used to get matching of projections to work correctly *)

   Fake of Term;

(* we could also use Fake to handle explicit parentheses 
in infix term parsing? *)

fun dparenp (In(t,u)) = In(dparent t, dparent u) |

dparenp (Equals(t,u)) = Equals(dparent t, dparent u) |

dparenp (Not p) = Not (dparenp p) |

dparenp (And(p,q)) = And(dparenp p,dparenp q) |
dparenp (Or(p,q)) = Or(dparenp p,dparenp q) |
dparenp (If(p,q)) = If(dparenp p,dparenp q) |
dparenp (ConvIf(p,q)) = ConvIf(dparenp p, dparenp q) |
dparenp (Iff(p,q)) = Iff(dparenp p,dparenp q) |
dparenp (Xor(p,q)) = Xor(dparenp p,dparenp q) |

dparenp (All(m,n,p)) = All(m,n,dparenp p) |
dparenp (Some(m,n,p)) = Some(m,n,dparenp p) |

dparenp (DefProp(s,L)) = DefProp(s,map dparent L) |

dparenp (Parenthesis p) = dparenp p |

dparenp (PropVar(n,L)) = PropVar(n,map dparent L)

and dparent (Set(m,n,p)) = Set(m,n,dparenp p) |

dparent (Pair(t,u)) = Pair(dparent t, dparent u) |

dparent (Proj1 t) = Proj1 (dparent t) |
dparent (Proj2 t) = Proj2 (dparent t) |

dparent (DefTerm (s,L)) = DefTerm(s,map dparent L) |

dparent (Fake t) = dparent t |

dparent t = t;

(* proof serial number counter *)

val NEXTSERIAL = ref 0;

fun getnewserial() = (NEXTSERIAL:=(!NEXTSERIAL)+1;(!NEXTSERIAL));

fun resetserial() = NEXTSERIAL:=0;

(* proposition serial number counter *)

val NEXTPSERIAL = ref 0;

fun nextpserial() = (NEXTPSERIAL:=(!NEXTPSERIAL)+1;(!NEXTPSERIAL));

fun resetpserial() = NEXTPSERIAL:=0;

(* counters for new variables *)

val NEXTFREE = ref 1;

fun getnewfree() = (NEXTFREE:=(!NEXTFREE)+1;FreeVar (!NEXTFREE));

val NEXTBOUND = ref 1;

fun getnewbound(t) = (NEXTBOUND:=(!NEXTBOUND)+1;BoundVar(!NEXTBOUND,t));

fun max ((m:int), (n:int)) = if m>n then m else n

(* toggle to disable the pair and projections *)

val NOPAIRS = ref false;

(* arities of declared operators *)

val ARITIES = ref (nil:(string*int)list);

fun arity s = safefind 0 s (!ARITIES);


(* detect parse errors *)

fun parseerror (BoundVar(n,m)) = false |

parseerror (FreeVar n) = n= 0 |

parseerror (DefTerm(s,nil)) = if arity s <> 0
                              andalso find s (!ARITIES) <> nil
                              then (Say "Arity error";true) else false |

parseerror (DefTerm(s,(t::L))) = map parseerror (t::L) <> map (fn x=>false) (t::L) orelse 
if (arity s <> length (t::L) andalso find s (!ARITIES) <> nil)
then (Say "Arity error";true) else false |

parseerror (Set(m,n,p)) = Parseerror p |

parseerror (Pair(x,y)) = (!NOPAIRS) orelse parseerror x orelse parseerror y |

parseerror (Proj1 x) = (!NOPAIRS) orelse parseerror x |

parseerror (Proj2 x) = (!NOPAIRS) orelse parseerror x

(* parse errors continued *)

and Parseerror (PropVar (v, nil)) = v= ~1 |

    Parseerror (PropVar (v, (p::L))) = map (parseerror) (p::L) <>
                                        map (fn x=>false) (p::L) |

    Parseerror (DefProp(s,L)) = map (parseerror) (L) <>
                                        map (fn x=>false) (L)
                                orelse 
                                if (find s (!ARITIES) <> nil 
                                andalso length L <> arity s)
                                then (Say "Arity error";true) else false |

    Parseerror (In(x,y)) = parseerror x orelse parseerror y |

    Parseerror     (Equals(x,y)) = parseerror x orelse parseerror y |

     Parseerror   (And(p,q)) = Parseerror p orelse Parseerror q |
      Parseerror   (Or(p,q)) = Parseerror p orelse Parseerror q |
      Parseerror   (If(p,q)) = Parseerror p orelse Parseerror q |
     Parseerror(ConvIf(p,q)) = Parseerror p orelse Parseerror q |
    Parseerror     (Iff(p,q)) =Parseerror p orelse Parseerror q  |
     Parseerror    (Xor(p,q)) = Parseerror p orelse Parseerror q |
    Parseerror (Not(p)) = (Parseerror p) |
    Parseerror (All(n,t,p)) = Parseerror p |
    Parseerror (Some(n,t,p)) = Parseerror p |
    Parseerror (Parenthesis p) = true;

(* the largest index in a term *)

fun termboundindex (BoundVar(n,m)) = n |

termboundindex (FreeVar n) = 0 |

termboundindex (DefTerm(s,nil)) = 0 |

termboundindex (DefTerm(s,(t::L))) = max(termboundindex t,termboundindex(DefTerm(s,L))) |

termboundindex (Set(m,n,p)) = max(m,newboundindex p) |

termboundindex (Pair(x,y)) = max(termboundindex x,termboundindex y) |

termboundindex (Proj1 x) = termboundindex x |

termboundindex (Proj2 x) = termboundindex x

(* the largest bound variable index in a proposition *)  
(* the previously found addition of one is probably excessive *)

and newboundindex (PropVar (v, nil)) = 1 |

    newboundindex (PropVar (v, (p::L))) = max(termboundindex p,newboundindex(PropVar (v, L))) |

    newboundindex (DefProp(s,L)) = newboundindex (PropVar(1,L)) |

    newboundindex (In(x,y)) = max (termboundindex x,termboundindex y) |

    newboundindex (Equals(x,y)) = max(termboundindex x,termboundindex y) |

    newboundindex (And(p,q)) = max (newboundindex p,newboundindex q) |
    newboundindex (Or(p,q)) = max (newboundindex p,newboundindex q) |
    newboundindex (If(p,q)) = max (newboundindex p,newboundindex q) |
newboundindex (ConvIf(p,q)) = max (newboundindex p,newboundindex q) |
    newboundindex (Iff(p,q)) = max (newboundindex p,newboundindex q) |
    newboundindex (Xor(p,q)) = max (newboundindex p,newboundindex q) |
    newboundindex (Not(p)) = (newboundindex p) |
    newboundindex (All(n,t,p)) = max(n,newboundindex p) |
    newboundindex (Some(n,t,p)) = max(n,newboundindex p) |
    newboundindex (Parenthesis p) = newboundindex p;

fun termfreeindex (BoundVar(n,m)) = 0 |

termfreeindex (FreeVar n) = abs n |

termfreeindex (DefTerm(s,nil)) = 0 |

termfreeindex (DefTerm(s,t::L)) = max(termfreeindex t,termfreeindex(DefTerm(s,L))) |

termfreeindex (Set(m,n,p)) = newfreeindex p |

termfreeindex (Pair(x,y)) = max(termfreeindex x,termfreeindex y) |

termfreeindex (Proj1 x) = termfreeindex x |

termfreeindex (Proj2 x) = termfreeindex x

(* the largest free variable index in a proposition *)  
(* the previously found addition of one is probably excessive *)

and newfreeindex (PropVar (v, nil)) = 0 |

    newfreeindex (PropVar (v, (p::L))) = max(termfreeindex p,newfreeindex(PropVar (v, L))) |

    newfreeindex (DefProp (s,L)) = newfreeindex (PropVar (1,L)) |

    newfreeindex (In(x,y)) = max (termfreeindex x,termfreeindex y) |

    newfreeindex (Equals(x,y)) = max(termfreeindex x,termfreeindex y) |

    newfreeindex (And(p,q)) = max (newfreeindex p,newfreeindex q) |
    newfreeindex (Or(p,q)) = max (newfreeindex p,newfreeindex q) |
    newfreeindex (If(p,q)) = max (newfreeindex p,newfreeindex q) |    
newfreeindex (ConvIf(p,q)) = max (newfreeindex p,newfreeindex q) |
    newfreeindex (Iff(p,q)) = max (newfreeindex p,newfreeindex q) |
    newfreeindex (Xor(p,q)) = max (newfreeindex p,newfreeindex q) |
    newfreeindex (Not(p)) = (newfreeindex p) |
    newfreeindex (All(n,t,p)) = newfreeindex p |
    newfreeindex (Some(n,t,p)) = newfreeindex p |
    newfreeindex (Parenthesis p) = newfreeindex p;

(* these functions find largest index of a free variable (not
including unknown variables).  might have some role in refinement of
rules for manipulation of unknown variables. not used yet.  *)

fun termfreeindex2 (BoundVar(n,m)) = 0 |

termfreeindex2 (FreeVar n) = if n>0 then n else 0 |

termfreeindex2 (DefTerm(s,nil)) = 0 |

termfreeindex2 (DefTerm(s,t::L)) = max(termfreeindex2 t,termfreeindex2(DefTerm(s,L))) |

termfreeindex2 (Set(m,n,p)) = newfreeindex2 p |

termfreeindex2 (Pair(x,y)) = max(termfreeindex2 x,termfreeindex2 y) |

termfreeindex2 (Proj1 x) = termfreeindex2 x |

termfreeindex2 (Proj2 x) = termfreeindex2 x

(* the largest free variable index in a proposition *)  
(* the previously found addition of one is probably excessive *)

and newfreeindex2 (PropVar (v, nil)) = 0 |

    newfreeindex2 (PropVar (v, (p::L))) = max(termfreeindex2 p,newfreeindex2(PropVar (v, L))) |

    newfreeindex2 (DefProp (s,L)) = newfreeindex2 (PropVar (1,L)) |

    newfreeindex2 (In(x,y)) = max (termfreeindex2 x,termfreeindex2 y) |

    newfreeindex2 (Equals(x,y)) = max(termfreeindex2 x,termfreeindex2 y) |

    newfreeindex2 (And(p,q)) = max (newfreeindex2 p,newfreeindex2 q) |
    newfreeindex2 (Or(p,q)) = max (newfreeindex2 p,newfreeindex2 q) |
    newfreeindex2 (If(p,q)) = max (newfreeindex2 p,newfreeindex2 q) |    
newfreeindex2 (ConvIf(p,q)) = max (newfreeindex2 p,newfreeindex2 q) |
    newfreeindex2 (Iff(p,q)) = max (newfreeindex2 p,newfreeindex2 q) |
    newfreeindex2 (Xor(p,q)) = max (newfreeindex2 p,newfreeindex2 q) |
    newfreeindex2 (Not(p)) = (newfreeindex2 p) |
    newfreeindex2 (All(n,t,p)) = newfreeindex2 p |
    newfreeindex2 (Some(n,t,p)) = newfreeindex2 p |
    newfreeindex2 (Parenthesis p) = newfreeindex2 p;
      
(* the deproj and depair functions simplify management of pairs *)

(* the pair is supposed surjective *)

fun deproj (Proj1(Pair(x,y))) = x |

deproj (Proj2(Pair(x,y))) = y |

deproj x = x;

(* make genuine stacks for counter-safe commands *)

val OLDFREE = ref ([!NEXTFREE]);

val _ = OLDFREE:=nil;

val OLDBOUND = ref ([!NEXTBOUND]);

val _ = OLDBOUND:=nil;

fun savecounters() = (OLDFREE := (!NEXTFREE)::(!OLDFREE);
OLDBOUND:=(!NEXTBOUND)::(!OLDBOUND));

fun getcounters() = (NEXTFREE:= hd(!OLDFREE); OLDFREE:=tl(!OLDFREE);
NEXTBOUND:= hd(!OLDBOUND); OLDBOUND:=tl(!OLDBOUND));

(* list of substitutions for unknown variables assumed by alphaprop *)

val USUBS = ref (nil:((int*Term)list));

val USUBSBLOCKED=ref false;

fun blockusubs() = USUBSBLOCKED:=true;

fun unblockusubs() = USUBSBLOCKED:=false;

(* not a good place for automatic unknown subs *)

fun depair (Pair(Proj1 x,Proj2 y)) = 
if (blockusubs();safealphaterm x y) then (unblockusubs();x) else 
(unblockusubs();(Pair(Proj1 x,Proj2 y))) |

depair x = x

(* the NEXTFREE counter really does need to be global (on any given
branch of a proof, at least) and in practice it does not get absurdly
large.  The bound variable counter really only needs to be considered
in a single term or formula.  How about a top-level version of substerm
and subsprop which sets the NEXTBOUND counter to 0? *)

(* substitution functions *)

(* variable collision problems are avoided by _always_ renaming a bound variable
with a fresh index before substituting -- one doesn't even need a definition of
"free"! *)

and substerm m n t (BoundVar(m1,n1)) = if m=m1 andalso n=n1 then t else BoundVar(m1,n1)

| substerm m n t (Set(m1,n1,p)) = 

(NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));
NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));
let val BoundVar(r,N) = getnewbound(n1) in

Set(r,n1,subsprop m n t (subsprop m1 n1 (BoundVar(r,n1)) p)) end)

| substerm m n t (Pair(x,y)) = depair(Pair(substerm m n t x,substerm m n t y))

| substerm m n t (Proj1 x) = deproj(Proj1 (substerm m n t x))

| substerm m n t (Proj2 x) = deproj(Proj2 (substerm m n t x))

| substerm m n t (DefTerm(s,L)) = DefTerm(s,map (substerm m n t) L) |

substerm m n t x = x  

and
   subsprop m n t (PropVar (v, L)) = PropVar (v, (map (substerm m n t) L)) |

   subsprop m n t (In(x,y)) = In(substerm m n t x,
                            substerm m n t y) |

   subsprop m n t (Equals(x,y)) = Equals(substerm m n t x,
                            substerm m n t y) |

   subsprop m n t (And(p,q)) = And(subsprop m n t p,subsprop m n t q) |

   subsprop m n t (Or(p,q)) = Or(subsprop m n t p,subsprop m n t q) |

   subsprop m n t (If(p,q)) = If(subsprop m n t p,subsprop m n t q) |
subsprop m n t (ConvIf(p,q)) = ConvIf(subsprop m n t p,subsprop m n t q) |
   subsprop m n t (Iff(p,q)) = Iff(subsprop m n t p,subsprop m n t q) |

   subsprop m n t (Xor(p,q)) = Xor(subsprop m n t p,subsprop m n t q) |

   subsprop m n t (Not(p)) = Not(subsprop m n t p) |

   subsprop m n t (All(m1,n1,p)) =

       (NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));

       let val BoundVar (r, N)  = getnewbound(n1) in

       All(r,n1,subsprop m n t (subsprop m1 n1 (BoundVar (r,n1)) p))

       end) |

   subsprop m n t (Some(m1,n1,p)) =

       (NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));

       let val BoundVar (r, N) = getnewbound(n1) in

       Some(r,n1,subsprop m n t(subsprop m1 n1 (BoundVar(r,n1)) p))

       end) |

   subsprop m n t (DefProp(s,L)) = DefProp(s,map (substerm m n t) L) |

   subsprop m n t (Parenthesis p) = Parenthesis (subsprop m n t p)

(* functions which recognize equivalence up to alpha-conversion *)

and usubsok n t = n>0 andalso (find n (!USUBS) = nil orelse 
   t=hd(find n (!USUBS)) orelse
   alphaterm t (hd(find n (!USUBS))))

and alphaterm (FreeVar n) (FreeVar m) = 

   if (!USUBSBLOCKED) then m=n else

   if n=0 orelse m=0 then false else

   if n>0 andalso m>0 then m=n

   else if n>0 andalso m<0 andalso n<(~m) andalso usubsok (~m) (FreeVar n)

     then (USUBS:=((~m,FreeVar n)::(drop (~m)(!USUBS)));true)

   else if m>0 andalso n<0 andalso m<(~n) andalso usubsok (~n) (FreeVar m)

   then (USUBS:=((~n,FreeVar m)::(drop (~n)(!USUBS)));true)

   else if m=n then true

   else if m<0 andalso n<0 andalso m>n andalso usubsok (~n) (FreeVar m)

   then (USUBS:=((~n,FreeVar m)::(drop(~n)(!USUBS)));true)

   else if m<0 andalso n<0 andalso m<n andalso usubsok (~m) (FreeVar n) then 

   (USUBS:=((~m,FreeVar n)::(drop (~m)(!USUBS)));true) else false |

alphaterm (FreeVar n) t =

   if (!USUBSBLOCKED) then false else
   if n>=0 orelse termfreeindex t >= (~n) orelse 
   (not(usubsok (~n) t))
   then false else (USUBS:=((~n,t)::(drop (~n)(!USUBS)));true) |

alphaterm t (FreeVar n) = alphaterm (FreeVar n) t |

alphaterm (BoundVar(n1,t1)) (BoundVar(n2,t2)) = n1=n2 andalso t1 = t2 |

alphaterm (Pair(x,y)) (Pair(z,w)) = alphaterm x z andalso alphaterm y w |

alphaterm (Proj1 x) (Proj1 y) = alphaterm x y |

alphaterm (Proj2 x) (Proj2 y) = alphaterm x y |

alphaterm (Set(m1,n1,t1)) (Set(m2,n2,t2)) = let val FreeVar(n) = getnewfree() in

alphaprop (subsprop m1 n1 (FreeVar(n)) t1) (subsprop m2 n2 (FreeVar(n)) t2) end |

alphaterm (DefTerm(s,L)) (DefTerm(t,M)) = s=t andalso alphatermlist L M |

alphaterm x y = false

and alphatermlist nil nil = true |

alphatermlist (t::L) (t2::L2) = alphaterm t t2 andalso alphatermlist L L2 |

alphatermlist x y = false 

and alphaprop (PropVar(v1,L1)) (PropVar(v2,L2)) = v1 = v2 andalso
     alphatermlist L1 L2 |

alphaprop (Not(p)) (Not(q)) = alphaprop p q |
alphaprop (And(p1,q1)) (And(p2,q2)) =  alphaprop p1 p2 andalso alphaprop q1 q2 |
alphaprop (Or(p1,q1)) (Or(p2,q2)) =  alphaprop p1 p2 andalso alphaprop q1 q2 |

alphaprop (If(p1,q1)) (If(p2,q2)) =  alphaprop p1 p2 andalso alphaprop q1 q2 |
alphaprop (ConvIf(p1,q1)) (ConvIf(p2,q2)) =  alphaprop p1 p2 andalso alphaprop q1 q2 |
alphaprop (Iff(p1,q1)) (Iff(p2,q2)) =  alphaprop p1 p2 andalso alphaprop q1 q2 |

alphaprop (Xor(p1,q1)) (Xor(p2,q2)) =  alphaprop p1 p2 andalso alphaprop q1 q2 |

alphaprop (In(p1,q1)) (In(p2,q2)) =  alphaterm p1 p2 andalso alphaterm q1 q2 |

alphaprop (Equals(p1,q1)) (Equals(p2,q2)) =  alphaterm p1 p2 andalso alphaterm q1 q2 |

alphaprop (All(m1,n1,p1)) (All(m2,n2,p2)) =  let val FreeVar(n) = getnewfree() in

alphaprop (subsprop m1 n1 (FreeVar(n))p1) (subsprop m2 n2 (FreeVar(n))p2)

end |
alphaprop (Some(m1,n1,p1)) (Some(m2,n2,p2)) =  let val FreeVar(n) = getnewfree() in

alphaprop (subsprop m1 n1 (FreeVar(n))p1) (subsprop m2 n2 (FreeVar(n))p2)

end |

alphaprop (DefProp(s,L)) (DefProp(t,M)) = s=t andalso alphatermlist L M |

alphaprop (Parenthesis p) (Parenthesis q) = alphaprop p q |

alphaprop x y = false

(* the safe versions restore the variable counters and clear the match info *)

and safealphaprop t u = (savecounters();
let val T = alphaprop t u in (getcounters();T) end)
and safealphaterm t u = (savecounters();
let val T = alphaterm t u in (getcounters();T) end);

(*  top level substitution for bound variables *)

(* these were implemented very oddly -- see if they still work *)

fun topsubsterm m n t U = (savecounters();let val T =
(NEXTBOUND:=m;substerm m n t U) in (getcounters();T) end);
fun topsubsprop m n t U = (savecounters();let val T =
(NEXTBOUND:=m;subsprop m n t U) in (getcounters();T) end);

(*  substitution for free variables *)

fun subsfree  n t (BoundVar(m1,n1)) = BoundVar(m1,n1)

| subsfree n t (Set(m1,n1,p)) = 

(NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));
NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));
let val BoundVar(r,N) = getnewbound(n1) in

Set(r,n1,subsfreep n t (topsubsprop m1 n1 (BoundVar(r,n1)) p)) end)

| subsfree n t (Pair(x,y)) = depair(Pair(subsfree n t x,subsfree n t y))

| subsfree n t (Proj1 x) = deproj(Proj1 (subsfree n t x))

| subsfree n t (Proj2 x) = deproj(Proj2 (subsfree n t x))

| subsfree n t (DefTerm(s,L)) = DefTerm(s,map (subsfree n t) L) |

subsfree n t (FreeVar m) = if m=n then t else FreeVar m |

subsfree n t x = x  

and
   subsfreep n t (PropVar (v, L)) = PropVar (v, (map (subsfree n t) L)) |

   subsfreep n t (In(x,y)) = In(subsfree n t x,
                            subsfree n t y) |

   subsfreep n t (Equals(x,y)) = Equals(subsfree n t x,
                            subsfree n t y) |

   subsfreep n t (And(p,q)) = And(subsfreep n t p,subsfreep n t q) |

   subsfreep n t (Or(p,q)) = Or(subsfreep n t p,subsfreep n t q) |

   subsfreep n t (If(p,q)) = If(subsfreep n t p,subsfreep n t q) |
subsfreep n t (ConvIf(p,q)) = ConvIf(subsfreep n t p,subsfreep n t q) |
   subsfreep n t (Iff(p,q)) = Iff(subsfreep n t p,subsfreep n t q) |

   subsfreep n t (Xor(p,q)) = Xor(subsfreep n t p,subsfreep n t q) |

   subsfreep n t (Not(p)) = Not(subsfreep n t p) |

   subsfreep n t (All(m1,n1,p)) =

       (NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));

       let val BoundVar (r, N)  = getnewbound(n1) in

       All(r,n1,subsfreep n t (topsubsprop m1 n1 (BoundVar (r,n1)) p))

       end) |

   subsfreep n t (Some(m1,n1,p)) =

       (NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));

       let val BoundVar (r, N) = getnewbound(n1) in

       Some(r,n1,subsfreep n t(topsubsprop m1 n1 (BoundVar(r,n1)) p))

       end) |

   subsfreep n t (DefProp(s,L)) = DefProp(s,map (subsfree n t) L) |

   subsfreep n t (Parenthesis p) = Parenthesis (subsfreep n t p) |

   subsfreep n t p = p;

fun topsubsfree n t T = (savecounters();let val A =(NEXTBOUND:=0;subsfree n t T) in (getcounters();A) end);
fun topsubsfreep n t T = (savecounters();let val A =(NEXTBOUND:=0;subsfreep n t T) in (getcounters();A) end);

(* modify so that rewrites do not increase free variable indices *)
(* unknown variables handled by absolute value of index *)

fun Topsubsfree n (FreeVar m) T =

   if abs(m)>abs(n) then topsubsfree m (FreeVar n) T

   else topsubsfree n (FreeVar m) T |

   Topsubsfree n t T = topsubsfree n t T;

fun Topsubsfreep n (FreeVar m) T =

   if abs(m)>abs(n) then topsubsfreep m (FreeVar n) T

   else topsubsfreep n (FreeVar m) T |

   Topsubsfreep n t T = topsubsfreep n t T;

(* the aim of this function is to replace all free (and unknown)
variables by new unknown variables *)

(* this is for use by ThmCut *)

val NEWUNKNOWNSBASE=ref 0;

fun setnewunknownsbase() = NEWUNKNOWNSBASE:=(!NEXTFREE);

fun newunknownsp (PropVar(n,L)) =

   PropVar(n,map newunknownst L) |

   newunknownsp (In(T,U)) = In(newunknownst T, newunknownst U) |

   newunknownsp (Equals(T,U)) = Equals(newunknownst T,newunknownst U) |

   newunknownsp (Not(P)) = Not (newunknownsp P) |

   newunknownsp (And(P,Q)) = And(newunknownsp P,newunknownsp Q) |

   newunknownsp (If(P,Q)) = If(newunknownsp P,newunknownsp Q) |

   newunknownsp (Or(P,Q)) = Or(newunknownsp P,newunknownsp Q) |

   newunknownsp (Iff(P,Q)) = Iff(newunknownsp P,newunknownsp Q) |

   newunknownsp (ConvIf(P,Q)) = ConvIf(newunknownsp P,newunknownsp Q) |

   newunknownsp (Xor(P,Q)) = Xor(newunknownsp P,newunknownsp Q) |

   newunknownsp (All(m,n,P)) = All(m,n,newunknownsp P) |

   newunknownsp (Some(m,n,P)) = Some(m,n,newunknownsp P) |

   newunknownsp  (DefProp(s,L)) = DefProp(s,map newunknownst L) |

   newunknownsp (Parenthesis P) = Parenthesis (newunknownsp P)

and newunknownst (FreeVar t) =
   (NEXTFREE:=max((!NEXTFREE),(!NEWUNKNOWNSBASE)+abs(t));
   FreeVar(~((!NEWUNKNOWNSBASE)+abs(t)))) |

   newunknownst (BoundVar(m,n)) = BoundVar(m,n) |

   newunknownst (Set(m,n,P)) = Set(m,n,newunknownsp P) |

   newunknownst (Pair(T,U)) = Pair(newunknownst T,newunknownst U) |

   newunknownst  (Proj1 T) = Proj1 (newunknownst T) |

   newunknownst (Proj2 T) = Proj2 (newunknownst T) |

   newunknownst (DefTerm (s,L)) = DefTerm (s,map newunknownst L) |

   newunknownst (Fake T) = Fake (newunknownst T);

fun anonymizeterm t = (setnewunknownsbase();newunknownst t);

(* general rewrite function -- needed for set-free equality rule *)

(* this controls whether instances of the rewritten term are to be rewritten, bit by bit, low order first. *)

val SAVEUSUBS = ref(!USUBS);

fun saveusubs() = SAVEUSUBS:=(!USUBS);

fun resetusubs() = USUBS:=(!SAVEUSUBS);

fun testalphaterm t1 t2 = (saveusubs();alphaterm t1 t2);

val REWRITEMASK = ref ~1;

fun rewriteterm t1 t (BoundVar(m1,n1)) =

if testalphaterm t1 (BoundVar(m1,n1))  then if (!REWRITEMASK)mod 2 = 1 then (
REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else(
(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2);

BoundVar(m1,n1)) else (resetusubs();BoundVar(m1,n1))

| rewriteterm  t1 t (Set(m1,n1,p)) = 

if testalphaterm t1 (Set(m1,n1,p)) then if (!REWRITEMASK)mod 2 = 1 then (REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2;

(NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));
NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));
let val BoundVar(r,N) = getnewbound(n1) in

Set(r,n1,rewriteprop t1 t (subsprop m1 n1 (BoundVar(r,n1)) p)) end))

else (resetusubs();NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));
NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));
let val BoundVar(r,N) = getnewbound(n1) in

Set(r,n1,rewriteprop t1 t (subsprop m1 n1 (BoundVar(r,n1)) p)) end)

| rewriteterm t1 t (Pair(x,y)) = 

if testalphaterm t1 (Pair(x,y)) then if (!REWRITEMASK)mod 2 = 1 then (REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2;



depair(Pair(rewriteterm t1 t x,rewriteterm t1 t y))) else
(resetusubs();depair(Pair(rewriteterm t1 t x,rewriteterm t1 t y)))

| rewriteterm t1 t (Proj1 x) = 

if testalphaterm t1 (Proj1 x) then if (!REWRITEMASK)mod 2 = 1 then (REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else

(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2;


deproj(Proj1 (rewriteterm t1 t x)))

else(resetusubs();


deproj(Proj1 (rewriteterm t1 t x)))

| rewriteterm t1 t (Proj2 x) = 
if testalphaterm t1 (Proj2 x) then if (!REWRITEMASK)mod 2 = 1 then (REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2;

deproj(Proj2 (rewriteterm t1 t x)))
else (resetusubs();deproj(Proj2 (rewriteterm t1 t x)))

| rewriteterm t1 t (DefTerm(s,L)) = 

if testalphaterm t1 (DefTerm(s,L)) then if (!REWRITEMASK)mod 2 = 1 then 
(REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2;


DefTerm(s,map (rewriteterm t1 t) L))

else (resetusubs();DefTerm(s,map (rewriteterm t1 t) L)) |

rewriteterm t1 t x =  

if testalphaterm t1 x then if (!REWRITEMASK)mod 2 = 1 then (REWRITEMASK:=(!REWRITEMASK) div 2 ;t) else(resetusubs();REWRITEMASK:=(!REWRITEMASK)div 2;


x  ) else (resetusubs();x)

and
   rewriteprop t1 t (PropVar (v, L)) = PropVar (v, (map (rewriteterm t1 t) L)) |

   rewriteprop t1 t (In(x,y)) = In(rewriteterm t1 t x,
                            rewriteterm t1 t y) |

   rewriteprop t1 t (Equals(x,y)) = Equals(rewriteterm t1 t x,
                            rewriteterm t1 t y) |

   rewriteprop t1 t (And(p,q)) = And(rewriteprop t1 t p,rewriteprop t1 t q) |

   rewriteprop t1 t (Or(p,q)) = Or(rewriteprop t1 t p,rewriteprop t1 t q) |

   rewriteprop t1 t (If(p,q)) = If(rewriteprop t1 t p,rewriteprop t1 t q) |
rewriteprop t1 t (ConvIf(p,q)) = ConvIf(rewriteprop t1 t p,rewriteprop t1 t q) |
   rewriteprop t1 t (Iff(p,q)) = Iff(rewriteprop t1 t p,rewriteprop t1 t q) |

   rewriteprop t1 t (Xor(p,q)) = Xor(rewriteprop t1 t p,rewriteprop t1 t q) |

   rewriteprop t1 t (Not(p)) = Not(rewriteprop t1 t p) |

   rewriteprop t1 t (All(m1,n1,p)) =

       (NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));

       let val BoundVar (r, N)  = getnewbound(n1) in

       All(r,n1,rewriteprop t1 t (subsprop m1 n1 (BoundVar (r,n1)) p))

       end) |

   rewriteprop t1 t (Some(m1,n1,p)) =

       (NEXTBOUND:=max((!NEXTBOUND),max(termboundindex t,max(m1,newboundindex p)));NEXTFREE:=max((!NEXTFREE),max(termfreeindex t,newfreeindex p));

       let val BoundVar (r, N) = getnewbound(n1) in

       Some(r,n1,rewriteprop t1 t(subsprop m1 n1 (BoundVar(r,n1)) p))

       end) |

   rewriteprop t1 t (DefProp(s,L)) = DefProp(s,map (rewriteterm t1 t) L) |

   rewriteprop t1 t (Parenthesis p) = Parenthesis (rewriteprop t1 t p)

fun toprewriteterm mask t1 t U = (savecounters();REWRITEMASK:=mask;let val T =
(NEXTBOUND:=0;rewriteterm t1 t U) in (getcounters();T) end);
fun toprewriteprop mask t1 t U = (savecounters();REWRITEMASK:=mask;let val T =
(NEXTBOUND:=0;rewriteprop t1 t U) in (getcounters();T) end);

(* is a free variable found in a term or prop? *)

fun freevarfoundp n (PropVar (m,L)) = 
    map (freevarfoundt n) L <> map (fn x=>false) L |

   freevarfoundp n (In(T,U)) = freevarfoundt n T orelse freevarfoundt n U |

   freevarfoundp n (Equals(T,U)) = freevarfoundt n T orelse freevarfoundt n U |

   freevarfoundp n (Not p) = freevarfoundp n p |

   freevarfoundp n (And(p,q)) = freevarfoundp n p orelse freevarfoundp n q | 
   freevarfoundp n (Or(p,q)) = freevarfoundp n p orelse freevarfoundp n q |
   freevarfoundp n (If(p,q)) = freevarfoundp n p orelse freevarfoundp n q |
   freevarfoundp n (ConvIf(p,q)) = freevarfoundp n p orelse freevarfoundp n q |
   freevarfoundp n (Xor(p,q)) = freevarfoundp n p orelse freevarfoundp n q |
   freevarfoundp n (Iff(p,q)) =  freevarfoundp n p orelse freevarfoundp n q |

   freevarfoundp n (All(r,s,p)) = freevarfoundp n p |
   freevarfoundp n (Some(r,s,p)) = freevarfoundp n p |


   freevarfoundp n (DefProp(s,L)) = 
       map (freevarfoundt n) L <> map (fn x=>false) L |

   freevarfoundp n (Parenthesis p) = freevarfoundp n p |

   freevarfoundp n p = false

and freevarfoundt n (FreeVar m) = m=n |

  freevarfoundt n (BoundVar (m,r)) = false |

  freevarfoundt n (Set(r,s,p)) = freevarfoundp n p |

  freevarfoundt n (Pair(T,U)) = freevarfoundt n T orelse freevarfoundt n U |

  freevarfoundt n (Proj1 T) = freevarfoundt n T |

  freevarfoundt n (Proj2 T) = freevarfoundt n T |

  freevarfoundt n (DefTerm(s,L)) = 

         map (freevarfoundt n) L <> map (fn x=>false) L |

  freevarfoundt n (Fake T) = freevarfoundt n T |

  freevarfoundt n t = false;


(* matching technology under construction *)

val TERMMATCHES = ref (nil:((Term*Term) list));

val PROPMATCHES = ref (nil:((Proposition*Proposition) list));

val CLASSMATCHES = ref (nil:((Proposition*Proposition) list));

fun thematchof x nil = nil |

thematchof x ((y,z)::L) = if x=y then [z] else thematchof x L;

(* matching needs to be made smarter about pairs *)

(* first, we need the correct matching for class variables *)

(* match to a proposition with fresh variables -- each time the template
is used, drop the matches to its variables? *)

(* Another idea:  class matches could be set explicitly? *)

fun item n nil = nil |

item 1 (a::L) = [a] |

item n (a::L) = item (n-1) L;

fun indexof a nil = 0 |

(* probably not a good place for automatic unknown rewriting *)

indexof a (b::L) = if (blockusubs();safealphaterm a b) 
then (unblockusubs();1) else (unblockusubs();let val I = indexof a L in
if I = 0 then 0 else I+1 end);

fun fixlist1 (x::L) (Pair(y,z)::M) = fixlist1 ((Proj1 x)::((Proj2 x)::L)) (y::(z::M)) |

fixlist1 (x::L) (y::M) = x::(fixlist1 L M) |

fixlist1 x y = nil;

fun fixlist2 (x::L) (Pair(y,z)::M) = fixlist2 ((Proj1 x)::(Proj2 x)::L) (y::z::M) |

fixlist2 (x::L) (y::M) = y::(fixlist2 L M) |

fixlist2 x y = nil;


(* n is the propositional variable index; p is the proposition being matched;
L is the argument list to the propositional variable index *)

fun classmatchleftargs nil = nil |

classmatchleftargs (a::L) = (getnewfree()::classmatchleftargs L);  

fun classmatchleft n L = PropVar(n,classmatchleftargs L);

(* we could make testsub pair-smart by a transformation of
the two lists whereby pairs in L2 cause the projections of the
corresponding items in L to be added to L *)


fun testsub x L2 L y = let val I = indexof x L in 
if I = 0 then y else hd(item I L2) end;  

(* this is really a simultaneous substitution function; its name is
confusing *)

fun classmatchterm L L2 (Pair(x,y)) = testsub (Pair(x,y)) L L2 
(Pair(classmatchterm L L2 x,classmatchterm L L2 y)) |

classmatchterm L L2 (Proj1 x) = testsub (Proj1 x) L L2 (Proj1 (classmatchterm L L2 x)) |
classmatchterm L L2 (Proj2 x) = testsub (Proj2 x) L L2 (Proj2 (classmatchterm L L2 x)) |

classmatchterm L L2 (Set(m1,n1,t1)) = let val V = getnewbound(~1) in

let val Set(m2,n2,t2) = substerm m1 n1 V (Set(m1,n1,t1)) in

testsub (Set(m2,n2,t2)) L L2 (Set(m2,n2,classmatchprop L L2 t2))

end 

end |

classmatchterm L L2 (DefTerm(s,M)) = 
testsub (DefTerm(s,M)) L L2 (DefTerm(s,map (classmatchterm L L2) M)) |

classmatchterm L L2 x = testsub x L L2 x

and classmatchprop L L2 (In(x,y)) = In(classmatchterm L L2 x,
classmatchterm L L2 y) |

classmatchprop L L2 (Equals(x,y)) = Equals(classmatchterm L L2 x,
classmatchterm L L2 y) |

classmatchprop L L2 (Not(p)) = (Not(classmatchprop L L2 p)) |
classmatchprop L L2 (Parenthesis(p)) = (Parenthesis(classmatchprop L L2 p)) |
classmatchprop L L2 (And(p,q)) =  
    (And(classmatchprop L L2 p,classmatchprop L L2 q)) |
classmatchprop L L2 (Or(p,q)) =  
    (Or(classmatchprop L L2 p,classmatchprop L L2 q)) |
classmatchprop L L2 (If(p,q)) =  
    (If(classmatchprop L L2 p,classmatchprop L L2 q)) |
classmatchprop L L2 (ConvIf(p,q)) =  
    (ConvIf(classmatchprop L L2 p,classmatchprop L L2 q)) |


classmatchprop L L2 (Iff(p,q)) = 
    (Iff(classmatchprop L L2 p,classmatchprop L L2 q)) |
classmatchprop L L2 (Xor(p,q)) =
    (Xor(classmatchprop L L2 p,classmatchprop L L2 q)) |
classmatchprop L L2 (All(m1,n1,t1)) =  let val V = getnewbound(~1) in

let val (All(m2,n2,t2)) = subsprop m1 n1 V (All(m1,n1,t1)) in

All(m2,n2,classmatchprop L L2 t2)

end

end |
classmatchprop L L2 (Some(m1,n1,t1)) =  let val V = getnewbound(~1) in

let val (Some(m2,n2,t2)) = subsprop m1 n1 V (Some(m1,n1,t1)) in

Some(m2,n2,classmatchprop L L2 t2)

end

end |

classmatchprop L L2 (PropVar (v,L3)) = PropVar(v,map (classmatchterm L L2) L3) |

classmatchprop L L2 (DefProp(s,M)) = DefProp(s,map (classmatchterm L L2) M) |

classmatchprop L L2 x = x;

fun topclassmatchterm L L2 x = (savecounters();let val A = 
(NEXTBOUND:=termboundindex(DefTerm("",L@L2));classmatchterm L L2 x) 
in (getcounters();A) end);

fun topclassmatchprop L L2 x = (savecounters();let val A = 
(NEXTBOUND:=newboundindex(DefProp("",L@L2));classmatchprop L L2 x) 
in (getcounters();A) end);

fun argsof (PropVar(v,L)) = L |

argsof x = nil;

fun classmatch n L p = let val LEFT = classmatchleft n L in
(LEFT,
topclassmatchprop (fixlist1 (argsof LEFT) L) (fixlist2 (argsof LEFT) L) p)  end;

(* this forces a class match "by hand" *)

fun forceclassmatch (PropVar(n,L)) p = CLASSMATCHES:=(classmatch n L p)::(!CLASSMATCHES) |

forceclassmatch x y = ();


(* the topclassmatchterm and topclassmatchprop functions are also usable by 
the definition facility; definitions will have lists of bound variables
(possibly typed) as arguments *)

val TERMDEFS = ref (nil:((string*(Term list* Term)) list));

val PROPDEFS = ref (nil:((string*(Term list*Proposition)) list));

val MAYBETERM = ref (nil:string list);

val MAYBEPROP = ref (nil:string list);


(* nonce free variable macro declarations *)

val ADEFS = ref (nil:((string*int)list));

val ADEFS2 = ref (nil:((int*string)list));

(* contains stratification information about defined operators *)

val STRATINFO = ref (nil:(string*(bool*(int list))) list);

(* precedence for binary functions *)

val PRECS = ref (nil:((string*int) list));

val MAXPREC = ref 0;

(* utilities for setting precedences for binary functions *)

fun prec s = (if find s (!PRECS) = nil then PRECS:=(s,0)::(!PRECS) else ();safefind 0 s (!PRECS));

fun isspecial c = #"!" = c orelse #"@" = c orelse #"#" = c  orelse #"$"
= c orelse #"^" = c orelse #"&" = c orelse #"*" = c orelse #"-" = c
orelse #"+" = c orelse #"=" = c orelse #":" = c orelse #";" = c orelse
#"<" = c orelse #">" = c orelse #"?" = c orelse #"/" = c orelse #"!" =
c orelse #"." = c orelse #"," = c orelse #"|" = c orelse #"~" = c
orelse c = #"`";

fun iscap c = (#"A" <= c andalso c <= #"Z");
fun isalpha c = #"a" <= c andalso c <= #"z";
fun isdigit c = #"0" <= c andalso c <= #"9";


fun decap c = if iscap c then  chr(ord c - ord (#"A") + ord (#"a")) else c;

fun cap c = if isalpha c then  chr(ord c - ord(#"a") + ord(#"A")) else c;

fun capitalize0 nil = nil |

capitalize0 (x::L) = (cap x::L);

fun capitalize s = implode(capitalize0(explode s));

(* device for fixing legacy definitions *)

fun lcapitalize0 ((#"*")::L) = 
if L <> nil andalso isalpha(hd L) then 
capitalize0 L else ((#"*")::L) |

lcapitalize0 ((#"#")::L) = 
if L <>nil andalso isalpha(hd L) then
capitalize0 L else ((#"#")::L) |

lcapitalize0 L = L;

fun lcapitalize s = implode(lcapitalize0 (explode s));

fun decapitalize0 nil = nil |

decapitalize0 (x::L) = (decap x::L);

fun decapitalize s = implode(decapitalize0(explode s));

fun setprec s n = 

(* if arity (decapitalize s) <> 2 then (Say "Cannot set arity of non-infix")

else *)

(PRECS:=(decapitalize s,n)::
(drop (decapitalize s) (!PRECS)); MAXPREC:=max(n,(!MAXPREC)));

fun pushprecs0 n nil = nil |

pushprecs0 n ((s,m)::L) = ((s,if m>=n then m+2 else m)::(pushprecs0 n L));

fun pushprecs n = PRECS:=pushprecs0 n (!PRECS);

fun evenabove n = n+1+(1-n mod 2);

fun evenbelow n = n-1-(1-n mod 2);

fun oddabove n = n+1+(n mod 2);

fun oddbelow n = n-1-(n mod 2);




(* snapshots of the definition lists taken when 
theorems were proved *)

val SAVEDDEFS = ref [("bogus",(!TERMDEFS,!PROPDEFS,!STRATINFO))];

val _ = SAVEDDEFS:=nil;

(* more list utilities *)

fun compatible nil L = true |

  compatible ((s,x)::L) M = if find s M = nil then

     compatible L M else if hd(find s M) = x then compatible L M

     else false;

fun union nil M = M |

   union (n::L) M = if foundin n M then union L M else (n::(union L M));

fun p1(x,y,z) = x; fun p2(x,y,z) =y;fun p3(x,y,z)=z;

fun checksaveddefs s = if find s (!SAVEDDEFS) = nil
  then (say "Saved definition info not found";false)
  else if compatible (p1(hd(find s (!SAVEDDEFS)))) (!TERMDEFS)
  andalso compatible (p2(hd(find s (!SAVEDDEFS)))) (!PROPDEFS)
  andalso compatible (p3(hd(find s (!SAVEDDEFS)))) (!STRATINFO)

then (TERMDEFS:= union (p1(hd(find s (!SAVEDDEFS)))) (!TERMDEFS);
PROPDEFS:= union (p2(hd(find s (!SAVEDDEFS)))) (!PROPDEFS);
STRATINFO:= union (p3(hd(find s (!SAVEDDEFS)))) (!STRATINFO);
true)

else (say "Saved definitions are incompatible with current definitions";false);

(* utility for reading defined names *)
(*
fun isalpha #"a" = true |
isalpha #"b" = true |isalpha #"c" = true |isalpha #"d" = true |
isalpha #"e" = true | isalpha #"f" = true |isalpha #"g" = true |isalpha #"h" = true |isalpha #"i" = true |isalpha #"j" = true |isalpha #"k" = true |isalpha #"l" = true |isalpha #"m" = true |isalpha #"n" = true |isalpha #"o" = true |isalpha #"p" = true |isalpha #"q" = true |isalpha #"r" = true |isalpha #"s" = true |isalpha #"t" = true |isalpha #"u" = true |isalpha #"v" = true |isalpha #"w" = true |isalpha #"x" = true |isalpha #"y" = true |isalpha #"z" = true |isalpha x=false;
*)

(* keywords and keyword combinations to be ignored by preparser *)

fun keyword s = s = "&" orelse s = "->" orelse s = "==" orelse s = "=/=" orelse s = "<-" orelse
s = "&~" orelse s = "->~" orelse s = "==~" orelse s = "=/=~" orelse s = "<-~"
orelse s = "&#" orelse s = "->#" orelse s = "==#" orelse s = "=/=#" orelse s = "<-#" orelse
s = "&~#" orelse s = "->~#" orelse s = "==~#" orelse s = "=/=~#" orelse s = "<-~#"
orelse s = "&*" orelse s = "->*" orelse s = "==*" orelse s = "=/=*" orelse s = "<-*" orelse
s = "&~*" orelse s = "->~*" orelse s = "==~*" orelse s = "=/=~*" orelse s = "<-~*"

orelse s = "." orelse s = ".~" orelse s = ".#" orelse s = ".~#" orelse s = ".*"
orelse s = ".~*"
orelse s = "|" orelse s = "|~" orelse s = "|#" orelse s = "|~#" orelse s = "|*"
orelse s = "|~*"


orelse s = "," orelse s = ",*"

orelse s = "=" orelse s = "=*"

(* I have to guard ordered pair notation! -- or not*)

(* orelse s = "<" orelse s = "<*" orelse s = ">," orelse s = ">,*"
orelse s = ">=" orelse s = ">=*" *)
;

(* alphabetic strings cannot end with "v" nor may they contain
"va" or "vx" in order to avoid ambiguities with the disjunction operator NOT TRUE ANY MORE *)


(* fun getalpha0 nil = nil | *)

(* getalpha0 (#"v"::L) = if L = nil

   orelse getalpha0 L = nil

   orelse getalpha0 L = [#"a"]

   orelse getalpha0 L = [#"p"]

   orelse getalpha0 L = [#"x"]

   then nil else #"v"::(getalpha0 L) | *)

fun getspecial0 nil = nil | getspecial0 (x::L) = if isspecial x
    then (x::((getspecial0 L))) else nil;

fun restspecial1 nil = nil |  restspecial1 (x::L) = if isspecial x
then restspecial1 L else (x::L);

fun getalpha1 nil = nil |

   getalpha1 (x::L) = if isalpha x then x::(getalpha1 L) else nil;

fun restalpha1 nil = nil |

   restalpha1 (x::L) = if isalpha x then restalpha1 L else (x::L);

fun getalpha0 nil = nil |

getalpha0 (x::L) = if isalpha x then x::(getalpha1 L) else 

if isspecial x then x::(getspecial0 L) else

nil;

fun getalpha L = implode(getalpha0 L);

fun despace nil = nil |

    despace ((#" ")::L) = despace L |

    despace L = L;

fun restalpha0 nil = nil |

(* restalpha (#"v"::L) = if L = nil orelse

   getalpha0 L = nil

   orelse getalpha0 L = [#"x"]

   orelse getalpha0 L = [#"a"]

   orelse getalpha0 L = [#"p"] then (#"v"::L)

   else restalpha L | *)

restalpha0 (x::L) = if isalpha x then restalpha1 L 
                    else if isspecial x then restspecial1 L
                    else x::L; 

fun restalpha L = despace(restalpha0 L);

(* very simple preprocessor -- only processes declared stuff *)

fun strip (#" "::L) = strip L |

(* guard quantifiers *)

    strip ((#"(")::(#"A")::(#"x")::c::L) =

        if isdigit c then ((#"(")::(#"A")::(#"x")::c::(strip L))

        else ((#"(")::(strip((#"A")::(#"x")::c::L)))|
    strip ((#"(")::(#"E")::(#"x")::c::L) =

        if isdigit c then ((#"(")::(#"E")::(#"x")::c::(strip L))

        else ((#"(")::(strip((#"E")::(#"x")::c::L)))|

(* convert declared capitalized identifiers to the correct forms *)

    strip (p::L) = 

(* additional condition protects P1... and projected U1... *)

(*clause to protect legacy defined terms *)

 (*   if p = #"*" orelse p = #"#" andalso (L<>nil andalso isalpha(hd L))
    then [p]@(getalpha0 L)@(strip(restalpha0 L)) *)

(* additional condition protects P1... and projected U1... *)


    if (iscap p andalso (L = nil orelse not(isdigit(hd L))))
  
    orelse isspecial p

    then let val A = getalpha ((decap p)::L) in

(* guard the membership symbol *)

    if A = "e" orelse A = "ex" orelse A = "ea" orelse A = "ep"

    then p::(strip L)

    else if keyword A

    then (explode A)@(strip(restalpha((decap p)::L)))

    else if find (A) (!ADEFS) <> nil then 

    (if hd(find A (!ADEFS)) < 0 then [#"U"] else[#"a"])
    @(explode(makestring(hd(find A (!ADEFS)))))
    @(strip(restalpha((decap p)::L)))


       else if (find A (!PROPDEFS) <> nil 
       orelse foundin A (!MAYBEPROP))
       then [#"#"]@(explode A)@[#" "]@(strip(restalpha((decap p)::L)))

       else if (find A (!TERMDEFS) <> nil 
       orelse foundin A (!MAYBETERM))
       then [#"*"]@(explode A)@[#" "]@(strip(restalpha((decap p)::L)))

       else p::(strip L) end

    else p::(strip L) |

    strip nil = nil;


fun isboundvarlist nil = true |

isboundvarlist ((BoundVar(m,n))::L) = isboundvarlist L |

isboundvarlist (x::L) = false;



fun uniquelist nil = true |

uniquelist (x::L) = not(foundin x L) andalso uniquelist L;

(* functions that check for correct left sides for definitions
of propositions and terms *)

fun isdefpropleft (DefProp(s,L)) = s <> "" andalso s = getalpha(explode s)

andalso isboundvarlist L andalso uniquelist L

andalso find s (!PROPDEFS) = nil andalso find s (!TERMDEFS) = nil 

andalso find s (!ADEFS) = nil |

isdefpropleft x = false;

fun isdeftermleft (DefTerm(s,L)) = s <> "" andalso s = getalpha(explode s)

andalso isboundvarlist L andalso uniquelist L

andalso find s (!TERMDEFS) = nil andalso find s (!PROPDEFS) = nil 

andalso find s (!ADEFS) = nil |

isdeftermleft x = false;

(* functions to check definedness of defined notions appearing in
propositions and terms *)

(* now also detects parse errors *)

fun alldefinedterm (Set(m,n,p)) = alldefinedprop p |

alldefinedterm (Pair(x,y)) = alldefinedterm x andalso alldefinedterm y |

alldefinedterm (Proj1 x) = alldefinedterm x |

alldefinedterm (Proj2 x) = alldefinedterm x |

alldefinedterm (DefTerm(s,L)) = find s (!TERMDEFS) <> nil andalso
map alldefinedterm L = map (fn x=>true) L |

alldefinedterm (FreeVar n) = n>0 |

alldefinedterm x = true

and alldefinedprop (In(x,y)) = alldefinedterm x andalso alldefinedterm y |

alldefinedprop (Equals(x,y)) = alldefinedterm x andalso alldefinedterm y |

alldefinedprop (Not p) = alldefinedprop p |

alldefinedprop (Parenthesis p) = alldefinedprop p |

alldefinedprop (And(p,q)) = alldefinedprop p andalso alldefinedprop q |  

alldefinedprop (Or(p,q)) = alldefinedprop p andalso alldefinedprop q |  

alldefinedprop (If(p,q)) = alldefinedprop p andalso alldefinedprop q |  
alldefinedprop (ConvIf(p,q)) = alldefinedprop p andalso alldefinedprop q |
alldefinedprop (Iff(p,q)) = alldefinedprop p andalso alldefinedprop q |  

alldefinedprop (Xor(p,q)) = alldefinedprop p andalso alldefinedprop q | 

alldefinedprop (All(m,n,p)) = alldefinedprop p |

alldefinedprop (Some(m,n,p)) = alldefinedprop p |

alldefinedprop (DefProp(s,L)) = find s (!PROPDEFS) <> nil
andalso map alldefinedterm L = map (fn x => true) L |

alldefinedprop (PropVar(~1,nil)) = false |

alldefinedprop p = true; 

fun primitivepropdefform (DefProp(s,L)) (DefProp(t,M)) = 
    s=t andalso length L = length M |

    primitivepropdefform x y = false; 
fun primitivetermdefform (DefTerm(s,L)) (DefTerm(t,M)) = 
    s=t andalso length L = length M |

    primitivetermdefform x y = false; 

fun p2(x,y) = y;

fun usepropdef (DefProp(s,L)) = let val S = find s (!PROPDEFS) in

if S = nil orelse primitivepropdefform (DefProp(s,L)) (p2(hd S)) then DefProp(s,L)

else let val (args,defright) = hd S in

if length(args) <> length L then DefProp(s,L) else

(NEXTFREE:=max((!NEXTFREE),newfreeindex defright);NEXTBOUND:=
max(newboundindex(DefProp(s,L)),
max((!NEXTBOUND),
max(newboundindex (DefProp(s,args)),newboundindex defright)));
topclassmatchprop (fixlist1 L args) (fixlist2 L args) defright)

end end |usepropdef x = x;

fun usetermdef (DefTerm(s,L)) = let val S = find s (!TERMDEFS) in

if S = nil orelse primitivetermdefform (DefTerm(s,L)) (p2 (hd S)) then DefTerm(s,L)

else let val (args,defright) = hd S in

if length args <> length L then (DefTerm(s,L)) else

(NEXTFREE:=max((!NEXTFREE),termfreeindex defright);NEXTBOUND:=
max(termboundindex(DefTerm(s,L)),max((!NEXTBOUND),
max(termboundindex (DefTerm(s,args)),termboundindex defright)));
topclassmatchterm (fixlist1 L args) (fixlist2 L args) defright)

end end | usetermdef x = x;

fun dropfromlist t nil = nil |

dropfromlist t ((u,v)::L) = if (blockusubs();safealphaterm t u) 
then (unblockusubs();L) 
else (unblockusubs();(u,v)::(dropfromlist t L));

fun clearmatches nil = () |

clearmatches (t::L) = (TERMMATCHES:=dropfromlist t (!TERMMATCHES);clearmatches L);


fun findclassmatch0 n nil = nil |

findclassmatch0 n ((PropVar (m,L),x)::M) = if m=n then [(PropVar(m,L),x)]
else findclassmatch0 n M |

findclassmatch0 n (x::M) = findclassmatch0 n M;

fun isprojvar (BoundVar(m,n)) = true |

isprojvar (FreeVar n) = true |

isprojvar (Proj1 x) = isprojvar x |

isprojvar (Proj2 x) = isprojvar x |

isprojvar(Fake(Proj1 x)) = isprojvar x |

isprojvar(Fake(Proj2 x)) = isprojvar x |

isprojvar x = false;

fun defake (Fake(Proj1 x)) = Proj1 (defake x) |

defake (Fake(Proj2 x)) = Proj2 (defake x) |

defake x = x;

fun projlist (Proj1 x) = (x::(projlist x)) |

projlist (Proj2 x) = (x::(projlist x)) |

projlist x = nil;

fun unknownindex (FreeVar n) = ~n |

unknownindex x = ~1;

(* new clause in termmatches needed to handle anything matching an
unknown variable?  Maybe such matches just have to be handled manually. *)

(*

The automation of unknown assignment automation is bad because unknown
assignments are made which involve reversals of index!  So fireusubs
needs to be written differently.

*)

fun termmatches (FreeVar m) (FreeVar n) =

    if n<0 then 
  let val M = thematchof(FreeVar m)(!TERMMATCHES) in
  if M=nil then
  (TERMMATCHES:=(FreeVar m,FreeVar n)::(!TERMMATCHES);true) else 
   alphaterm (FreeVar n) (hd M) end

else let val t = FreeVar n in
let val M = thematchof (FreeVar m) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (FreeVar m,defake t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm (defake t) T 

end end end |

 termmatches (BoundVar (m,n)) (FreeVar p) = 

    if p<0 then 
  let val M = thematchof(BoundVar(m,n))(!TERMMATCHES) in
  if M=nil then
  (TERMMATCHES:=(BoundVar(m,n),FreeVar p)::(!TERMMATCHES);true) else 
   alphaterm (FreeVar p) (hd M) end

else let val t = FreeVar p in

 let val M=thematchof (BoundVar (m,n)) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (BoundVar(m,n),(defake t))::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T 

end end end |

termmatches (Pair(x,y)) (FreeVar n) =
    if n<0 then 
    let val t = (Pair(x,y)) in
    let val T = anonymizeterm (defake t) in

    if find (~n) (!USUBS) = nil
    orelse alphaterm (hd(find (~n)(!USUBS))) (T)

    then (USUBS:=(~n,T)::(drop (~n) (!USUBS));
    termmatches t T) else false

    end end

    else let val z = FreeVar n in
termmatches (Pair(x,y)) (Pair(Proj1(z),Proj2(z))) end

    |

termmatches (Fake(Proj1 x)) (FreeVar n) =

    if n<0 then let val t = (Fake(Proj1 x)) in 

    let val T = anonymizeterm (defake t) in

    if find (~n) (!USUBS) = nil
    orelse alphaterm (hd(find (~n)(!USUBS))) (T)

    then (USUBS:=(~n,T)::(drop (~n) (!USUBS));
    termmatches t T) else false

    end end else
let val t = FreeVar n in
isprojvar (Proj1 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj1 (defake x)))

= map (fn y=> nil) (projlist (Proj1 (defake x)))

andalso let val M = thematchof (Proj1 (defake x)) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj1 (defake x),t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end end |

termmatches (Fake(Proj2 x)) (FreeVar n) =

    if n<0 then 

    let val t = (Fake(Proj2 x))in
    let val T = anonymizeterm (defake t) in

    if find (~n) (!USUBS) = nil
    orelse alphaterm (hd(find (~n)(!USUBS))) (T)

    then (USUBS:=(~n,T)::(drop (~n) (!USUBS));
    termmatches t T) else false

    end end else
let val t = FreeVar n in 
isprojvar (Proj2 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj2 (defake x)))

= map (fn y=> nil) (projlist (Proj2 (defake x)))

andalso let val M = thematchof (Proj2 (defake x)) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj2 (defake x),t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end end |
termmatches (Proj1 x) (FreeVar n) = 

    if n<0 then 
    let val t = Proj1 x in
    let val T = anonymizeterm (defake t) in

    if find (~n) (!USUBS) = nil
    orelse alphaterm (hd(find (~n)(!USUBS))) (T)

    then (USUBS:=(~n,T)::(drop (~n) (!USUBS));
    termmatches t T) else false

    end end else
let val t = FreeVar n in
isprojvar (Proj1 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj1 x))

= map (fn y=> nil) (projlist (Proj1 x))

andalso let val M = thematchof (Proj1 x) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj1 x,t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end end |

termmatches (Proj2 x) (FreeVar n) = 

    if n<0 then let val t = Proj2 x in

    let val T = anonymizeterm (defake t) in

    if find (~n) (!USUBS) = nil
    orelse alphaterm (hd(find (~n)(!USUBS))) (T)

    then (USUBS:=(~n,T)::(drop (~n) (!USUBS));
    termmatches t T) else false

    end end else
let val t = FreeVar n in 
isprojvar (Proj2 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj2 x))

= map (fn y=> nil) (projlist (Proj2 x))

andalso let val M = thematchof (Proj2 x) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj2 x,t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end end |


termmatches t (FreeVar n) =

    if n<0 then let val T = anonymizeterm (defake t) in

    if find (~n) (!USUBS) = nil
    orelse alphaterm (hd(find (~n)(!USUBS))) (T)

    then (USUBS:=(~n,T)::(drop (~n) (!USUBS));
    termmatches t T) else false

    end else false
|

termmatches (Pair(x,y)) (Pair(z,w)) = termmatches x z andalso
termmatches y w |

termmatches t (Pair(x,y)) = termmatches (Fake(Proj1 t)) x andalso termmatches
(Fake(Proj2 t)) y | 

termmatches (Pair(x,y)) z = termmatches (Pair(x,y)) (Pair(Proj1(z),Proj2(z))) |

termmatches (FreeVar n) t = 

let val M = thematchof (FreeVar n) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (FreeVar n,defake t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm (defake t) T 

end end |

 termmatches (BoundVar (m,n)) t = let val M=thematchof (BoundVar (m,n)) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (BoundVar(m,n),t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T 

end end |

termmatches (Proj1 x) (Proj1 y) = termmatches x y |

termmatches (Proj2 x) (Proj2 y) =  termmatches x y |

termmatches (Fake(Proj1 x)) t =

isprojvar (Proj1 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj1 (defake x)))

= map (fn y=> nil) (projlist (Proj1 (defake x)))

andalso let val M = thematchof (Proj1 (defake x)) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj1 (defake x),t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end |

termmatches (Fake(Proj2 x)) t =
isprojvar (Proj2 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj2 (defake x)))

= map (fn y=> nil) (projlist (Proj2 (defake x)))

andalso let val M = thematchof (Proj2 (defake x)) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj2 (defake x),t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end |
termmatches (Proj1 x) t = isprojvar (Proj1 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj1 x))

= map (fn y=> nil) (projlist (Proj1 x))

andalso let val M = thematchof (Proj1 x) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj1 x,t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end|

termmatches (Proj2 x) t = isprojvar (Proj2 x)

andalso map (fn y=>thematchof y (!TERMMATCHES)) (projlist (Proj2 x))

= map (fn y=> nil) (projlist (Proj2 x))

andalso let val M = thematchof (Proj2 x) (!TERMMATCHES) in

if M = nil then (TERMMATCHES := (Proj2 x,t)::(!TERMMATCHES);true)

else let val [T] = M in alphaterm t T

end end |
(*
termmatches (Set(m1,n1,t1)) (Set(m2,n2,t2)) =

let val FreeVar n = getnewfree() in

propmatches (topsubsprop m1 n1 (FreeVar n) t1) (topsubsprop m2 n2 (FreeVar n) t2) 

end |*)

termmatches (Set(m1,n1,t1)) (Set(m2,n2,t2)) =

let val FreeVar n = getnewfree() in

propmatches (topsubsprop m1 n1 (FreeVar n) t1) 
  (topsubsprop m2 n2 (FreeVar n) t2) 

   andalso (TERMMATCHES:=dropfromlist (FreeVar n) (!TERMMATCHES);

   map (fn (x,y)=>freevarfoundt n y) (!TERMMATCHES) = 
    map (fn (x,y)=>false) (!TERMMATCHES) 

   andalso map (fn (x,y)=>freevarfoundp n y) (!PROPMATCHES) = map (fn (x,y)=>false) 
   (!PROPMATCHES))

end |


termmatches (DefTerm(s,L)) (DefTerm(t,M)) = s=t andalso termlistmatches L M |

termmatches (DefTerm(s,L)) x = 

if usetermdef(DefTerm(s,L)) = DefTerm(s,L) then false else

termmatches (usetermdef(DefTerm(s,L))) x |

termmatches x (DefTerm(s,L)) = 

if usetermdef(DefTerm(s,L)) = DefTerm(s,L) then false

else termmatches x (usetermdef(DefTerm(s,L))) |

termmatches x y = false

and termlistmatches nil nil = true |

termlistmatches (t1::L1) (t2::L2) = termmatches t1 t2 andalso termlistmatches L1 L2 |

termlistmatches x y = false

and propmatches (PropVar(v,nil)) P = let val M = thematchof (PropVar(v,nil)) (!PROPMATCHES) in

if M = nil then (PROPMATCHES:=(PropVar(v,nil),P)::(!PROPMATCHES);true)

else let val [P2] = M in alphaprop P P2

end end |   

(* matching for class variables eventually needs to be much smarter! *)

(* I'm still not certain of the dynamics
of class matching when a class symbol is applied to arguments containing
the same class symbol and this is matched *)

(* I think it is OK *)

(* for matching of a class symbol to work, all its formal parameters must actually
appear in its "definition".  This means that matching will not work if
the first appearance of a class symbol has any repeated arguments. *)

propmatches (PropVar(v1,L1)) p = let val M1 = findclassmatch0 v1 (!CLASSMATCHES)

in let val M = if M1 <> nil then M1 else findclassmatch0 v1 (!PROPMATCHES) in 

if M = nil then

(* something is needed here to stipulate that every variable
appearing in L1 has a match in TERMMATCHES -- the termlistmatches
L1 L2 does this. *)

let val L2 = (map (topclassmatchterm (map (fn (x,y)=>y) (!TERMMATCHES)) (map (fn (x,y)=> x) (!TERMMATCHES))) L1) in

(PROPMATCHES := (classmatch v1 L2 p)::(!PROPMATCHES);
termlistmatches L1 L2;
true) end

else let val [(PropVar(n,L),P)] = M in if length L <> length L1 then false else


propmatches P p andalso 
map (fn x=>thematchof x (!TERMMATCHES) = nil) L = map (fn x=> false) L 

andalso
let val Q = 
(map (fn x=>hd(thematchof x (!TERMMATCHES))) L )

in (clearmatches L;termlistmatches (map (topclassmatchterm (map (fn (x,y)=>y) (!TERMMATCHES)) (map (fn (x,y)=> x) (!TERMMATCHES))) L1)

 Q) end

end end

end |

propmatches (In(t1,u1)) (In(t2,u2)) = termmatches t1 t2 andalso termmatches u1 u2 |

propmatches (Equals(t1,u1)) (Equals(t2,u2)) = termmatches t1 t2 andalso termmatches u1 u2 |

propmatches (And(p1,q1)) (And(p2,q2)) = propmatches p1 p2 andalso propmatches q1 q2 |

propmatches (Or(p1,q1)) (Or(p2,q2)) = propmatches p1 p2 andalso propmatches q1 q2 |

propmatches (If(p1,q1)) (If(p2,q2)) = propmatches p1 p2 andalso propmatches q1 q2 |
propmatches (ConvIf(p1,q1)) (ConvIf(p2,q2)) = propmatches p1 p2 andalso propmatches q1 q2 |

propmatches (Iff(p1,q1)) (Iff(p2,q2)) = propmatches p1 p2 andalso propmatches q1 q2 |

propmatches (Xor(p1,q1)) (Xor(p2,q2)) = propmatches p1 p2 andalso propmatches q1 q2 |

propmatches (Not(p1)) (Not(p2)) = propmatches p1 p2 |

propmatches (Parenthesis(p1)) (Parenthesis(p2)) = propmatches p1 p2 |

propmatches (All(m1,n1,p1)) (All(m2,n2,p2)) = termmatches (Set(m1,n1,p1)) (Set(m2,n2,p2)) |

propmatches (Some(m1,n1,p1)) (Some(m2,n2,p2)) = termmatches (Set(m1,n1,p1)) (Set(m2,n2,p2)) |

propmatches (DefProp(s,L)) (DefProp(t,M)) = s=t andalso termlistmatches L M |

propmatches (DefProp(s,L)) x = 

if usepropdef(DefProp(s,L)) = DefProp(s,L) then false else

propmatches (usepropdef(DefProp(s,L))) x |

propmatches x (DefProp(s,L)) = propmatches x (usepropdef(DefProp(s,L))) |

propmatches x y = false;

fun safetermmatches x y = (TERMMATCHES:=nil;PROPMATCHES:=nil;
savecounters();
let val T = termmatches x y in (getcounters();
(* CLASSMATCHES:=nil; *) T) end); 
fun safepropmatches x y = (TERMMATCHES:=nil;PROPMATCHES:=nil;
savecounters();
let val T = propmatches x y in (getcounters();
CLASSMATCHES:=nil;T) end); 


(* a sequent is a pair of lists of propositions (left and right sides of |-) *)

(* AUTOPRUNE UPDATE:  it is now a list of pairs of propositions
and lists of integers (the genealogy of the associated proposition) *)

datatype Sequent = 
Seq of ((Proposition*(int list)) list)*((Proposition*(int list)) list);

(* for autopruning, we need this to be a list of pairs of
propositions with lists of integers? *)

(* sequent matching under construction *)

(* this function matches a sequent (presumably from the theorems list)
against a chosen subsequent (indicated by lists of propositions to be
taken from the left and right parts of the sequent in a given order --
this is the function of the two arguments which are lists of integers) *)

fun p1 (x,y) = x;

fun leftitem n (Seq(L,M)) = item n L;

fun rightitem n (Seq(L,M)) = item n M;

(* this handles the issue of whether all components of theorem
are used: if anything is left over, of course the theorem does
not apply! *)

fun seqmatch nil nil (Seq(nil,nil)) (Seq(L2,M2)) = true |

seqmatch nil (a::L) (Seq(L1,((s,g):: M1))) (Seq(L2,M2)) =

if item a M2 = nil then false

else let val [(I,J)] = item a M2 in propmatches s I 
andalso seqmatch nil L (Seq(L1,M1)) (Seq(L2,M2)) end |

seqmatch (a::L) M (Seq(((s,g)::L1),M1)) (Seq(L2,M2)) = 

if item a L2 = nil then false

else let val [(I,J)] = item a L2 in propmatches s I
andalso seqmatch L M (Seq(L1,M1)) (Seq(L2,M2)) end |

seqmatch a b x y = false;

fun safeseqmatch x y z w= (TERMMATCHES:=nil;PROPMATCHES:=nil;
savecounters();
let val M = seqmatch x y z w in (getcounters();
CLASSMATCHES:=nil;M) end);

(* match conclusions first *)

fun revseqmatch x y z w = safeseqmatch y x w z;

(* a proof is a finitely branching tree of sequents -- a Goal node
is an unproved leaf (a proved leaf has a null list of proofs above it) *)

datatype Proof = Node of int*Sequent*(Proof list) | Goal of int*Sequent

  | ProofReference of string;

fun lineno (Node(n,s,L)) = n |

   lineno (Goal(n,s)) = n |

   lineno x = 0;

fun bubble0 (x::(y::L)) = if lineno y < lineno x then

   y::(bubble0(x::L))

   else x::(bubble0(y::L)) |

   bubble0 x = x;

fun bubble x = let val A = bubble0 x in if A = x then x else bubble A end;

val BUBBLES = ref true;

(* tool for sorting USUBS into _descending_ order *)

fun uitem (n,t) = n;

fun ububble0 (x::(y::L)) = if uitem y > uitem x then

   y::(ububble0(x::L))

   else x::(ububble0(y::L)) |

   ububble0 x = x;

fun ububble x = let val A = ububble0 x in if A = x then x else ububble A end;

fun ububbles() = USUBS := ububble (!USUBS);

(* use nobubbles for legacy proofs -- may not be needed *)

fun nobubbles() = BUBBLES:=false;

fun bubbles (Node(n,s,L)) = 

if (!BUBBLES) then Node(n,s,bubble (map bubbles L))
else Node(n,s,L) |

   bubbles x = x;

(* the master list of proved sequents with their proofs *)

(* one needs to add lists of lemmas and definitions to saved theorems *)
(* note that lists of lemmas are not needed, due to the new machinery
of theorem-labelled lemmas. *)

val THEOREMS = ref(nil:((string*Proof) list));

(* the list of axiom names is maintained for security:
an axiom cannot be modified *)

val AXIOMS = ref(nil:(string list));

(* lemmas currently in use which cannot be modified *)

val CURRENTLEMMAS = ref (nil:string list);

(* reference cell containing the proof in progress *)

val THEPROOF = ref (Goal (0,Seq([],[])));

val REMEMBER = ref true;

val PROOFS = ref [!THEPROOF];

val PROOFS2 = ref [!THEPROOF];


(* other current proofs in progress *)

val SAVEDPROOFS =  ref [("bogus",(0,0,!TERMDEFS,!PROPDEFS,!STRATINFO,!THEPROOF))];

val _ = SAVEDPROOFS:=nil;

fun thesequent (Node(n,s,p)) = s |

   thesequent (Goal(n,s)) = s |

   thesequent (ProofReference s) = if find s (!THEOREMS) = nil
   then (Say "Theorem reference error";Seq(nil,nil))
   else thesequent (hd(find s (!THEOREMS)));

(* utilities for manipulation of theorem names:  theorem names with periods
in them have special meaning. *)

fun prefixof1 nil = nil |

prefixof1 (#"."::L) = nil |

prefixof1 (x::L) = (x::(prefixof1 L));

fun prefixof s = implode(prefixof1 (explode s));

fun hasprefix s = prefixof s <> s;

fun attachprefix p s = if s = "" then "" else if p = "" then s else p^"."^s;

fun deprefix0 nil = nil |

deprefix0 (#"."::L) = L |

deprefix0 (x::L) = deprefix0 L;

fun deprefix s = implode(deprefix0 (explode s));

fun stringreverse s = implode(rev(explode s));

(* this shortens the prefix of s at the end *)

fun shortenprefix s =

if not(hasprefix s) then s

else attachprefix (stringreverse(deprefix(deprefix(stringreverse s))))

(stringreverse(prefixof(stringreverse s)));

(* deletes items with s as key and all items with s as a prefix
to their key from a table *)

(* these would behave oddly if some subtheorems were present without
their parent *)

(* list of locked theorems which cannot be changed and are not
reduplicated in saved lemmas *)

val LOCKED = ref (nil:(string list));

fun islocked s = foundin s (!LOCKED);

fun safedelete s nil = nil |

safedelete s ((u,v)::L) = 

   if find s ((u,v)::L) = nil then ((u,v)::L) else

   if (foundin s (!CURRENTLEMMAS) orelse foundin s (!AXIOMS)
   orelse foundin s (!LOCKED))
   then (Say ("Cannot change axiom, current lemma or locked theorem "^s);
      ((u,v)::L))

   else if prefixof u = s then safedelete s L

   else (u,v)::(safedelete s L);

(* adds an item t with s as key after deleting anything with
s as key or a key with s as prefix *)

fun safeadd s t L = if find s L <> nil

    andalso (foundin s (!CURRENTLEMMAS) orelse foundin s (!AXIOMS)
    orelse foundin s (!LOCKED))

    then (Say ("Cannot change axiom, current lemma or locked theorem "^s);L)

    else let val A = (s,t)::(safedelete s L)
    in (CURRENTLEMMAS:=s::(!CURRENTLEMMAS);A) end;

(* copy everything with s as prefix with an additional prefix p *)

(* this checks for the existence of simpler names for the same
thing *)


(* is q redundant, given p with the same data? *)

(* this should be a full redundancy checker *)

fun isredundant p q = hasprefix p andalso hasprefix q
andalso prefixof p = prefixof q
andalso hasprefix(deprefix(stringreverse q))
andalso (let val q2 = attachprefix (stringreverse(deprefix(deprefix(stringreverse q))))
(stringreverse(prefixof(stringreverse q))) in p=q2 
orelse isredundant p q2 orelse 
isredundant (stringreverse(deprefix(stringreverse p)))
(stringreverse(deprefix(stringreverse q))) end);

fun addcarefully u v nil = [(u,v)] |

   addcarefully u v ((w,x)::L) =

      if isredundant w u andalso x=v then ((w,x)::L)

      else if isredundant u w andalso x=v then 

          addcarefully u v L

      else ((w,x)::(addcarefully u v L)); 

fun addprefix1 p s nil = nil |

(* try not to add A.B.C if A.C already exists *)

(* we don't want to add p.u if p.u' exists with u' a tail of u
and the data with p.u' is the same *)

(* also get rid of things of the form p.q.u which appear after
p.u is added *)


addprefix1 p s ((u,v)::L) =

let val M = addprefix1 p s L in

if prefixof u = s 

then addcarefully (attachprefix p u) v ((u,v)::M)
else ((u,v)::(M)) end;

fun addprefix p s L =  addprefix1 p s (safedelete (attachprefix p s) L);

(* pop out everything with prefix s to top level *)

fun openprefix s nil = nil |

   openprefix s ((t,u)::L) =

   if hasprefix t andalso prefixof t = s then

   safeadd (deprefix t) u ((t,u)::(openprefix s L))

   else (t,u)::(openprefix s L);

fun prelength1 nil = 0 |

   prelength1 (#"\n"::L) = 0 |

   prelength1 (c::L) = 1+prelength1 L;

fun prelength s = prelength1(explode s);

fun postlength s = prelength1(rev(explode s));

val MARGIN = ref 50;

val CURSOR = ref 0;

fun cursordisplay s = if (!CURSOR) + prelength s > (!MARGIN)

then (CURSOR:=postlength ("\n     "^s);"\n     "^s )

else (CURSOR:=(!CURSOR)+postlength s;s);

(* display function -- this could be used as a description of the syntax *)

fun stickiness (And(x,y)) = 5 |

stickiness (Or(x,y)) = 4 |

stickiness (If(x,y)) = 3 |
stickiness (ConvIf(x,y)) = 3 |
stickiness (Iff(x,y)) = 2 |

stickiness (Xor(x,y)) = 2 |

stickiness p = 6;

fun termleftstickiness (DefTerm(s,[T,U])) = (2*prec s)+((prec s)mod 2) |

termleftstickiness x = 2*(!MAXPREC)+1;

fun termrightstickiness (DefTerm(s,[T,U])) = 
   (2*prec s)+(1-(((prec s) mod 2))) |

termrightstickiness x = 2*(!MAXPREC)+1;

fun propdisplay (PropVar (n, nil)) = "P"^(makestring n) |

   (* a propositional variable (nullary predicate variable) is of the form P<numeral> *)

   propdisplay (PropVar (n,[t1,t2])) = (termdisplay t1)^" R"^(makestring n)^" "^(termdisplay t2) |

   propdisplay (PropVar (n, L)) = "P"^(makestring n)^"("^(displayarglist L)^")" |

   (* a predicate variable term is of the form P<numeral>(<term>,...,<term>) *)

   propdisplay (Not(And(p,q))) = "~("^(propdisplay (And(p,q)))^")" |     
   propdisplay (Not(Or(p,q))) = "~("^(propdisplay (Or(p,q)))^")" |
   propdisplay (Not(If(p,q))) = "~("^(propdisplay (If(p,q)))^")" |
   propdisplay (Not(ConvIf(p,q))) = "~("^(propdisplay (ConvIf(p,q)))^")" |
   propdisplay (Not(Iff(p,q))) = "~("^(propdisplay (Iff(p,q)))^")" |
   propdisplay (Not(Xor(p,q))) = "~("^(propdisplay (Xor(p,q)))^")" |

   propdisplay (Not p) = "~"^(propdisplay p) |

   (* the propositional connectives all take mandatory parentheses -- there is
   no grouping or order of operations (this is an improvement to be expected
   eventually *)

   propdisplay (And(p,q)) = (cursordisplay((parendisplay 6 p)))
   ^(cursordisplay(" & "^(parendisplay 5 q))) |

   propdisplay (Or(p,q)) = (cursordisplay((parendisplay 5 p)))^
   (cursordisplay(" v "^(parendisplay 4 q))) |

   propdisplay (If(p,q)) = (cursordisplay((parendisplay 4 p)))^
   (cursordisplay(" -> "^(parendisplay 3 q))) |
   propdisplay (ConvIf(p,q)) = (cursordisplay((parendisplay 4 p)))^
   (cursordisplay(" <- "^(parendisplay 3 q))) |

   propdisplay (Iff(p,q)) = (cursordisplay((parendisplay 3 p)))
   ^(cursordisplay(" == "^(parendisplay 2 q))) |

   propdisplay (Xor(p,q)) = (cursordisplay((parendisplay 3 p)))^
   (cursordisplay(" =/= "^(parendisplay 2 q))) |

   (* the primitive predicates are infix without parentheses *)

   propdisplay (In(x,y)) = (termdisplay x)^" E "^(termdisplay y) |

   propdisplay (Equals(x,y)) = (termdisplay x)^" = "^(termdisplay y) |

   (* &, v are also the universal and existential quantifiers, used
   in the syntax (<quantifier><bound variable>.<proposition>)  Note
   the parentheses *)

   propdisplay (All(m,n,p)) = "(Ax"^(makestring m)^(if n<0 then "" else "^"^(makestring n))
      ^"."^(propdisplay p)^")" |

   propdisplay (Some(m,n,p)) = "(Ex"^(makestring m)^"."^(if n> ~1 then "^"^(makestring n) else "")
      ^(propdisplay p)^")" |

   propdisplay (DefProp(s,[T,U])) =

   if find s (!PROPDEFS) = nil
   then let val S = "#"^s and L = [T,U] in
   S^"("^(displayarglist L)^")" end

   else (termdisplay T)^" "^(capitalize s)^" "^(termdisplay U) |

   propdisplay (DefProp(s,L)) = let val S =

       if find s (!PROPDEFS) = nil 
       orelse s = "e" orelse s = "ea" orelse s = "ep" orelse s = "ex"

       then "#"^s else capitalize s in

       if L = nil then S else 
      S^"("^(displayarglist L)^")" end |

   propdisplay (Parenthesis p) = "("^(propdisplay p)^")"

and parendisplay s p = if stickiness p < s then "("^(propdisplay p)^")" else
propdisplay p

and parentldisplay s p = if termleftstickiness p < 2*(prec s)+1 then
"["^(termdisplay p)^"]" else termdisplay p

and parentrdisplay s p = if termrightstickiness p < 2*(prec s)+1 then
"["^(termdisplay p)^"]" else termdisplay p

and termdisplay (FreeVar n) = 

   (* "a"^(makestring n) | *)

if find n (!ADEFS2) = nil then
   (if n<0 then "U" else "a")^(makestring (abs(n))) else 
   (capitalize(hd(find n (!ADEFS2)))) |

   (* a free variable is of the form a<numeral> *)

   termdisplay(Set(m,n,p)) = "{"^(termdisplay(BoundVar(m,n)))^"|"^(propdisplay p)^"}" |

   (* a set is of the form {<bound variable>|<proposition>} *)

   termdisplay (BoundVar (m,n)) = "x"^(makestring m)^(if n > ~1 then "^"^(makestring n) 
   else "")|

   (* a bound variable is of one of the two forms x<numeral> (untyped, internally
   having type ~1) and x<numeral>^<numeral>

   Here is as good a place as any to point out that the parser, if a numeral
   is expected but not found, will read 0 for index (which will be printed)
   and ~1 for type (which will not be printed).  So x will be parsed and
   printed as x0, x^ will be parsed and printed as x0^0, x^1 as x0^1, etc.
   Similar considerations apply to P (which becomes P0) and a (which becomes a0) *)

   termdisplay (Pair(x,y)) = "["^(termdisplay x)^","^(termdisplay y)^"]" |

   (* the ordered pair has syntax <<term>,<term>> (as in <x1,x2>) *)

   termdisplay (Proj1 x) = "p1("^(termdisplay x)^")" |

   (* the first projection is p1(<term>) *)

   termdisplay (Proj2 x) = "p2("^(termdisplay x)^")" |

   (* the second projection is p2(<term>) *)

   termdisplay (DefTerm(s,[T,U])) =

   (cursordisplay((parentldisplay s T)))
   ^(cursordisplay(" "^(if find s (!TERMDEFS) = nil 
   orelse s = "e" orelse s = "ea" orelse s="ep" orelse s = "ex"
   then "*"^s else capitalize s)^" "^(parentrdisplay s U))) |

   termdisplay (DefTerm(s,L)) = 

   let val S = if (find s (!TERMDEFS) = nil 
   orelse s = "e" orelse s = "ea" orelse s="ep" orelse s = "ex")
   andalso (hd(explode s) <> #"\"")

   then "*"^s else capitalize s in

   if L = nil then S else

   S^"("^(displayarglist L)^")" end

(* this function displays argument lists *)

and displayarglist nil = "" |

   displayarglist (p::nil) = termdisplay p |

   displayarglist (p::L) = (termdisplay p)^","^(displayarglist L);

(* stratification -- the stratification function checks that all variables
appearing in binders are typed and that any atomic formulas are well-typed
(accepting any atomic formula containing an untyped variable as well-typed *)

(* it now handles defined constructions by expanding all definitions;
a static method should be installed, but this will do for now *)

(* I believe a static method is now in place. *)

(* now installing dynamic stratification.  The idea is to assign
types dynamically to bound variables of type ~1 as needed.

*)

(* Oct. 6:  this algorithm is not complete, but should be completable
if it can be made to try all orders *)

val STRAT = ref (nil:((int*int) list)); val OLDSTRAT=ref(!STRAT);

val VAGUE = ref 0;  val OLDVAGUE = ref 0;

val FATAL = ref false;

(* stack of old states of stratification *)

val STRAT2 = ref [!STRAT];

val VAGUE2 = ref [0];

val FATAL2 = ref [false];

val _ = (STRAT2:=nil;VAGUE2:=nil;FATAL2:=nil);

(* save current stratification info *)

fun pushstrat() = (STRAT2:= (!STRAT)::(!STRAT2);VAGUE2:=(!VAGUE)::(!VAGUE2);
                  FATAL2:=(!FATAL)::(!FATAL2));

(* retrieve saved stratification info *)

fun popstrat() = (STRAT:=hd(!STRAT2);STRAT2:=tl(!STRAT2);
VAGUE:=hd(!VAGUE2);VAGUE2:=tl(!VAGUE2);
FATAL:=hd(!FATAL2);FATAL2:=tl(!FATAL2));

fun discardstrat() = (STRAT2:=tl(!STRAT2);VAGUE2:=tl(!VAGUE2);
                          FATAL2:=tl(!FATAL2));

(* stored stratification info about defined constructions *)

fun indexlist nil = nil |

indexlist (t::L) = (indexlist L)@[length L +1];


fun isstratdef s = if find s (!STRATINFO) = nil then false else

let val [(b,L)] = find s (!STRATINFO) in b end;

fun stratdeflist s = if find s (!STRATINFO) = nil then nil else

let val [(b,L)] = find s (!STRATINFO) in L end;

fun typelistassign nil L = () |

typelistassign (t::L) nil = (settype t 0;typelistassign L nil) |

typelistassign (t::L) (n::M) = (settype t n;typelistassign L M)

and termstratified (Set(m,~1,p)) = 

   stratified p |

   termstratified (Set(m,n,p)) = stratified p |

   termstratified (Pair(x,y)) = stratified(Equals(x,y)) |

   termstratified (Proj1 x) = termstratified x |

   termstratified (Proj2 x) = termstratified x |

(* an "opaque" version of stratification for defined terms would be
more complicated:  this is it. *)

   termstratified (DefTerm(s,L)) = if isstratdef s = false then

   if map (fn x=>not(istyped x orelse needstype x)) L = map (fn x => true) L

   then true else (false)

   else 

   (settype (DefTerm(s,L)) (typeof(DefTerm(s,L))); 
   let val S = map termstratified L = map (fn x=>true) L in

   if (map (fn n=> needstype(hd(item n L)) andalso (typeof (hd(item n L))
   - typeof (DefTerm(s,L)) <>
      (hd(item n (stratdeflist s))))) (indexlist L)) <> map (fn x=>false) L

   then (false)

   else S end) |

   termstratified x = true 

and listtypediff L nil = 0 |

   listtypediff nil L = 0 |

   listtypediff (t::L) (n::M) = if istyped t then typeof t - n else 

   listtypediff L M

(* type of a term -- pick a type the term must have if it is to
be typed, with no concern for uniqueness. *)

and typeof (BoundVar(m,n)) = if n <> ~1 then n else if

   find m (!STRAT) = nil then ~1 else hd(find m (!STRAT))

   | typeof (Set(m,n,p)) = typeof (BoundVar(m,n)) + 1

   | typeof (Pair(x,y)) = if (istyped x) then typeof x else typeof y

   | typeof (Proj1 x) = typeof x

   | typeof (Proj2 x) = typeof x

   | typeof (DefTerm(s,L)) = if isstratdef s then listtypediff L (stratdeflist s)

     else ~1 

   | typeof x = ~1

and istyped (BoundVar(m,n)) = n > 0 orelse find m (!STRAT) <> nil 

   | istyped (Set(m,n,p)) = istyped (BoundVar(m,n))

   | istyped (Pair(x,y)) = istyped x orelse istyped y

   | istyped (Proj1 x) = istyped x

   | istyped (Proj2 x) = istyped x

   | istyped (DefTerm(s,L)) = if isstratdef s then map istyped L <> map (fn x=>false) L

     else false

   | istyped x = false

and settype (BoundVar(m,~1)) n = if find m (!STRAT) = nil

   then STRAT:=(m,n)::(!STRAT) else () |

   settype (Set(m,~1,p)) n = if find m (!STRAT) = nil

   then STRAT:=(m,n-1)::(!STRAT) else () |

   settype (Pair(x,y)) n = (settype x n;settype y n) |

   settype (Proj1 x) n = settype x n |

   settype (Proj2 x) n = settype x n |

(* a clause for defined terms is probably wanted *)

   settype (DefTerm(s,L)) n = if isstratdef s 

   then typelistassign L (map (fn x=>x+n)(stratdeflist s)) else () | 

   settype x n = ()

and needstype (BoundVar(m,~1)) = true |

   needstype (Set(m,~1,p)) = true |

   needstype (Pair(x,y)) = needstype x orelse needstype y |

   needstype (Proj1 x) = needstype x |

   needstype (Proj2 x) = needstype x |

   needstype (DefTerm(s,L)) = map needstype L <> map (fn x=>false) L |

   needstype x = false

and stratified (In(x,y)) =
termstratified x andalso termstratified y andalso
( if needstype x orelse needstype y then let val T = if istyped x then typeof x else if istyped y then typeof y -1
else 0 in (settype x T; settype y (T+1)) end else ();
((typeof y = typeof x + 1) orelse not(needstype x) orelse not(needstype y))
) |

   stratified (Equals(x,y)) = 
termstratified x andalso termstratified y andalso
(if needstype x orelse needstype y then let val T = 
if istyped x then typeof x else if istyped y then typeof y
else 0 in (settype x T; settype y (T)) end else ();
((typeof x = typeof y) orelse not(needstype x) orelse not(needstype y))) |

   stratified (Not(p)) = stratified p |

   stratified (And(p,q)) = let val A = (pushstrat();stratified p
      andalso stratified q) in if (not A) then (popstrat();
      stratified q andalso stratified p) else (discardstrat();A) end |
   stratified (Or(p,q)) = stratified(And(p,q)) |
   stratified (If(p,q)) = stratified(And(p,q)) |
   stratified (ConvIf(p,q)) = stratified(And(p,q)) |
   stratified (Iff(p,q)) = stratified(And(p,q)) |
   stratified (Xor(p,q)) = stratified(And(p,q)) |
   stratified (All(m,n,p)) = termstratified (Set(m,n,p)) |
   stratified (Some(m,n,p)) = termstratified (Set(m,n,p)) |
   stratified (Parenthesis p) = stratified p |

   stratified (DefProp(s,L)) = 

if isstratdef s then

    let val S = map termstratified L = map (fn x=> true) L in

      (let val T = listtypediff L (stratdeflist s) in

      typelistassign L (map (fn n => n+T) (stratdeflist s))

      end;

    let val T = listtypediff L (stratdeflist s) in

       if (map (fn n => istyped (hd(item n L)) andalso typeof (hd(item n L)) - T
       <>
      (hd(item n (stratdeflist s)))) (indexlist L)) <> map (fn x=>false) L

       then false

       else S end) end

else  if map (fn x=> not(istyped x orelse needstype x)) L
               = map (fn x => true) L then true else (false)|

stratified (PropVar (n, L)) = if map (fn x=> not(istyped x orelse needstype x)) L
               = map (fn x => true) L then true else (false);


(* (* note that VAGUE appears no longer to be used *)

fun looptermstratified b t =

   ((* OLDVAGUE:=(!VAGUE); VAGUE:= 0; *) OLDSTRAT:=(!STRAT);VAGUE:=0;

 let val S = termstratified t in

   if S then true else if (!FATAL) then false 

   else looptermstratified b t end); *)


fun safetermstratified x = (STRAT:=nil;termstratified x);

(* (Set(m,~1,p)) =

     (STRAT:=nil;VAGUE:=0;FATAL:=false;STRAT2:=nil;VAGUE2:=nil;FATAL2:=nil;

     let val S = termstratified (Set(m,~1,p))

     in if S then true

     else if (!FATAL) then false

     else looptermstratified false (Set(m,~1,p)) end)

     orelse (STRAT:=[(m,0)];VAGUE:=0;FATAL:=false;STRAT2:=nil;VAGUE2:=nil;FATAL2:=nil;

     let val S = termstratified (Set(m,~1,p))

     in if S then true

     else if (!FATAL) then false

     else looptermstratified true (Set(m,~1,p)) end) |


     safetermstratified x = (STRAT:=nil;VAGUE:=0; FATAL:=false;
     let val S = termstratified x in if S then true else if (!FATAL)
     then false else looptermstratified false x end)

     orelse (STRAT:=nil;VAGUE:=0; FATAL:=false;settype x 1;
     let val S = termstratified x in
     if S then true else if (!FATAL) then false else 
     looptermstratified true x end); *)

(* display a list of propositions (the set of propositions on the left
or right of a sequent) as a list of numbered items *)

(* AUTOPRUNE UPDATE:  changed this to note (and throw away) the
genealogies of propositions -- though I suppose one could use
the serial numbers of propositions as permanent line numbers *)

fun proplistdisplay1 n m i nil = "" |

    proplistdisplay1 n m i ((p,q)::L) = (CURSOR:=0;
        if i<n then proplistdisplay1 n m (i+1) L

        else if (i>=n andalso i <=n+m-1) orelse m<0 then
        (makestring i)^":  "^(propdisplay p)^"\n"^
        proplistdisplay1 n m (i+1) L

        else "");

fun proplistdisplay m n L = proplistdisplay1 m n 1 L;

val LEFTSTART = ref 1;

val RIGHTSTART = ref 1;

val LINES = ref ~1;



(* a sequent is displayed in the form

list of propositions on the left (each on a separate line)

|-

list of propositions on the right (each on a separate line) *)

fun seqdisplay (Seq(L,M)) = (proplistdisplay (!LEFTSTART) (!LINES) L)
   ^"\n\n|-\n\n"^(proplistdisplay (!RIGHTSTART) (!LINES) M)^"\n\n"; 


(* getproplist gets the nth element of the list to the front, rotating items
from front to back *)

fun getproplist n nil = nil |

     getproplist 1 L = L |

     getproplist n (p::nil) = (p::nil) |

     getproplist n (p::(q::L)) = getproplist (n-1) ((q::L)@[p]);

fun pruneproplist n nil = nil |

     pruneproplist 1 (p::L) = L |

     pruneproplist n (p::L) = p::(pruneproplist (n-1) L);

(* functions used to bring the nth item on the left or right of a sequent to the front *)

fun getleft n (Seq(L,M)) = Seq(getproplist n L,M);

fun getright n (Seq(L,M)) = Seq(L,getproplist n M);

fun getleft2 n (Seq(L,M)) =

   if L = nil orelse tl L = nil orelse n<=2 then Seq(L,M)

   else Seq((hd L)::(getproplist (n-1) (tl L)),M);

fun getright2 n (Seq(L,M)) =

   if M = nil orelse tl M = nil orelse n<= 2 then Seq(L,M)
   else Seq(L,(hd M)::(getproplist (n-1) (tl M)));

fun pruneleft n (Seq(L,M)) = Seq(pruneproplist n L, M);

fun pruneright n (Seq(L,M)) = Seq(L,pruneproplist n M);

(* apply the appropriate rule to a sequent with a given formula first on the left *)

(* constructive logic *)

val CONSTRUCTIVE = ref false;

fun constructive() = CONSTRUCTIVE:=true;

fun maybehd nil = nil |

maybehd (x::L) = if (!CONSTRUCTIVE) then [x] else (x::L);

fun maybeadd x L = if (!CONSTRUCTIVE) then (x::L) else L;

(* provide a toggle to turn this off -- with the toggle off one is
in pure NFU. *)

val CLASSES = ref true;

fun noclasses() = CLASSES:=false;

(* extensional theories *)

val EXTENSIONAL = ref false;

(* this toggle will put you in NF; the pair is harmless in
classical NF but must be disabled for INF *)

fun extensional() = (CLASSES:=false;EXTENSIONAL:=true);

(* a toggle to disable the pair *)

fun nopairs() = NOPAIRS:=true;

(* set up the prover for intuitionistic NF:  the logic is constructive,
the right rule for equality is the rule for coextensionality, and 
the pair and projections are rejected by the parser *)

fun inf() = (constructive();extensional();nopairs());

(* AUTOPRUNE UPDATE:  add the genealogy as a new argument *)

fun genextend g = (nextpserial())::g


(* this handles the left rule for the universal quantifier and the right
rule for the existential quantifier, which have an arbitrary term as
an additional argument *)

(* witness rule will act on a universal statement on the left before
acting on an existential statement on the right *)

(* why doesn't witnessrule raise the bound index? *)
(* it doesn't need to:  all considerations of the bound index are
local to a particular proposition and term and are handled by the
substitution function when one subs into binding constructions *)

fun witnessrule t (Seq(((All(m,n,p)),G)::L,M)) = (NEXTFREE:=max(!NEXTFREE,termfreeindex t);
[Seq(((topsubsprop m n t p),genextend G)::((All(m,n,p)),genextend G)::L,M)]) |

    witnessrule t (Seq(L,((Some(m,n,p)),G)::M)) = (NEXTFREE:=max(!NEXTFREE,termfreeindex t);
[Seq(L,((topsubsprop m n t p),genextend G)::((Some(m,n,p)),genextend G)::M)]) |

    witnessrule t x = (Say "No witness rule applies.";[x]);

fun     witnessrule2 t (Seq(L,((Some(m,n,p)),G)::M)) = (NEXTFREE:=max(!NEXTFREE,termfreeindex t);
[Seq(L,((topsubsprop m n t p),genextend G)::((Some(m,n,p)),genextend G)::M)]) |

(* witnessrule2 has the reverse default behavior *)

witnessrule2 t (Seq(((All(m,n,p)),G)::L,M)) = 
(NEXTFREE:=max(!NEXTFREE,termfreeindex t);[Seq(((topsubsprop m n t p),genextend G)::((All(m,n,p)),genextend G)::L,M)]) |

    witnessrule2 t x = (Say "No witness rule applies.";[x]);

(* turn on experimental "unknown variables" *)

val UNKNOWNS = ref false;

fun unknowns() = UNKNOWNS:=true;

fun listnewfreeindex nil = 0 |

   listnewfreeindex (p::L) = max(newfreeindex p,listnewfreeindex L);

fun listnewboundindex nil = 0 |

   listnewboundindex (p::L) = max(newboundindex p,listnewboundindex L);

(* fun resetindices0 (Seq(L,M)) = 

let val A = map (fn (x,y)=>x) L and B = map (fn (x,y)=>x) M in

(NEXTFREE:=listnewfreeindex (A@B);
NEXTBOUND:=listnewboundindex (A@B);Seq(L,M)) end; *)

fun setunknown n t (Seq(L,M)) = Seq(map (fn (P,G)=>
if not(freevarfoundp (~(abs(n))) P) then (P,G) else
(topsubsfreep (~(abs n)) t P,G)) L,map (fn (P,G)=>
if not(freevarfoundp (~(abs(n))) P) then (P,G) else
(topsubsfreep (~(abs n)) t P,G)) M) |

setunknown n t x = x;

fun setunknowns m t (Node(n,S1,L)) = Node(n,setunknown m t S1,map (setunknowns m t) L) |

setunknowns m t (Goal(n,S)) = Goal(n,setunknown m t S) |

setunknowns m t x = x;


(* display a sequent *)

fun showseq s = (TextIO.output(TextIO.stdOut,("\n"^seqdisplay s));s);

fun logseq s = 
if (!LOGGING) then 
(writelogline "\n(* Sequent snapshot:\n";
    TextIO.output((!LOGFILE),seqdisplay s);writelogline "\n*)\n\n";s) else s;


(* how to organize the proof environment?  *)

(* there will be a proof in progress.  To view the structure of the proof as
a whole would be to be able to look at the goals remaining to be proved.
One should be able to move to the next goal, the previous goal, or apply a rule
to the current goal.  If a goal is no longer a goal after one performs
such an operation, one should be transferred to the next available goal
(first subgoal of this node or next goal overall if the goal has been solved).
Any goal which is proved should be announced (eventually with the option of
being recorded).

*)


fun undo() = 

if (!PROOFS) = nil orelse (!REMEMBER) = false

then say "No undo information available"

else (PROOFS2 := (hd (!PROOFS))::(!PROOFS2);PROOFS:=tl (!PROOFS);

if (!PROOFS) = nil then say "No undo information available"

else THEPROOF := hd(!PROOFS));

fun backup() = if (!REMEMBER) then 
(PROOFS:= (!THEPROOF)::(!PROOFS);PROOFS2:=nil) else ();

fun forward() = if (!REMEMBER)=false orelse (!PROOFS2)=nil

then say "No undo history available"

else (THEPROOF:=hd(!PROOFS2);PROOFS2:=tl(!PROOFS2);
PROOFS:= (!THEPROOF)::(!PROOFS));

fun clearmemory() = PROOFS:=nil;



(* idea for position:  always work on the first goal.  To move
around, change the order of the proofs to make the one you want first? *)

(* commands are provided to do this manually, but it's not a great idea -
basically, one should go through the goals as they are presented.  The
autorotate function below uses these *)

fun rotateproof 0 (Node(n,x,p::q::L)) = Node(n,x,(q::L)@[p]) |

rotateproof 0 p = p |

rotateproof n (Node(m,x,p::L)) = if n<1 then Node(m,x,p::L) else Node(m,x,(rotateproof (n-1) p)::L)|

rotateproof n x = x;

fun rotate n = (THEPROOF := rotateproof n (!THEPROOF));

(* Returns the leftmost sequent in the proof tree if it is a goal, otherwise error
(implemented by returning a one-element list with the sequent if it is a goal,
and nil otherwise) *)

(* added an exclusion list argument to support second goal function *)

fun thegoal (Goal (n,p)) = [p] |

thegoal (Node(n,x,p::L)) = thegoal p |

thegoal x = nil;

fun goalline (Goal (n,p)) = n |

goalline (Node(n,x,p::L)) = goalline p |

goalline x = 1;

(* index of line numbers at which unknown variables are introduced,
used by new prover *)

val UNKNOWNINDEX=ref (nil:((int*int)list));

fun getnewunknown() = (NEXTFREE:=(!NEXTFREE)+1;
UNKNOWNINDEX:=((!NEXTFREE),goalline(!THEPROOF))::(!UNKNOWNINDEX);
FreeVar (~(!NEXTFREE)));


(* the idea is to move the goal to the end *)

(* I'm not certain but I think iterating this followed by
autorotate will find all the goals in the sequent one after the other;
the order in which this is done will be a little strange though *)

fun putlast (Node(n,x,p::L)) = Node(n,x,L@[putlast p]) |

putlast S = S;

(* this function automatically brings a goal to the leftmost position if there
is an unproved goal in the tree *)

fun autorotate (Goal (n,p)) = Goal (n,p) |

autorotate (Node(n,x,p::L)) = let val L1 = map autorotate (p::L) in

let val L2 = map (thegoal) L1 in

if map (fn x => nil) (p::L) = L2 then Node(n,x,p::L)

else if thegoal (hd L1) <> nil then Node(n,x,L1)

else autorotate (rotateproof 0 (Node(n,x,L1))) 

end end |

autorotate x = x;

(* I need a function which will rotate the second to the leftmost
goal to the front *)

(* fun autorotate2 X (Goal (n,p)) = Goal (n,p) |

autorotate2 X (Node(n,x,p::L)) = let val L1 = map (autorotate2 X) (p::L) in

let val L2 = map (thegoal X) L1 in

if map (fn x => nil) (p::L) = L2 then Node(n,x,p::L)

else if thegoal (hd L1) <> nil then Node(n,x,L1)

else autorotate2 X (rotateproof 0 (Node(n,x,L1))) 

end end |

autorotate2 X x = x; *)

fun nextgoal S = (* autorotate2 (thegoal S) S; *)

   autorotate (putlast S);

(* I also want a function which will sort by line number *)

(* the autoprune function -- eliminates unused propositions from 
sequents *)

(* we need to merge all genealogy lists of propositions at the top
of the proof tree, then go through all sequents in the proof tree
and eliminate propositions whose serial number does not appear on
this list *)

fun union nil M = M |

   union (n::L) M = if foundin n M then union L M else (n::(union L M));

fun list_union nil = nil |

   list_union (L::L2) = union L (list_union L2);

fun p2(x,y) = y;

(* added case of reflexivity of equality *)

fun genealogylist (Node(n,Seq(L,(Equals(T,U),g)::M),nil)) =

   if safealphaterm T U then g else 

   if L<> nil andalso safealphaprop (p1(hd L)) (Equals(T,U))

   then union (p2(hd L)) g

   else genealogylist (Goal(n,Seq(L,(Equals(T,U),g)::M))) |

   genealogylist (Node(n,Seq((p,g1)::L,(q,g2)::M),nil)) =

   if safealphaprop p q then union g1 g2 else 

   genealogylist (Goal(n,Seq((p,g1)::L,(q,g2)::M))) |

   genealogylist 

   (Node(n,S,[ProofReference s])) = genealogylist (Goal(n,S)) |

   genealogylist (Node(n,S,L)) = list_union(map genealogylist L) |

   genealogylist (Goal(n,Seq(L,M))) = union (list_union(map p2 L))
      (list_union(map p2 M)) |

   genealogylist P = nil;

fun pruneproplist L ((p,(n::M))::N) = if foundin n L  then 
     (p,(n::M))::(pruneproplist L N)
     else (pruneproplist L N) |

    pruneproplist L nil = nil; 

fun prunesequent L (Seq(P,Q)) = Seq(pruneproplist L P,pruneproplist L Q);

fun pruneproof L (Node(n,S,M)) = Node(n,prunesequent L S,
    map (pruneproof L) M) |

    pruneproof L (Goal(n,S)) = Goal(n,prunesequent L S) |

    pruneproof L P = P;

fun autoprune1 (Node (n,S,M)) =

let val M2 = map autoprune1 M in 

Node(n,prunesequent(genealogylist(Node(n,S,M2))) S,M2)

end |

autoprune1 P = P;

fun mayberotate x = if (!BUBBLES) then autorotate x else x;

fun autoprune() = (THEPROOF := 
   
   (mayberotate(bubbles(autoprune1 (!THEPROOF))));backup());



(* this function allows one to apply a function from sequents to sequents
to the leftmost goal *)

fun changeseq1 f (Goal (n,p)) = Goal (n,(f p)) |

changeseq1 f (Node(n,x,(p::L))) = Node(n,x,((changeseq1 f p)::L)) |

changeseq1 f x = (say "\nQ. E. D.\n";x);

fun setunknowns m t (Node(n,S1,L)) = Node(n,setunknown m t S1,map (setunknowns m t) L) |

setunknowns m t (Goal(n,S)) = Goal(n,setunknown m t S) |

setunknowns m t x = x;

(* changed this so the list rewrites itself as it goes *)

fun setunknownslist nil = () |

setunknownslist ((n,t)::L) = (
if termfreeindex t < n then

(THEPROOF:=

(* changeseq1 resetindices0 *) (setunknowns n t (!THEPROOF));

   setunknownslist 
(map(fn (m,T)=>(m,if not (freevarfoundt (~n) T) then T else
(topsubsfree (~n) t T)))

L))

else (Say "Variable hierarchy error in unification";undo()));

fun fireusubs() = if (!USUBS)=nil then () else
(ububbles(); setunknownslist (!USUBS); USUBS:=nil);


(* this function sets up the initial state of proof of a proposition *)

fun trytoprove p = (clearmemory();NEXTFREE:=newfreeindex p;(* NEXTSERIAL:=0; *)
NEXTBOUND :=newboundindex p; (* CURRENTLEMMAS:=nil;SAVEDPROOFS:=nil; *)
UNKNOWNINDEX:=nil;
THEPROOF := Goal (getnewserial(),(Seq(nil,[(p,[nextpserial()])])));backup());

fun trytoprove2 p = (clearmemory();NEXTFREE:=newfreeindex p;(* NEXTSERIAL:=0; *)
NEXTBOUND :=newboundindex p;  CURRENTLEMMAS:=nil;SAVEDPROOFS:=nil; 
UNKNOWNINDEX:=nil;
THEPROOF := Goal (getnewserial(),(Seq(nil,[(p,[nextpserial()])])));backup());


fun startsequent L M = (clearmemory();
UNKNOWNINDEX:=nil;
NEXTFREE:=listnewfreeindex (L@M);
NEXTBOUND:=listnewboundindex (L@M);
THEPROOF:= Goal(getnewserial(),
   Seq(map (fn x=>(x,[nextpserial()])) L,map (fn x=>(x,[nextpserial()])) M)));


(* this function takes the leftmost leaf of the proof tree (if it is 
a goal) and puts above it the output of a function from sequents to lists
of sequents (use this to apply rules) *)

fun changeseq2 f (Goal (n,p)) = 

let val A = f p in if A = [p] then (Goal (n,p)) else

Node(n,p,map (fn x=>Goal(getnewserial(),x)) A) end |

changeseq2 f (Node(n,x,p::L)) = Node(n,x,(changeseq2 f p)::L) |

changeseq2 f x = x;

fun changeseq3 f (Goal(n,p)) = f(Goal(n,p)) |

changeseq3 f (Node(n,x,p::L)) = Node(n,x,(changeseq3 f p)::L) |

changeseq3 f x = x;

fun repeat f x = let val A = f x in if A = x then x else repeat f A end;

(* c1 and c2 implement application of the higher order functions above
to the given proof *)

fun c1 f = (THEPROOF := ((changeseq1 f (!THEPROOF)));fireusubs();
THEPROOF:=changeseq1 showseq (!THEPROOF));

fun c2 f = (THEPROOF:= 
((autorotate(changeseq2 f (!THEPROOF))));fireusubs();
THEPROOF:=changeseq1 showseq (!THEPROOF)
);

fun c2s f = (THEPROOF := 
((autorotate(repeat (changeseq2 f) (!THEPROOF))));fireusubs();
THEPROOF:=changeseq1 showseq (!THEPROOF)
);

fun c3 f = (THEPROOF := 
((autorotate(changeseq3 f(!THEPROOF))));fireusubs();
THEPROOF:=changeseq1 showseq (!THEPROOF));





(* commands for posting information to proof logs *)


fun snapshot() = c1 logseq;

fun logcomment s = (
     writelogline ("\n\n(* "^(makestring(!LINENUMBER))^
     "\n\n"^s^"*)\n\n");snapshot());

(* hardcomment1 is for all lines of a hard comment except the last;
it omits the snapshot *)

fun hardcomment1 s = (
     writelogline ("\n\n(* "^(makestring(!LINENUMBER))^
     " *)\n\nhardcomment \""^s^"\";\n\n"));

fun hardcomment s = (
     writelogline ("\n\n(* "^(makestring(!LINENUMBER))^
     " *)\n\nhardcomment \""^s^"\";\n\n");snapshot());

fun reportcommand ((Mnemonic m)::L) = if (!LOGGING) = false then ()

   else (nextline();writelogline(
   (if 

(* commands before which we place a return *)

   m = "Start" orelse m = "DefineProp" orelse m="DefineTerm"
   orelse m = "DefSent" orelse m="StartSequent"

   orelse m = "Constructive" orelse m = "Extensional"
   orelse m = "NoClasses" orelse m = "NoPairs" orelse m = "Inf"
   orelse m = "Unknowns" orelse m = "Axiom"

   then "\n\n"^(linenumber()) else "")
   ^(linedisplay ((Mnemonic m)::L))^(if

(* commands after which we place a return *)
 
   m = "Done" orelse m = "UseThm" orelse m = "NextGoal"
   orelse m = "UseThm2" orelse m = "Reflexiveeq" 
   orelse m="Cut" orelse m="Cut2" orelse m = "ThmCut"
   orelse m = "w" orelse m = "w2" orelse m = "NameSequent" orelse
   m = "Start" orelse m = "DefineProp" orelse m="DefineTerm"
   orelse m = "DefSent" orelse m = "Axiom" orelse m ="StartSequent"

   then "\n"^(nextlinenumber()) else "")));


fun Say s = (say s; 
if (!LOGGING) then (say ("In line number "^(makestring(1+(!LINENUMBER))));
logcomment s) else(); 
getstuff();());

(* precedences are set relative to precedences of existing operations;
users do not need to know numerical values (which shift) *)

fun setprecsame s t = (setprec s (prec t);
                      reportcommand [Mnemonic "setprecsame",
                      StringArg s,StringArg t]);

fun setprecrightabove s t = ((pushprecs (evenabove(prec t));setprec s
(evenabove(prec t)));reportcommand [Mnemonic "setprecrightabove",
                      StringArg s,StringArg t]);

fun setprecrightbelow s t = ((pushprecs ((prec t));setprec s
(evenbelow(prec t)));reportcommand [Mnemonic "setprecrightbelow",
                      StringArg s,StringArg t]);

fun setprecleftabove s t = ((pushprecs (oddabove(prec t));setprec s
(oddabove(prec t)));reportcommand [Mnemonic "setprecleftabove",
                      StringArg s,StringArg t]);

fun setprecleftbelow s t = ((pushprecs ((prec t));setprec s
(oddbelow(prec t)));reportcommand [Mnemonic "setprecleftbelow",
                      StringArg s,StringArg t]);

fun setprecrightmax s  = (setprec s (evenabove (!MAXPREC));
                      reportcommand [Mnemonic "setprecrightmax",
                      StringArg s]);

fun setprecleftmax s  = (setprec s (oddabove (!MAXPREC));
                      reportcommand [Mnemonic "setprecleftmax",
                      StringArg s]);

fun setprecrightmin s t = ((pushprecs 0;setprec s 0);
                      reportcommand [Mnemonic "setprecrightmin",
                      StringArg s]);

fun setprecleftmin s t = ((pushprecs 0;setprec s 1);
                      reportcommand [Mnemonic "setprecleftmin",
                      StringArg s]);



fun pleftrule (Parenthesis p) G L M = pleftrule p G L M |

   pleftrule (Not p) G L M = [Seq(maybeadd (Not p,G) L,(p,genextend G)::M)] | 

   pleftrule (And(p,q)) G L M = [Seq((p,genextend G)::(q,genextend G)::L,M)] |

    pleftrule (Or(p,q)) G L M = [Seq((p,genextend G)::L,M),
       Seq((q,genextend G)::L,M)] |

    pleftrule (If(p,q)) G L M = [Seq(maybeadd (If(p,q),G) L,((p,genextend G)::M)),
       Seq((q,genextend G)::L,M)] |
    pleftrule (ConvIf(p,q)) G L M = [Seq(L,((q,genextend G)::M)),
       Seq((p,genextend G)::L,M)] |

(* == and =/= (iff and xor) are handled by definitional expansion *)

    pleftrule (Iff(p,q)) G L M = [Seq(((And(If(p,q),If(q,p))),genextend G)
       ::L,M)] |

    pleftrule (Xor(p,q)) G L M =  [Seq(((Iff(p,Not(q))),genextend G)::L,M)] |

(* for the left rule for the universal quantifier, see witnessrule below *)

    pleftrule (Some(m,n,p)) G L M = 
    [Seq(((topsubsprop m n (getnewfree()) p),genextend G)::L,M)] |

(* experimental left rule for the universal quantifier *)

    pleftrule (All(m,n,p)) G L M = 
    
    if (!UNKNOWNS) then 
    witnessrule (getnewunknown()) (Seq(((All(m,n,p)),G)::L,M))
    else (Say "No left rule applies (use witness rule)!";[(Seq(((All(m,n,p)),G)::L,M))]) |

(* unstratified abstracts are allowed -- this complicates this rule a bit *)

    pleftrule (In(t,DefTerm(s,L))) G M N = 
    let val T = usetermdef(DefTerm(s,L)) in
    if T = (DefTerm(s,L))
    then [Seq((((In(t,DefTerm(s,L))),G))::M,N)] else
    pleftrule (In(t,T)) G M N end |

    pleftrule (In(t,Set(m,n,p))) G L M = if safetermstratified (Set(m,n,p)) then
    [Seq(((topsubsprop m n t p),genextend G)::L,M)] 
    else (Say "Warning:  set abstract isn't stratified";let val v = getnewfree() in
    [Seq(((topsubsprop m n t p),genextend G)::
    ((All(m,n,Iff(In(BoundVar(m,n),v),p))),genextend G)::L,M)]
    end)|

(* equality on the left is handled by simple Leibniz definitional expansion *)

    pleftrule (Equals(t,u)) G L M = (NEXTBOUND:=newboundindex(Equals(t,u));let val BoundVar(m,n) = getnewbound(~1) in

    [Seq(((All(m,n,Iff(In(t,BoundVar(m,n)),In(u,BoundVar(m,n))))),genextend G)
       ::L,M)] end) |

(* definition expansion for defined predicates *)

    pleftrule (DefProp(s,L)) G M N = 
    let val P = usepropdef(DefProp(s,L)) in
    if P = (DefProp(s,L)) then
    [Seq((P,G)::M,N)]
    else [Seq(((usepropdef (DefProp(s,L))),genextend G)::M,N)] end |

(* the following complex of rules allows cut-free reasoning about
equality between complex terms appearing to the left of E; 
atomic terms are excluded from application of the rule.  The situation
for projection terms is still not satisfactory  --that last remark
may now be out of date *)

    pleftrule (In(BoundVar(m,n),u)) G L M = 
    [Seq(((In(BoundVar(m,n),u)),G)::L,M)] |

    pleftrule (In(FreeVar(n),u)) G L M = 
    [Seq(((In(FreeVar(n),u)),G)::L,M)] |

    pleftrule (In(t,u)) G L M = (NEXTBOUND:=newboundindex(In(t,u));
    let val BoundVar(m,n) = getnewbound(~1) in

    [Seq(((Some(m,n,(And(Equals(BoundVar(m,n),t),
    In(BoundVar(m,n),u))))),genextend G)::L,M)] end) |


(* inappropriate rule application invisibly creates redundant nodes *)
(* not anymore! this is detected later *)

    pleftrule x G L M = (Say "No left rule applies.";[Seq((x,G)::L,M)]);

fun prightrule (Parenthesis p) G L M = prightrule p G L M |

    prightrule (Not p) G L M = [Seq((p,genextend G)::L,M)] |

    prightrule (And(p,q)) G L M = [Seq(L,(p,genextend G)::M),
       Seq(L,(q,genextend G)::M)] |

    prightrule (Or(p,q)) G L M = [Seq(L,(p,genextend G)::(q,genextend G)::M)] |

    prightrule (If(p,q)) G L M = [Seq((p,genextend G)::L,(q,genextend G)::M)] |
    prightrule (ConvIf(p,q)) G L M = [Seq((q,genextend G)::L,(p,genextend G)::M)] |

    prightrule (Iff(p,q)) G L M = [Seq(L,((And(If(p,q),If(q,p))),genextend G)
       ::M)] |

    prightrule (Xor(p,q)) G L M =  [Seq(L,((Iff(p,Not(q))),genextend G)::M)] |

(* the rule below is complex for the same reasons *)

    prightrule (In(t,DefTerm(s,L))) G M N = 
let val T =usetermdef(DefTerm(s,L))in

if T = DefTerm(s,L) 
then [Seq(M,((In(t,DefTerm(s,L))), G)::N)]

else prightrule (In(t,usetermdef(DefTerm(s,L)))) G M N end |

    prightrule (In(t,Set(m,n,p))) G L M = 

    if safetermstratified (Set(m,n,p)) then 


    [Seq(L,((topsubsprop m n t p),genextend G)::M)]

    else (NEXTBOUND:=newboundindex(In(t,Set(m,n,p)));(let val BoundVar(m1,n1) = getnewbound(~1) in
    (Say "Warning:  set abstract isn't stratified!";
    [Seq(L,((Some(m1,n1,Iff(In(BoundVar(m,n),BoundVar(m1,n1)),
     p))),genextend G)::M),Seq(L,((topsubsprop m n t p),genextend G)::M)
    ]) end)) |

(* the following complex of rules allows cut-free reasoning about
equality between complex terms appearing to the left of E; 
atomic terms are excluded from application of the rule.  The situation
for projection terms is still not satisfactory  --that last remark
may now be out of date *)

    prightrule (In(BoundVar(m,n),u)) G L M = 
    [Seq(L,((In(BoundVar(m,n),u)),G)::M)] |

    prightrule (In(FreeVar(n),u)) G L M = 
    [Seq(L,((In(FreeVar(n),u)),G)::M)] |

    prightrule (In(t,u)) G L M = (NEXTBOUND:=newboundindex(In(t,u));
    let val BoundVar(m,n) = getnewbound(~1) in

    [Seq(L,((All(m,n,(If(Equals(BoundVar(m,n),t),
    In(BoundVar(m,n),u))))),genextend G)::M)] end) |

(* the right rule for existential quantification appears under witnessrule below *)

    prightrule (All(m,n,p)) G L M = 
    [Seq(L,((topsubsprop m n (getnewfree()) p),genextend G)::M)] |

(* experimental right rule for the existential quantifier *)

    prightrule (Some(m,n,p)) G L M = 
    
    if (!UNKNOWNS) then 
    witnessrule2 (getnewunknown()) (Seq(L,(Some(m,n,p),G)::M))
    else (Say "No right rule applies (use witness rule)!";[Seq(L,((Some(m,n,p)),G)::M)]) |


(* the requirements of NFU extensionality complicate this rule *)

    prightrule (Equals(t,u)) G L M = (NEXTBOUND:=newboundindex(Equals(t,u));let val BoundVar(m,n) = getnewbound(~1) in

if (!EXTENSIONAL) then 

[Seq(L,(((All(m,n,Iff(In(BoundVar(m,n),t),In(BoundVar(m,n),u))))),genextend G)
      ::M)]

else     [(Seq(L,((All(m,n,Iff(In(t,BoundVar(m,n)),
      In(u,BoundVar(m,n))))),genextend G)::
      ((And(Some(m,n,Or(In(BoundVar(m,n),t),In(BoundVar(m,n),u))),
      All(m,n,Iff(In(BoundVar(m,n),t),In(BoundVar(m,n),u))))),genextend G)
      ::M))]



    end) |

(* definition expansion for defined predicates *)

    prightrule (DefProp(s,L)) G M N = 
    let val P = usepropdef(DefProp(s,L)) in
    if P = DefProp(s,L)

    then [Seq(M,(P,G)::N)]

    else [Seq(M,((usepropdef (DefProp(s,L))),genextend G)::N)] end |

    prightrule x G L M = (Say "No right rule applies.";[Seq(L,(x,G)::M)]);


(* special right rule for  equality -- classes with the same extension are
equal.  Abstracts representing proper classes turn out to be urelements.
This scheme is consistent (I have published a proof) and turns out to be
convenient *)

(* val NOLEFTSE = ref false;

fun noleftse() = NOLEFTSE:=true; *)

fun setequals (Seq(L,((Equals(Set(m1,n1,p1),Set(m2,n2,p2))),G)::M)) =

if (!CLASSES) orelse (safetermstratified (Set(m1,n1,p1))
andalso safetermstratified (Set(m2,n2,p2))) then
[Seq(L,((All(m1,n1,(Iff(p1,
topsubsprop m2 n2 (BoundVar(m1,n1)) p2)))),genextend G)::M)]
else (Say "Stratification failure";
[(Seq(L,((Equals(Set(m1,n1,p1),Set(m2,n2,p2))),G)::M))]) |

setequals (Seq(((Equals(Set(m1,n1,p1),Set(m2,n2,p2))),G)::M,L)) =

(* if (!NOLEFTSE) then [(Seq(((Equals(Set(m1,n1,p1),Set(m2,n2,p2))),G)::M,L))]
else *)
if (!CLASSES) orelse (safetermstratified (Set(m1,n1,p1))
andalso safetermstratified (Set(m2,n2,p2))) then
[Seq(((All(m1,n1,(Iff(p1,
topsubsprop m2 n2 (BoundVar(m1,n1)) p2)))),genextend G)::M,L)]
else (Say "Stratification failure";
[(Seq(((Equals(Set(m1,n1,p1),Set(m2,n2,p2))),G)::M,L))])|

setequals x = [x];

(* a try at rules for pairs.  There needs to be more attention to rules
for pairs and projections. *)

(* this rule is expanded to deal with equations with pairs on the
left as well *)

(* note that this works on the right by preference *)

fun pairequals (Seq(L,((Equals(t,Pair(u,v))),G)::M)) =

[Seq(L,((Equals(deproj(Proj1 t),u)),genextend G)::M),
   Seq(L,((Equals(deproj(Proj2 t),v)),genextend G)::M)] |

pairequals (Seq(L,((Equals(Pair(u,v),t)),G)::M)) =

[Seq(L,((Equals(u,deproj(Proj1 t))),genextend G)::M),
Seq(L,((Equals(v,deproj(Proj2 t))),genextend G)::M)] |

pairequals (Seq((((Equals(Pair(u,v),t)),G)::L),M)) =

[Seq(((Equals(u,deproj(Proj1 t)),genextend G)::
(Equals(v,deproj(Proj2 t)),genextend G)::L),M)] |

pairequals (Seq((((Equals(t,Pair(u,v))),G)::L),M)) =

[Seq(((Equals(deproj(Proj1 t),u),genextend G)
::(Equals(deproj(Proj2 t),v),genextend G)::L),M)] |

pairequals x = [x];

(* new rule for projections *)

(* extended to the left side as well --
introduces new free variables *)

fun projequals (Seq(L,((Equals(t,Proj1(u))),G)::M)) =

(NEXTBOUND:=newboundindex(Equals(t,Proj1(u)));let val BoundVar(m,n) = getnewbound(~1) in

[Seq(L,((Some(m,n,Equals((Pair(t,BoundVar(m,n))),u))),genextend G)::M)]

end) |
projequals (Seq(L,((Equals(t,Proj2(u))),G)::M)) =

(NEXTBOUND:=newboundindex(Equals(t,Proj2(u)));let val BoundVar(m,n) = getnewbound(~1) in

[Seq(L,((Some(m,n,Equals((Pair(BoundVar(m,n),t)),u))),genextend G)::M)]

end) |
projequals (Seq(L,((Equals(Proj1(u),t)),G)::M)) =

(NEXTBOUND:=newboundindex((Equals(Proj1(u),t)));(let val BoundVar(m,n) = getnewbound(~1) in

[Seq(L,((Some(m,n,Equals((Pair(t,BoundVar(m,n))),u))),genextend G)::M)]

end)) |

projequals (Seq(L,((Equals(Proj2(u),t)),G)::M)) =

(NEXTBOUND:=newboundindex(Equals(Proj2(u),t));let val BoundVar(m,n) = getnewbound(~1) in

[Seq(L,((Some(m,n,Equals(Pair(BoundVar(m,n),t),u))),genextend G)::M)]

end) |

(* left rules *)

projequals (Seq((((Equals(t,Proj1(u))),G)::L),M)) =

let val FreeVar(n) = getnewfree() in

[Seq((((Equals(Pair(t,FreeVar n),u),genextend G))::L),M)]

end |
projequals (Seq((((Equals(t,Proj2(u))),G)::L),M)) =

let val FreeVar(n) = getnewfree() in

[Seq((((Equals(Pair(FreeVar n,t),u),genextend G))::L),M)]

end |
projequals (Seq((((Equals(Proj1(u),t)),G)::L),M)) =

let val FreeVar(n) = getnewfree() in

[Seq((((Equals(u,Pair(t,FreeVar n)),genextend G))::L),M)]

end  |
projequals (Seq((((Equals(Proj2(u),t)),G)::M),L)) =

let val FreeVar(n) = getnewfree() in

[Seq((((Equals(u,Pair(FreeVar n,t)),genextend G))::L),M)]

end  |

projequals x = [x];

(* eliminate free variables by rewriting *)

(* I think this remains valid if the variables in the equation
are unknown variables so I'm leaving it enabled *)

fun rewritefree (Seq(((Equals(FreeVar n,t)),G1)::L,M)) =
[Seq(map(fn (P,G)=>(Topsubsfreep n t P,if safealphaprop P (Topsubsfreep n t P) 
then genextend G
else genextend(G@G1))) L,
map(fn (P,G)=>(Topsubsfreep n t P,if safealphaprop P (Topsubsfreep n t P) 
then genextend G
else genextend (G@G1))) M)] |
rewritefree (Seq(((Equals(t,FreeVar n)),G1)::L,M)) =
[Seq(map(fn (P,G)=>(Topsubsfreep n t P,if safealphaprop P (Topsubsfreep n t P) 
then genextend G
else genextend(G@G1))) L,
map(fn (P,G)=>(Topsubsfreep n t P,if safealphaprop P (Topsubsfreep n t P)
 then genextend G
else genextend (G@G1))) M)] |
rewritefree x = [x];

(* only substitutes if the unknown is actually found *)

(* fun setunknown n t (Seq(L,M)) = Seq(map (fn (P,G)=>
if not(freevarfoundp (~(abs(n))) P) then (P,G) else
(topsubsfreep (~(abs n)) t P,G)) L,map (fn (P,G)=>
if not(freevarfoundp (~(abs(n))) P) then (P,G) else
(topsubsfreep (~(abs n)) t P,G)) M) |

setunknown n t x = x;

fun setunknowns m t (Node(n,S1,L)) = Node(n,setunknown m t S1,map (setunknowns m t) L) |

setunknowns m t (Goal(n,S)) = Goal(n,setunknown m t S) |

setunknowns m t x = x;

fun setunknownslist nil = () |

setunknownslist ((n,t)::L) = (THEPROOF:=setunknowns n t (!THEPROOF);

   setunknownslist L);

fun fireusubs() = (ububbles(); setunknownslist (!USUBS); USUBS:=nil);
*)
fun Look() = (c1 showseq;Flush());

(* similarly for defined terms *)

(* modified so that it will also expand defined terms in equations
on the left *)

fun defequals (Seq(L,((Equals(DefTerm(t,L2),DefTerm(L1,s)),G)::M))) =

[Seq(L,((Equals(usetermdef(DefTerm(t,L2)),usetermdef(DefTerm(L1,s))),genextend G)::M))] |

defequals (Seq(L,((Equals(DefTerm(L1,s),t),G)::M)))

= [Seq(L,((Equals(usetermdef(DefTerm(L1,s)),t),genextend G)::M))] |

defequals (Seq(L,((Equals(t,DefTerm(L1,s)),G)::M))) =

[Seq(L,((Equals(t,usetermdef(DefTerm(L1,s))),genextend G)::M))] |


defequals (Seq(((Equals(DefTerm(t,L2),DefTerm(L1,s)),G)::M),L)) =

[Seq(((Equals(usetermdef(DefTerm(t,L2)),usetermdef(DefTerm(L1,s))),genextend G)::M),L)] |


defequals (Seq(((Equals(DefTerm(L1,s),t),G)::M),L)) =
[Seq(((Equals(usetermdef(DefTerm(L1,s)),t),genextend G)::M),L)] |

defequals (Seq(((Equals(t,DefTerm(L1,s)),G)::M),L)) =

[Seq(((Equals(t,usetermdef(DefTerm(L1,s))),genextend G)::M),L)] |


defequals x = [x];

(* the three new equality rules which avoid use of sets *)

(* legacy form of left rules *)

fun oldrewriteleft mask (Seq((P,G1)::(Equals(T,U),G2)::L,M)) =

[(Seq((toprewriteprop mask T U P,genextend(G1@G2))::(Equals(T,U),genextend G2)::L,M))];

fun oldconvrewriteleft mask (Seq((P,G1)::(Equals(T,U),G2)::L,M)) =

[(Seq((toprewriteprop mask U T P,genextend(G1@G2))::(Equals(T,U),genextend G2)::L,M))];

(* new form of left rules:  the equation you rewrite with should be
first and the rewritten formula second, because the equation is usually
introduced by cut so starts at the head *)

fun rewriteleft mask (Seq((Equals(T,U),G2)::(P,G1)::L,M)) =

[(Seq((Equals(T,U),G2)::(toprewriteprop mask T U P,genextend(G1@G2))::L,M))]|

rewriteleft mask x = (Say "Left rewrite rule did not apply";[x]);

fun convrewriteleft mask (Seq((Equals(T,U),G2)::(P,G1)::L,M)) =

[(Seq((Equals(T,U),genextend G2)::(toprewriteprop mask U T P,genextend(G1@G2))::L,M))] |

convrewriteleft mask x = (Say "Left rewrite rule did not apply";[x]);

fun rewriteright mask (Seq((Equals(T,U),G1)::L,(P,G2)::M)) =

[Seq((Equals(T,U),genextend G1)::L,(toprewriteprop mask T U P,genextend(G1@G2))::M)] |

rewriteright mask x = (Say"Right rewrite rule did not apply";[x]);

fun convrewriteright mask (Seq((Equals(T,U),G1)::L,(P,G2)::M)) =

[Seq((Equals(T,U),genextend G1)::L,(toprewriteprop mask U T P,genextend(G1@G2))::M)] |

convrewriteright mask x = (Say "Right rewrite rule did not apply";[x]);

fun reflexiveeq (Seq(L,((Equals(T,U),G))::M)) = if safealphaterm T U then []

   else (Say "Reflexivity of equality did not apply";[(Seq(L,((Equals(T,U),G))::M))]) |

reflexiveeq x = (Say "Reflexivity of equality did not apply";[x]);

(* the cut rule *)

fun cut p (Seq(L,M)) = 
let val G = [nextpserial()] in

(NEXTFREE := max((!NEXTFREE),newfreeindex p);
NEXTBOUND:=max((!NEXTBOUND),newboundindex p); 
[Seq((p,G)::L,M),Seq(L,(p,G)::M)])

end;

(* the cut rule in the other order *)

fun cut2 p (Seq(L,M)) = 
let val G = [nextpserial()] in

(NEXTFREE := max((!NEXTFREE),newfreeindex p);
NEXTBOUND:=max((!NEXTBOUND),newboundindex p); 
[Seq(L,(p,G)::M),Seq((p,G)::L,M)])

end;

(* workspace for development of ThmCut *)

(* convert a sequent to a form with new unknown variables *)

fun newunknownsseq (Seq(L,M)) = (setnewunknownsbase();
   Seq(map (fn (x,y) => (newunknownsp x,[nextpserial()])) L,
     map (fn (x,y)=>(newunknownsp x,[nextpserial()])) M));

fun newunknownsthm s = newunknownsseq (thesequent (ProofReference s));

fun thmcutexpand (Seq(nil,nil)) (Seq(L,M)) = [] |

thmcutexpand (Seq(P,x::Q)) (Seq(L,M)) = (Seq(x::L,M))::
                  (thmcutexpand (Seq(P,Q)) (Seq(L,M))) |

thmcutexpand (Seq(x::P,nil)) (Seq(L,M)) = (Seq(L,x::M))::
                  (thmcutexpand (Seq(P,nil)) (Seq(L,M)));

fun thmcut s (Seq(L,M)) = let val S = newunknownsthm s in

(S::(thmcutexpand S (Seq(L,M)))) end;

fun linenolist nil = nil |

linenolist L = (linenolist (tl L))@[length L];

fun seqleftlist (Seq(L,M)) = L;

fun seqrightlist (Seq(L,M)) = M;

(* turn pleftrule and prightrule into functions acting on sequents *)

(* the maybehd function strips off extra conclusions on the right
for constructive logic *)

(* does any special rule introduce extra sequents on the right?
as long as only subsets of pleftrule and prightrule do this, we are
in business *)

fun pleft (Seq((p,G)::L,M)) = pleftrule p G L (maybehd M)   |

    pleft x = [x];

fun pright (Seq(L,(p,G)::M)) = prightrule p G L 
                  (if (!CONSTRUCTIVE) then nil else M)  |

    pright x = [x];


(* view a theorem in the master theorem list *)


fun thmdisplay s = (TextIO.output(TextIO.stdOut,s^":\n\n");
showseq (thesequent(ProofReference s));());

(* get the proof of a theorem in the master theorem list *)

(* this command is currently insecure:  it is necessary to clear
background variables and load all lemmas used in the proof to top
level to make this work correctly; but the facilities exist to do this.

This may now be fixed.  Notice that no lemma of the theorem s
can be modified when this command is loaded, since openprefix
puts all of them in CURRENTLEMMAS. Presumably the reason to load
this proof is to use NameSequent. *)

fun getproof s = (if find s (!THEOREMS) = nil

then say "Proof reference error"

else if hasprefix s then say "Cannot go down more than one level"

else if not(checksaveddefs s)

then ()

else let val A = hd(find s (!THEOREMS)) in 

(CURRENTLEMMAS:=nil;SAVEDPROOFS:=nil;
THEOREMS:= openprefix s(!THEOREMS);
SAVEDDEFS:=openprefix s (!SAVEDDEFS);
showseq (thesequent A);THEPROOF:=A;clearmemory())end);
fun P1(x,y,z,w,u,v) = x; fun P2(x,y,z,w,u,v)=y;fun P3(x,y,z,w,u,v) = z;
fun P4(x,y,z,w,u,v) = w;fun P5(x,y,z,w,u,v)=u;fun P6(x,y,z,u,v,w)=w;

fun restoreproof s = if find s (!SAVEDPROOFS) = nil then say "No proof found"

else (THEPROOF := 
(P6(hd(find s (!SAVEDPROOFS))));NEXTFREE:=P1(hd(find s (!SAVEDPROOFS)));NEXTBOUND:=P2(hd(find s (!SAVEDPROOFS)));TERMDEFS:=P3(hd(find s (!SAVEDPROOFS)));
PROPDEFS:=P4(hd(find s (!SAVEDPROOFS)));STRATINFO:=P5(hd(find s (!SAVEDPROOFS))))

(* this command is OK, as long as only current proofs are being considered *)

(* possibly CURRENTLEMMAS should also be backed up, but not doing this
is only to err on the side of caution *)

(* currently CURRENTLEMMAS does not need to be backed up:  when it
is cleared, so are all saved proofs. *)

(* You should add the current definition lists as components of saved proofs.  *)

fun backupproof s = SAVEDPROOFS:=(s,(!NEXTFREE,!NEXTBOUND,
   !TERMDEFS,!PROPDEFS,!STRATINFO,!THEPROOF))::(!SAVEDPROOFS);

fun prethethm name nil = nil |

prethethm name ((n,serial,seq,prf)::L) = if name = n then [seq] else prethethm name L;

fun thethm name = thesequent(ProofReference name);

(* use a theorem *)

(* AUTOPRUNE UPDATE:  in usethm(2), when a sequent is proved, 
it is automatically
pruned (just the part actually used is shown) *)

fun makesublist nil L = nil |

makesublist (n::M) L = (item n L)@(makesublist M L);




(* the following commands allow the introduction and removal of
nonce capitalized names for free variables *)

(* is there any problem with allowing these in proof printouts? *)

fun WitnessMacro n S = 
(let val s = decapitalize S in

if s <> "" andalso getalpha (explode s) = s then

if find s (!TERMDEFS) <> nil orelse
   find s (!PROPDEFS) <> nil orelse find s (!ADEFS) <> nil

   then Say "Declaration conflict"

   else (ADEFS:=(s,n)::(!ADEFS);ADEFS2:=(n,s)::(!ADEFS2);Look()) 

   else Say "Bad identifier" end;
reportcommand [Mnemonic("wm"),IntegerArg n,StringArg S]);

val wm = WitnessMacro;

fun WitnessUnMacro S = 

(let val s = decapitalize S in

let val L = find s (!ADEFS) in

   if L = nil then Say "No macro to cancel"

   else let val [n] = L in

   (ADEFS := drop s (!ADEFS);ADEFS2:= drop n (!ADEFS2);Look()) end end end;
reportcommand [Mnemonic "wum",StringArg S]);

val wum = WitnessUnMacro;

(* clear all witness macros *)

fun wums() = (ADEFS:=nil;ADEFS2:=nil;Look();
              reportcommand [Mnemonic "wums"]);


fun usethm name L1 L2 (Goal(n,(Seq(L,M)))) = let val TH = thethm name in

if TH = Seq(nil,nil) then (
Say ("UseThm operation failed: no theorem "^name);
(Goal(n,Seq(L,M))))

else

if checksaveddefs name andalso safeseqmatch L1 L2 TH (Seq(L,M)) then (
(*Say"Got to here";*)Node(n,Seq(makesublist L1 L,
makesublist L2 M),[ProofReference name]))
 else (Say ("UseThm operation failed:  match failure with theorem "^name);
Goal(n,Seq(L,M)))

end; 

fun usethm2 name L1 L2 (Goal(n,(Seq(L,M)))) = let val TH = thethm name in

if TH = Seq(nil,nil) then (
Say ("UseThm2 operation failed: no theorem "^name); (Goal(n,Seq(L,M))))

else 

if checksaveddefs name andalso revseqmatch L1 L2 TH (Seq(L,M)) then 

(Node(n,
Seq(makesublist L1 L,makesublist L2 M),[ProofReference name]))
 else (Say ("UseThm operation failed:  match failure with theorem "^name)
;Goal(n,Seq(L,M)))

end; 


(* finish proof of a sequent -- we do 
now recognize equality up to alpha-conversion *)

fun doneseq (Seq((p,g1)::L,(q,g2)::M)) = if safealphaprop p q then nil 

else (Say "Done operation failed";
[(Seq((p,g1)::L,(q,g2)::M))]) |

doneseq x = (say "Sequent is not done!";[x]);

fun extractserial (Goal(n,s)) = "" |

     extractserial (ProofReference t) = "" |

     extractserial (Node(n,s,nil)) = "" |

     extractserial (Node(n,s,[Goal(m,t)])) = (makestring m) |

     extractserial (Node(n,s,[Node(m,t,L)])) = makestring m |

     extractserial (Node(n,s,(Goal(m,t)::L))) = (makestring m)^", "^(extractserial (Node(n,s,L))) |

     extractserial (Node(n,s,(Node(m,t,L)::M))) = (makestring m)^", "^(extractserial (Node(n,s,M))) |

     extractserial (Node(n,s,[ProofReference t])) = t |

     extractserial (Node(n,s,((ProofReference t)::L))) = t^", "^(extractserial (Node(n,s,L)));

(* displays proved sequents and unresolved goals in a proof *)

(* shows proofs of lemmas the first time they appear *)

val SHOWNSUBPROOFS = ref ["bogus"];

val _ = SHOWNSUBPROOFS:= nil;

fun showsubproof s = let val T = not(foundin s (!SHOWNSUBPROOFS))
in (SHOWNSUBPROOFS:=s::(!SHOWNSUBPROOFS);T) end;

fun topseqdisplay (Node(n,s,L)) = seqdisplay s;

fun showdefs header printfun defcon equ nil = "\n\n"^header^"\n\n" |

showdefs header printfun defcon equ ((s,(T,U))::L) =(showdefs header printfun defcon equ L)^
"\n"^(printfun (defcon(s,T)))^" "^equ^" "^(CURSOR:=0;printfun U)^"\n";

fun showtermdefs() = showdefs "Term definitions:" termdisplay DefTerm "=" (!TERMDEFS);

fun showpropdefs() = showdefs "Predicate definitions:" propdisplay DefProp "==" (!PROPDEFS);

val LEMMAMODE = ref true;

fun inlemmamode() = (!LEMMAMODE) =true;

fun showproof file pausing prefix (Goal (n,s)) = (if pausing then TextIO.input(TextIO.stdIn) else "";TextIO.flushOut(file);TextIO.output(file,"\nLine "^
(attachprefix prefix (makestring n))^":  "^"\n----Goal-----\n"^(seqdisplay s))) |

showproof file pausing prefix (ProofReference s) = 

if inlemmamode() then

let val
S = attachprefix prefix s in

if find S (!THEOREMS) = nil then 

if hasprefix prefix orelse islocked s then 

(TextIO.output(file,"\n\nWarning:  looking up one level for lemma.\n\n");
showproof file pausing (stringreverse(deprefix(stringreverse prefix)))
(ProofReference s))

else (TextIO.output(file,"\n\nProof reference error!\n\n"))

else if showsubproof S then 

if extractserial(hd(find S (!THEOREMS))) = s

then TextIO.output(file,"\n\n"^S^" is an axiom:\n\n"^(topseqdisplay(hd(find S (!THEOREMS))))^"end of display of axiom "^S^"\n\n")
else
(TextIO.output(file,"\n\nProof of lemma "^S^" starts:\n\n");
showproof file pausing S (hd(find S (!THEOREMS)));
TextIO.output(file,"\n\nProof of lemma "^S^" ends\n\n"))
else () end

else TextIO.flushOut(file)

 |

showproof file pausing prefix (Node (n,s,L))  = if thegoal (Node(n,s,L)) = nil 

  then (if pausing then TextIO.input(TextIO.stdIn) else "";
  TextIO.flushOut(file);
  TextIO.output(file,"\nLine "^(attachprefix prefix (makestring n))
^":  "
^"\n----------Proved---------\n"
^(seqdisplay s)
^(if L=nil then "" else " by ")
^(attachprefix prefix (extractserial(Node(n,s,L))))^"\n");
  map(showproof file pausing prefix)L;())
  else
(if pausing then TextIO.input(TextIO.stdIn) else "";TextIO.flushOut(file);
TextIO.output(file,"\nLine "^(attachprefix prefix (makestring n))
^":  "
^"\n----------Not Proved---------\n"
^(seqdisplay s)
^(if L=nil then "" else " by "
^(attachprefix prefix (extractserial(Node(n,s,L))))));
map (showproof file pausing prefix) L;());

(* namesequent now adds localized references to lemmas used in proofs *)

fun fixline n s (Node(m,S,L)) = if m=n 
   andalso find s (!THEOREMS) <> nil
   then (Node(m,S,[ProofReference s]))
   else if m=n then (Node(m,S,L)) else
   (Node(m,S,map (fixline n s) L)) |

   fixline n s x = x;

(* function now modified to report error conditions *)

fun namesequent line name (Goal (n,s)) = if line = n then (Say ("Can't record a goal as theorem "^name);()) else ()|

namesequent line name (ProofReference s) = (
if find s (!THEOREMS) = nil then 

(Say ("Proof reference error found in claimed proof of "^name);()) else

(* don't copy "locked" toplevel theorems *)

if showsubproof s andalso not (islocked s) then

(THEOREMS:=addprefix name s (!THEOREMS);
SAVEDDEFS:=addprefix name s (!SAVEDDEFS))

else ()) |

namesequent line name (Node (n,s,L)) = 
if line = n andalso thegoal (Node(n,s,L)) = nil
   then (THEOREMS:= safeadd name (Node(n,s,L)) (!THEOREMS);
   SAVEDDEFS:= safeadd name (!TERMDEFS,!PROPDEFS,!STRATINFO) (!SAVEDDEFS);
   thmdisplay name;map(namesequent line name)L;()) 

else if line = n andalso thegoal (Node(n,s,L)) <> nil

   then (Say ("Cannot record unproved sequent as theorem "^name);())

(* might want to set things up to restore state of theorem list
in this bad case *)

else (map (namesequent line name) L;())

   
(* display the proved sequents and goals remaining to be proved in the given proof *)


fun showall () = (SHOWNSUBPROOFS:=nil;
(* say (showtermdefs()); TextIO.flushOut(TextIO.stdOut);
say (showpropdefs()); TextIO.flushOut(TextIO.stdOut); *)
showproof (TextIO.stdOut) true "" (!THEPROOF));

val FILE = ref (TextIO.openOut("dummy"));

fun saveproof s = (SHOWNSUBPROOFS:=nil;(FILE := TextIO.openOut(setdir(s^".prf")); 
TextIO.output((!FILE),showtermdefs());  TextIO.output((!FILE),showpropdefs());
showproof (!FILE) false "" (!THEPROOF); TextIO.closeOut (!FILE)));

(* Now I need a parser *)

(* No comments on this -- for syntax see comments under the display functions above *)

fun preparsenumeral n nil = n |

   preparsenumeral n (#"0"::L) = preparsenumeral (10*n) L |

   preparsenumeral n (#"1"::L) = preparsenumeral (10*n+1) L |

   preparsenumeral n (#"2"::L) = preparsenumeral (10*n+2) L |

   preparsenumeral n (#"3"::L) = preparsenumeral (10*n+3) L |

   preparsenumeral n (#"4"::L) = preparsenumeral (10*n+4) L |   

   preparsenumeral n (#"5"::L) = preparsenumeral (10*n+5) L |   

   preparsenumeral n (#"6"::L) = preparsenumeral (10*n+6) L |   

   preparsenumeral n (#"7"::L) = preparsenumeral (10*n+7) L |   

   preparsenumeral n (#"8"::L) = preparsenumeral (10*n+8) L |   

   preparsenumeral n (#"9"::L) = preparsenumeral (10*n+9) L |   

   preparsenumeral n L = n;   

fun parsenumeral n = preparsenumeral 0 n;

fun restnumeral nil = nil |

   restnumeral (#"0"::L) = restnumeral L |

   restnumeral (#"1"::L) = restnumeral L |

   restnumeral (#"2"::L) = restnumeral L |

   restnumeral (#"3"::L) = restnumeral L |

   restnumeral (#"4"::L) = restnumeral L |

   restnumeral (#"5"::L) = restnumeral L |

   restnumeral (#"6"::L) = restnumeral L |

   restnumeral (#"7"::L) = restnumeral L |

   restnumeral (#"8"::L) = restnumeral L |

   restnumeral (#"9"::L) = restnumeral L |

   restnumeral L = L;

(* a term begins with x (a bound variable), a (a new variable),
"{" (a set), "<" (a pair) or "p" (a projection)

if it begins with a, read a numeral and record a free variable

if it begins with x, read a numeral for the index.  If the next character
is not ^, stop -- if it is ^, read a numeral for the type (if no explicit
type is given record type ~1)

if it begins with {, read a bound variable and record its index and type;
the next character must be |; read a proposition; the next character must be }; stop.

if it begins with <, read a term, read a following ",", read a term, read a following ">", stop.
if it begins with p, read a numeral (which must be 1 or 2) to determine which
projection, then read a (, a term, and a ), then stop.

a proposition begins with P (a variable), ~ (a negation),
( (an infix or quantified expression -- look at the next character
to recognize a quantified expression) or the first character of some
term (an equation or membership sentence)

If you read P, read a numeral record a propositional variable and stop.

If you read (, read the next character:  if it is & or v we have the appropriate
quantifier:  read a bound variable, then read ".", then read a proposition, then read )

otherwise, read a proposition, then read a character.  If it is &, v we have
a conjunction or disjunction.  Read a proposition, then read ) then stop.

if it is -, read > then read a proposition then read ) then stop.

if it is =, read the next character -- if it is = read a proposition then stop.

if it is /, read = then a proposition then stop.

if it is a term-starting character, read a term then read the following character
(E or =) then read a term, then stop.

if it is ~ we have a negation -- read a proposition, then stop.

Use P~1 for the error proposition and a~1 for the error term.

spaces are completely ignored.

Now we also have propositional variables with argument lists (class variables).

If it begins with #, we have a defined predicate.

 *)

(* utility for order of operations *)

fun prepend x "==" y = Iff(x,y) |

prepend x "=/=" y = Xor(x,y) |

prepend x s (Iff(y,z)) = (Iff(prepend x s y,z)) |

prepend x s (Xor(y,z)) = (Iff(prepend x s y,z)) |

prepend x "->" y = If(x,y) |

prepend x "<-" y = ConvIf(x,y) |

prepend x s (If(y,z)) = If(prepend x s y,z) |

prepend x "v" y = Or(x,y) |

prepend x s (Or(y,z)) = Or(prepend x s y,z) |

prepend x "&" y = And(x,y) |

prepend x s y = PropVar(~1,nil);

(* prepend for terms *)

fun prependt x s (DefTerm(t,[T,U])) = 

if termrightstickiness(DefTerm(t,[T,U])) < 2*(prec s)+1

then DefTerm(t,[prependt x s T,U])

else DefTerm(s,[x,DefTerm(t,[T,U])]) |

prependt x s y = DefTerm(s,[x,y]);

fun getpropinfix nil = "" |

getpropinfix (#"&"::L) = "&" |

getpropinfix (#"v"::L) = "v" |

getpropinfix (#"-"::(#">"::L)) = "->" |

getpropinfix (#"<"::(#"-"::L)) = "<-" |

getpropinfix (#"="::(#"="::L)) = "==" |

getpropinfix (#"="::(#"/"::(#"="::L))) = "=/=" |

getpropinfix L = "";

fun restpropinfix nil = nil |

restpropinfix (#"&"::L) = L |

restpropinfix (#"v"::L) = L |

restpropinfix (#"-"::(#">"::L)) = L |

restpropinfix (#"<"::(#"-"::L)) = L |

restpropinfix (#"="::(#"="::L)) = L |

restpropinfix (#"="::(#"/"::(#"="::L))) = L |

restpropinfix L = L;



fun preparseterm1 (#"a"::L) = FreeVar (parsenumeral L) |

preparseterm1 (#"U"::L) = FreeVar (~(parsenumeral L)) |

preparseterm1 (#"x"::L)  = let val INDEX = parsenumeral L and REST1 =
   restnumeral L in   if REST1 = nil orelse hd (REST1) <> #"^"
   then BoundVar (INDEX,~1) else BoundVar(INDEX,parsenumeral (tl REST1)) end|

preparseterm1 (#"<"::L) = let val TERM1 = preparseterm L and REST1 =
restparseterm L in

if REST1 = nil orelse hd(REST1) <> #"," then FreeVar 0
else let val TERM2 = preparseterm (tl REST1) and REST2 = restparseterm (tl REST1) in

if REST2 = nil orelse hd(REST2)<> #">" then FreeVar 0 else depair(Pair(TERM1,TERM2))

end 

end |

preparseterm1 (#"p"::L) = if L = nil then FreeVar 0

else if hd L = #"1" then if tl L = nil orelse hd(tl L) <> #"(" then FreeVar 0

else let val TERM = preparseterm1 (tl(tl L)) and REST = restparseterm1 (tl(tl L)) in

if REST = nil orelse hd REST <> #")" then FreeVar 0 else deproj(Proj1 TERM)

end

else if  hd L = #"2" then if tl L = nil orelse hd(tl L) <> #"(" then FreeVar 0

else let val TERM = preparseterm1 (tl(tl L)) and REST = restparseterm1 (tl(tl L)) in

if REST = nil orelse hd REST <> #")" then FreeVar 0 else deproj(Proj2 TERM)

end

else FreeVar 0 |

preparseterm1 (#"{"::L) =   if L = nil then FreeVar 0

else if hd L <> #"x" then FreeVar 0

else let val INDEX = parsenumeral (tl L) and REST1 = restnumeral (tl L) in

if REST1 = nil then FreeVar 0 else

let val TYPE = if hd(REST1) = #"^" then parsenumeral (tl REST1) else ~1

and REST2 = if hd REST1 <> #"^" then REST1 else restnumeral (tl REST1) in

if REST2 = nil orelse hd REST2 <> #"|" then FreeVar 0

else let val PROP = preparseprop (tl REST2) and REST3 = restparseprop (tl REST2) in

if REST3 = nil orelse hd REST3 <> #"}" then FreeVar 0 

else Set(INDEX,TYPE,PROP)

end end end |

preparseterm1 (#"*"::L) = if L = nil then FreeVar 0

else let val s = getalpha L and L2 = restalpha L in

if s = "" then FreeVar 0

else if  L2 = nil orelse hd L2 <> #"(" then DefTerm(s,nil)

else let val M = getarglist (tl L2) in

DefTerm(s,M)

end end |

preparseterm1 (#"["::L) =

let val A = preparseterm L and B = restparseterm L in

if B = nil then FreeVar 0

else if hd B = #"," then Pair(A,preparseterm1 ((#"[")::(tl B)))

else if hd B <> #"]" then FreeVar 0

else Fake A

end |

preparseterm1 L = FreeVar 0

and restparseterm1 (#"a"::L) =  restnumeral L |

restparseterm1 (#"U"::L) = restnumeral L |

restparseterm1 (#"x"::L)  = let val REST1 = restnumeral L in 
if REST1 = nil orelse hd (REST1) <> #"^" then REST1 else restnumeral(tl REST1) end |

restparseterm1 (#"<"::L) =  let val REST1 = restparseterm L in

if hd(REST1) <> #"," then nil else let val REST2 = restparseterm(tl REST1) in

if REST2 = nil orelse hd REST2 <> #">" then nil else tl REST2 end end |

restparseterm1 (#"p"::L) = if L = nil then nil

else if hd L = #"1" orelse hd L = #"2" then if tl L = nil then nil

else if hd(tl L) <> #"(" then nil 

else let val REST = restparseterm1 (tl(tl(L))) in

if REST = nil orelse hd REST <> #")" then nil else tl REST

end

else nil|

restparseterm1 (#"{"::L) = if L = nil then nil

else if hd L <> #"x" then nil

else let val REST1 = restnumeral (tl L) in

if REST1 = nil then nil else

let val REST2 = if hd REST1 <> #"^" then REST1 else restnumeral (tl REST1) in

if REST2 = nil orelse hd REST2 <> #"|" then nil

else let val REST3 = restparseprop (tl REST2) in

if REST3 = nil orelse hd REST3 <> #"}" then nil 

else tl REST3

end end end |

restparseterm1 (#"*"::L) =  let val REST1 = restalpha L

in if REST1 = nil orelse (hd REST1) <> (#"(") then REST1

else restarglist (tl REST1) end |

restparseterm1 (#"["::L) = 

let val A = preparseterm L and B = restparseterm L in

if A = FreeVar 0 orelse B = nil then nil

else if hd B = #"," then restparseterm1 ((#"[")::(tl B))

else if hd B <> #"]" then nil

else tl B end |

restparseterm1 L = L

and preparseterm L = let val FIRST = preparseterm1 L 
and REST = restparseterm1 L in

if REST = nil orelse hd REST <> #"*" then FIRST

else let val INFIX = getalpha (tl REST) and REST2 = restalpha (tl REST) in

if INFIX = "" then FreeVar 0 

else prependt FIRST INFIX (preparseterm REST2)

end end

and restparseterm L = 

let val FIRST = preparseterm1 L and REST = restparseterm1 L in

if REST = nil orelse hd REST <> #"*" then REST

else let val INFIX = getalpha (tl REST) and REST2 = restalpha (tl REST) in

if INFIX = "" then nil else restparseterm REST2 

end end

and preparseprop1 (#"P"::L) = let val INDEX = parsenumeral L and REST = restnumeral L
in if REST = nil orelse hd REST <> #"(" then PropVar (INDEX,nil)

else let val LIST = getarglist (tl REST) and REST2 = restarglist (tl REST)

in PropVar(INDEX,LIST)

end  end |

preparseprop1 (#"#"::L) = let val s = getalpha L and L2 = restalpha L in

if s = "" then PropVar (~1,nil)

else if L2 = nil orelse hd L2 <> #"(" then DefProp(s,nil)

else let val M = getarglist (tl L2)

in DefProp(s,M)

end end |


preparseprop1 (#"~"::L) = Not (preparseprop1 L)|

preparseprop1 (#"("::L) = 

if L = nil then PropVar(~1,nil)

else if hd L = #"&"  orelse hd L = #"A" then

if tl L = nil orelse hd (tl L) <> #"x" then PropVar(~1,nil)

else let val INDEX = parsenumeral (tl(tl L)) and REST1 = restnumeral (tl(tl L)) in

if REST1 = nil then PropVar(~1,nil)

else let val TYPE = if hd REST1 = #"^" then parsenumeral (tl REST1) else ~1
and REST2 = if hd REST1 = #"^" then restnumeral (tl REST1) else REST1 in

if REST2 = nil orelse hd REST2 <> #"." then PropVar(~1,nil) 

else let val PROP = preparseprop (tl REST2) and REST3 = restparseprop (tl REST2) in

if REST3 = nil orelse hd REST3 <> #")" then PropVar(~1,nil)

else All(INDEX,TYPE,PROP)

end end end

else if hd L = #"v" orelse hd L = #"E" then

if tl L = nil orelse hd (tl L) <> #"x" then PropVar(~1,nil)

else let val INDEX = parsenumeral (tl(tl L)) and REST1 = restnumeral (tl(tl L)) in

if REST1 = nil then PropVar(~1,nil)

else let val TYPE = if hd REST1 = #"^" then parsenumeral (tl REST1) else ~1
and REST2 = if hd REST1 = #"^" then restnumeral (tl REST1) else REST1 in

if REST2 = nil orelse hd REST2 <> #"." then PropVar(~1,nil) 

else let val PROP = preparseprop (tl REST2) and REST3 = restparseprop (tl REST2) in

if REST3 = nil orelse hd REST3 <> #")" then PropVar(~1,nil)

else Some(INDEX,TYPE,PROP)

end end end

else let val P1 = preparseprop L

and L2 = restparseprop L in

if L2 = nil orelse hd L2 <> #")" then PropVar(~1,nil) else Parenthesis P1 end

|

preparseprop1 L =   let val T1 = preparseterm L 

and L2 = restparseterm L in

if L2 = nil then PropVar(~1,nil)

else if hd L2 = #"=" then let val T2 = preparseterm (tl L2) and
L3 = restparseterm (tl L2) in

Equals(T1,T2)

end 

(* case of defined infix predicate *)

else if hd L2 = #"#" then let val A = getalpha (tl L2) and
B = restalpha (tl L2) in

if find A (!PROPDEFS) <> nil orelse foundin A (!MAYBEPROP)

then DefProp(A,[T1,preparseterm B])

else PropVar(~1,nil)

end

else if hd L2 = #"E" then let val T2 = preparseterm (tl L2) (* and
L3 = restparseterm (tl L2) *) in

In(T1,T2)

end 

else if hd L2 = #"R" then let val INDEX = parsenumeral(tl L2)

in 

if restnumeral (tl L2) = nil then PropVar(~1,nil)

else let val T2 = preparseterm(restnumeral(tl L2)) in PropVar(INDEX,[T1,T2])

end end

else PropVar(~1,nil)

end

and restparseprop1 (#"P"::L) = let val REST1 = restnumeral L in 

if REST1 = nil orelse hd REST1 <> #"(" then REST1

else restarglist (tl REST1)

end |

restparseprop1 (#"#"::L) = let val REST1 = restalpha L

in if REST1 = nil orelse hd REST1 <> #"(" then REST1

else restarglist (tl REST1) end |

restparseprop1 (#"~"::L) = restparseprop1 L |

restparseprop1 (#"("::L) = if L = nil then nil

else if hd L = #"&"  orelse hd L = #"v" orelse hd L = #"A"  orelse hd L = #"E" then

if tl L = nil orelse hd (tl L) <> #"x" then nil

else let val REST1 = restnumeral (tl(tl L)) in

if REST1 = nil then nil

else let val REST2 = REST1 in

if REST2 = nil orelse hd REST2 <> #"." then nil

else let val REST3 = restparseprop (tl REST2) in

if REST3 = nil orelse hd REST3 <> #")" then nil

else tl REST3

end end end


else let val L2 = restparseprop L in

 if L2 = nil orelse hd L2 <> #")" then nil

else tl L2

end |

restparseprop1 L = let val L2 = restparseterm L in

if L2 = nil then nil

else if hd L2 = #"=" then restparseterm (tl L2)

else if hd L2 = #"#" then let val A = getalpha (tl L2)
and B = restalpha (tl L2) in

if find A (!PROPDEFS) <> nil orelse foundin A (!MAYBEPROP)

then

restparseterm B else nil

end


else if hd L2 = #"E" then let val T2 = preparseterm (tl L2) (* and
L3 = restparseterm (tl L2) *) in

restparseterm (tl L2)

end 

else if hd L2 = #"R" andalso (restnumeral (tl L2)<>nil) then 
restparseterm (restnumeral (tl L2))
 
else nil

end

and preparseprop L = let val FIRST = preparseprop1 L and REST = restparseprop1 L

in let val INFIX = getpropinfix REST in 

if INFIX = "" then FIRST

else prepend FIRST INFIX (preparseprop (restpropinfix REST))

end end

and restparseprop L = let val REST = restparseprop1 L in

let val INFIX = getpropinfix REST in

if INFIX = "" then REST else restparseprop (restpropinfix REST)

end end

and 

getarglist nil = nil |

getarglist L = let val FIRST = preparseterm L and REST = restparseterm L in

if REST = nil orelse (hd REST <> #"," andalso hd REST <> #")") then [FreeVar 0]
else if hd REST = #")" then [FIRST]
else FIRST::(getarglist (tl REST)) end

and restarglist nil = nil |

    restarglist L = let val REST = restparseterm L in

    if REST = nil orelse (hd REST <> #"," andalso hd REST <> #")") then nil

    else if hd REST = #")" then tl REST

    else restarglist (tl REST) end;


fun parseterm t = dparent(preparseterm(strip(explode t)));

fun parseprop p = (if restparseprop(strip(explode p)) = nil

   then ()

   else Say ("Parse error:  did not parse entire string \""^p^"\"");

dparenp(preparseprop(strip(explode p)))) 

(* user commands *)

(* lock a theorem so that it can't be changed and won't be copied into
lemmas inside proofs *)

fun Lock s = (LOCKED := s::(!LOCKED);
             reportcommand [Mnemonic "Lock",StringArg s]);

(* turn on and off display of lemmas by showproof *)

fun NoLemmas() = LEMMAMODE:=false;

fun ShowLemmas() = LEMMAMODE:=true;

(* takes a string argument, parses it as a proposition and sets up the initial
state of a proof of that proposition *)

fun Start s = (let val S = parseprop s in if Parseerror S then Say "Parse error!" else(resetserial();
if thegoal (!THEPROOF) <> nil then Say "Warning:  proof not complete" else ();
trytoprove (S); c1 (fn x => x)) end;backup();
reportcommand[Mnemonic "Start",StringArg s]);

val s = Start;

fun FreshStart s = (let val S = parseprop s in if Parseerror S 
then say "Parse error!" else(resetserial();

trytoprove2 (S); c1 (fn x => x)) end; backup();
reportcommand[Mnemonic "FreshStart",StringArg s]);

fun StartSequent L M = let val A = map parseprop L

and B = map parseprop M in

if map Parseerror (A@B) <> map (fn x=>false) (A@B)
then Say "Parse error!" else

(resetserial();

if thegoal (!THEPROOF) <> nil then Say "Warning: proof not complete" else ();

startsequent A B; c1 (fn x=>x);backup();

reportcommand[Mnemonic "StartSequent",StringListArg L,StringListArg M])

end;

val ss = StartSequent;

(* I hope that this pages through all the goals in the proof *)
(* I believe that what happens is that we put the current goal absolutely
last at all levels and the effect of iteration is to look at the next
goal in each branch of the proof (change top level branches before
lower level branches) *)

fun NextGoal() = 
(THEPROOF:=nextgoal(!THEPROOF);Look();backup();reportcommand [Mnemonic "NextGoal"]);

val ng = NextGoal;

(* takes an integer argument n -- rotates the nth item in the left list of the
sequent currently under observation to the front *)

fun GetLeft n = ((c1 (getleft n);backup());
                reportcommand[Mnemonic "gl",IntegerArg n]);

val gl = GetLeft;

fun GetLeft2 n = ((c1 (getleft2 n);backup());
                reportcommand[Mnemonic "gl2",IntegerArg n]);

val gl2 = GetLeft2;

(* similarly, rotates nth item on right of sequent to front *)

fun GetRight n = ((c1 (getright n);backup());
                 reportcommand[Mnemonic "gr",IntegerArg n]);

val gr = GetRight;

fun GetRight2 n = ((c1 (getright2 n);backup());
                 reportcommand[Mnemonic "gr2",IntegerArg n]);

val gr2 = GetRight2;

(* remove propositions that are not needed from sequents *)

fun PruneLeft n = ((c1 (pruneleft n);backup());
                  reportcommand[Mnemonic "pl",IntegerArg n]);

val pl = PruneLeft;

fun PruneRight n = ((c1(pruneright n);backup());
                   reportcommand[Mnemonic "pr",IntegerArg n]);

val pr = PruneRight;

(* removes all unused propositions from proofs *)

fun AutoPrune() = (autoprune();backup();
                  reportcommand[Mnemonic "AutoPrune"]);

val ap = AutoPrune;


(* records proved status of a sequent in which the first items on left
and right are the same (up to renaming of bound variables) *)

fun Done() = ((c2 doneseq;backup());
                  reportcommand[Mnemonic "Done"]);

val d = Done;


(* apply sequent rule suggested by the form of the first term on the left *)

fun LeftRule() = ((c2 pleft;backup());
                  reportcommand[Mnemonic "l"]);

val l = LeftRule;

fun LeftRules() = ((c2s pleft;backup());
                   reportcommand[Mnemonic "LeftRules"]);

(* apply sequent rule suggested by the form of the first term on the right *)

fun RightRule() = ((c2 pright;backup());
                   reportcommand[Mnemonic "r"]);

val r = RightRule;

fun RightRules() = ((c2s pright;backup());
                    reportcommand[Mnemonic "RightRules"]);

(*  new shortcuts *)

fun Gl n = (gl n;l());

fun Gr n = (gr n; r());

fun Triv m n = (gl m;gr n;Done());


(* apply left rule for universal quantifier or right rule for existential quantifier --
it will look on the left first *)

fun Witness t = 
(let val T = parseterm t in if parseerror T then Say "Parse error!" else
(c2 (witnessrule (T));backup()) end;
reportcommand [Mnemonic "w",StringArg t]);

val w = Witness;

(* the same, but looks on right first *)

fun Witness2 t = (let val T = parseterm t in 
if parseerror T then Say "Parse error!" else
(c2 (witnessrule2 (T));backup()) end;
reportcommand [Mnemonic "w2",StringArg t]);

val w2 = Witness2;

(* apply special right set equality rule *)

fun SetEquals() = ((c2 setequals;backup());
                  reportcommand[Mnemonic "SetEquals"]);

val se = SetEquals;

(* apply special right pair equality rule *)

fun PairEquals() = ((c2 pairequals;backup());
                   reportcommand[Mnemonic "PairEquals"]);

val pe = PairEquals;

(* apply special right projection equality rule *)

fun ProjEquals() = ((c2 projequals;backup());
                   reportcommand[Mnemonic "ProjEquals"]);

val pre = ProjEquals;

(* eliminate free variables by rewriting *)

fun RewriteFree() = ((c2 rewritefree;backup());
                     reportcommand[Mnemonic "RewriteFree"]);
val rf = RewriteFree;

(* added the restriction that of course one can only replace
Ui with objects already in the proof when Ui was introduced *)

(* so with this version be sure to get all the witnesses you are entitled
to before starting to get unknowns *)

(* a smarter upgrade will allow anything to be put in but suitably
reindex the Ui and the ai's which depend on it *)

fun SetUnknown n t = (
                     if termfreeindex (parseterm t) < n then
                     ((* NEXTBOUND:=max(termboundindex t,(!NEXTBOUND)); *)
                     THEPROOF:=
           (* changeseq1 resetindices0 *) (setunknowns n (parseterm t) (!THEPROOF)))
                     else Say ("Term replacing U"^(makestring n)^" cannot contain free or unknown variable with index "^(makestring n)^" or higher");
                     backup();Look();
                     reportcommand[Mnemonic "su",
                          IntegerArg n,StringArg t]);
val su = SetUnknown;

(* apply special defined term equality rule *)

fun DefEquals() = ((c2 defequals;backup());
                     reportcommand[Mnemonic "DefEquals"]);

val de = DefEquals;

fun OldRewriteleft mask = ((c2 (oldrewriteleft mask);backup());
                     reportcommand[Mnemonic "oldrwl",IntegerArg mask]);

val oldrwl = OldRewriteleft;

fun Rewriteleft mask = ((c2 (rewriteleft mask);backup());
                     reportcommand[Mnemonic "rwl",IntegerArg mask]);

val rwl = Rewriteleft;

fun Rewriteright mask = ((c2 (rewriteright mask);backup());
                     reportcommand[Mnemonic "rwr",IntegerArg mask]);

val rwr = Rewriteright;

fun Convrewriteleft mask = ((c2 (convrewriteleft mask);backup());
                     reportcommand[Mnemonic "crwl",IntegerArg mask]);

val crwl = Convrewriteleft;

fun OldConvrewriteleft mask = ((c2 (oldconvrewriteleft mask);backup());
                     reportcommand[Mnemonic "oldcrwl",IntegerArg mask]);

val oldcrwl = Convrewriteleft;

fun Convrewriteright mask = ((c2 (convrewriteright mask);backup());
                     reportcommand[Mnemonic "crwr",IntegerArg mask]);
val crwr = Convrewriteright;

fun Reflexiveeq() = ((c2 reflexiveeq;backup());
                     reportcommand[Mnemonic "Reflexiveeq"]);

val re = Reflexiveeq;

fun Cut p = (let val P = parseprop p in if Parseerror P then 
Say "Parse error!" else
(c2 (cut (P));backup()) end;reportcommand [Mnemonic "Cut",StringArg p]);

val c = Cut;

fun Cut2 p = (let val P = parseprop p in if Parseerror P then 
Say "Parse error!" else
(c2 (cut2 (P));backup()) end;reportcommand [Mnemonic "Cut2",StringArg p]);

val cc = Cut2;

(* added security so theorems which have been used in the current
proof cannot be modified *)

(* modified this so that names which are not in fact names of theorems
cannot be locked *)

fun UseThm name L1 L2 = ((
   if thethm name <> Seq(nil,nil) then
   CURRENTLEMMAS:=name::(!CURRENTLEMMAS) else ();
   c3 (usethm name L1 L2);backup());
   reportcommand[Mnemonic "UseThm",StringArg name,IntegerListArg L1,
                 IntegerListArg L2]);

val u = UseThm;

fun ThmCut s = (c2 (thmcut s); if thethm s <> Seq(nil,nil) then
CURRENTLEMMAS:=s::(!CURRENTLEMMAS) else ();
c3 (usethm s
(linenolist(seqleftlist(thesequent(ProofReference s)))) 
(linenolist(seqrightlist(thesequent(ProofReference s)))));
backup(); reportcommand[Mnemonic "ThmCut",StringArg s]);

val VersionDate = versiondate;

(* use theorem, matching consequences first *)

fun UseThm2 name L1 L2 = ((if thethm name <> Seq(nil,nil) then CURRENTLEMMAS:=name::(!CURRENTLEMMAS)  else ();
    c3 (usethm2 name L1 L2);backup());
    reportcommand[Mnemonic "UseThm2",StringArg name,IntegerListArg L1,
                 IntegerListArg L2]);
val u2 = UseThm2;

(* introduce a user-defined sequent as an axiom *)

fun gparseprop p =
(parseprop p,[nextpserial()]);

fun Axiom name L M = 
(if map Parseerror (map parseprop L)<> map (fn x=>false) L orelse  map Parseerror (map parseprop M)<> map (fn x=>false) M
then Say ("Parse error in proposed axiom "^name) else
if foundin name (!AXIOMS) orelse foundin name (!CURRENTLEMMAS)
then Say "Cannot change axiom or current lemma" 
else if map alldefinedprop (map parseprop L) <> map (fn x=> true) L
orelse map alldefinedprop (map parseprop M) <> map (fn x=>true) M
then Say "Undefined concepts appear in proposed axiom"
else (AXIOMS:=name::(!AXIOMS);
THEOREMS:=(name,Node(getnewserial(),Seq(map gparseprop L,map gparseprop M),[ProofReference name]))::(!THEOREMS);
SAVEDDEFS:= safeadd name (!TERMDEFS,!PROPDEFS,!STRATINFO) (!SAVEDDEFS);
thmdisplay name);
reportcommand[Mnemonic "Axiom",StringArg name,StringListArg L,StringListArg M]);

(* I am now having the definition functions record stratification
information.  An error message will be registered if the stratification
doesn't work, but for the moment the definition will be recorded anyway *)

fun strattest1 P = stratified (parseprop P);

fun strattest2 T = termstratified (parseterm T); 


(* The stratification algorithm used is not total, though it ought to
usually work, and in any event could be fixed by using typed variables
in the definitions *)

fun defineprop (DefProp(s,L)) p typelist = 

(if isdefpropleft (DefProp(s,L)) andalso p = DefProp(s,L)

andalso (not(isspecial (hd(explode s)))orelse length L = 2)

(* primitive notions *)
then (PROPDEFS:=(s,(L,p))::(!PROPDEFS);
ARITIES:=(s,length L)::(!ARITIES);
STRATINFO:=
(s,(length typelist=length L,
if length typelist = length L then typelist else nil))::(!STRATINFO);
say "Primitive predicate notion declared")

else if isdefpropleft (DefProp(s,L))

andalso alldefinedprop p 

andalso (not(isspecial(hd(explode s))) orelse length L = 2)

then (PROPDEFS:=(s,(L,p))::(!PROPDEFS);
ARITIES:=(s,length L)::(!ARITIES);
STRAT:=nil; (* typelistassign L typelist; *)
(let val S = stratified p in
if S then STRATINFO:=(s,(true,map typeof L))::(!STRATINFO)
else (Say "Stratification failed";STRATINFO:=(s,(false,nil))::(!STRATINFO))
end);
say (propdisplay(DefProp(s,L))^" == "^(CURSOR:=0;propdisplay p)))

else Say "Definition failed") |

defineprop x p  typelist = Say "Definition failure";

fun defineterm (DefTerm(s,L)) p typelist = 

(if isdeftermleft (DefTerm(s,L)) andalso p = DefTerm(s,L)
andalso (not(isspecial(hd (explode s))) orelse length L = 2)
(* primitive notion *)
then (TERMDEFS:=(s,(L,p))::(!TERMDEFS);
ARITIES:=(s,length L)::(!ARITIES);
STRATINFO:=
(s,(length typelist=1+length L,
if length typelist = 1+length L then typelist else nil))::(!STRATINFO);
say "Primitive object notion declared")

else if isdeftermleft (DefTerm(s,L))

andalso alldefinedterm p 

andalso (not(isspecial(hd (explode s))) orelse length L = 2)

then (TERMDEFS:=(s,(L,p))::(!TERMDEFS);
ARITIES:=(s,length L)::(!ARITIES);
STRAT:=nil;
(* typelistassign (p::L) typelist; *)
let val S = termstratified p in
if S then STRATINFO:=(s,(true,map (fn x=>typeof x -typeof p) L))::(!STRATINFO)
else (Say "Stratification failed";STRATINFO:=(s,(false,nil))::(!STRATINFO)) end;
say (termdisplay(DefTerm(s,L))^" = "^(CURSOR:=0;termdisplay p)))

else 

Say "Definition failed") |

defineterm x p typelist = Say "Definition failure";

fun DefineProp s t typelist = 
((MAYBEPROP:=[getalpha(explode(decapitalize (lcapitalize s)))];
defineprop (parseprop (lcapitalize s)) (parseprop t) typelist;MAYBEPROP:=nil);
reportcommand [Mnemonic "DefineProp",StringArg (lcapitalize s),StringArg t,IntegerListArg
              typelist]);

fun DefSent s t = (MAYBEPROP:=[getalpha(explode(decapitalize (lcapitalize s)))];(defineprop (parseprop (lcapitalize s)) (parseprop t) nil;
    reportcommand[Mnemonic "DefSent",StringArg (lcapitalize s),StringArg t]);MAYBEPROP:=nil);

fun DefineTerm s t typelist = 
((MAYBETERM:=[getalpha(explode(decapitalize (lcapitalize s)))];
defineterm (parseterm (lcapitalize s)) (parseterm t) typelist;MAYBETERM:=nil);
reportcommand [Mnemonic "DefineTerm",StringArg (lcapitalize s),StringArg t,IntegerListArg
              typelist]);

(* margin control *)

fun SetMargin n = (MARGIN:=n;Look());

(* sequent display control for limited windows *)

fun Propsdisplayed n = (LINES := n;Look());

fun Alllinesdisplayed() = (LINES := ~1;Look());

val al = Alllinesdisplayed;

fun Leftscrolldown n = (LEFTSTART := (!LEFTSTART)+n;Look());

val ld = Leftscrolldown;

fun Rightscrolldown n = (RIGHTSTART := (!RIGHTSTART)+n;Look());

val rd = Rightscrolldown;

fun Leftscrollup n = (if (!LEFTSTART)>n then LEFTSTART:=(!LEFTSTART)-n
                                       else LEFTSTART:=1;Look());

val lu = Leftscrollup;

fun Rightscrollup n = (if (!RIGHTSTART)>n then RIGHTSTART:=(!RIGHTSTART)-n
                                       else RIGHTSTART:=1;Look());

val ru = Rightscrollup;

fun Lefttop() = (LEFTSTART:=1;Look());

val lt = Lefttop;

fun Righttop() = (RIGHTSTART :=1;Look());

val rt = Righttop;



(* show proved sequents and goals (leaves only) in the whole proof tree.
One needs to hit return repeatedly to see everything *)

fun ShowAll() = showall();

(* show proof of a theorem *)

fun ShowProof s = 
(SHOWNSUBPROOFS:=nil;showproof TextIO.stdOut true "" (ProofReference s));

(* the history feature:  DontRemember and Remember turn it off or on;
Undo backs up to the result of the last user command.  Starting
a new proof erases the history. Forward() allows one to undo
Undo() as long as no other prover commands that change the proof
state have occurred (using Undo and Forward one can review recent
steps in the proof and return) *)

fun DontRemember() = REMEMBER:=false;  (* use if memory storage is a problem? *)

fun Remember() = REMEMBER:=true;

fun Undo() = ((undo();Look());reportcommand [Mnemonic "Undo"]);

val b = Undo;

fun Forward() = ((forward();Look());reportcommand [Mnemonic "Forward"]);

val f = Forward;

(* this command allows one to name a proved sequent in the current proof
tree -- it takes the line number as a parameter (now) *)

fun NameSequent line name = 

(if hasprefix name then say "User cannot assign name with a prefix to a theorem"
else if foundin name (!CURRENTLEMMAS) orelse foundin name (!AXIOMS) orelse foundin name (!LOCKED) then Say ("Cannot modify current lemma, axiom or locked theorem "^name)
else (SHOWNSUBPROOFS:=nil;
if (!BUBBLES) then autoprune() else ();
namesequent line name (!THEPROOF);
THEPROOF:=fixline line name (!THEPROOF));
logcomment (name^":\n\n"^(seqdisplay(thesequent(ProofReference name))));
reportcommand[Mnemonic "NameSequent",IntegerArg line,StringArg name]);

val SaveProof = saveproof;

(* user commands that reset the internals of the logic *)

fun NoClasses() = (noclasses();reportcommand [Mnemonic "NoClasses"]);

fun Constructive() = (constructive();reportcommand [Mnemonic "Constructive"]);

fun NoPairs() = (nopairs();reportcommand [Mnemonic "NoPairs"]);

fun Extensional() = (extensional();reportcommand [Mnemonic "Extensional"]);

fun Inf() = (inf();reportcommand [Mnemonic "Inf"]);

fun Unknowns() = (unknowns();reportcommand [Mnemonic "Unknowns"]);

(* this command enables one to manually set matches for class variables *)

fun ForceClassMatch x y = 
(if Parseerror(parseprop x) orelse Parseerror(parseprop y) then
say "Parse error!" else
forceclassmatch (parseprop x) (parseprop y);
reportcommand [Mnemonic "ForceClassMatch",StringArg x,StringArg y]);

fun ClearClassMatches() = (CLASSMATCHES := nil;
   reportcommand [Mnemonic "ClearClassMatches"]);

(* view theorems and their proofs *)

fun ThmDisplay s = thmdisplay s;

val td = ThmDisplay;

fun ShowTermDef s = if find s (!TERMDEFS) = nil

   then say "No such term definition"

   else let val [(L,p)] = find s (!TERMDEFS) in

      (CURSOR:=0;say ((termdisplay(DefTerm(s,L)))^" = "^(termdisplay p)))

   end;

fun ShowPropDef s = if find s (!PROPDEFS) = nil

   then say "No such predicate definition"

   else let val [(L,p)] = find s (!PROPDEFS) in

      (CURSOR:=0;say ((propdisplay(DefProp(s,L)))^" = "^(propdisplay p)))

   end;

fun GetProof s = (getproof s;reportcommand[Mnemonic "GetProof",StringArg s]); 

fun RestoreProof s = (restoreproof s;reportcommand[Mnemonic "RestoreProof",StringArg s]);

fun BackupProof s = (backupproof s;reportcommand[Mnemonic "BackupProof",StringArg s]);

(* Change the order of goals.  Different values of the numerical parameter
reshuffle things at different levels.  Not really recommended. *)

fun Rotate n = ((THEPROOF := autorotate(rotateproof n (!THEPROOF));backup());
               reportcommand[Mnemonic "Rotate",IntegerArg n]);

(* Theory Save (to be read by new prover) *)

fun listtoterm nil = PropVar(0,nil) |

listtoterm (t::L) = And(t,listtoterm L);

fun codegen (P,G) = And(P,listtoterm(map (fn x=>PropVar(x,nil)) G));

fun sequenttoterm (Seq(L,M)) = If(listtoterm (map codegen L),listtoterm (map codegen M));

fun prooftoterm (Goal(n,s)) = And(PropVar(n,nil),sequenttoterm s) |

prooftoterm (Node(n,s,[ProofReference th])) = 

(* if foundin th (!AXIOMS)

 then ConvIf(PropVar(n,nil),(If(sequenttoterm s,Equals(FreeVar 0,DefTerm("\"\"",nil)))))

else *) ConvIf(PropVar(n,nil),(If(sequenttoterm s,Equals(FreeVar 0,DefTerm("\""^th^"\"",nil)))))|

prooftoterm (Node(n,s,L)) = Or(PropVar(n,nil),(ConvIf(sequenttoterm s,listtoterm(map prooftoterm L)))) 
;

fun capitalize2 "p1" = "p1" |

capitalize2 "p2" = "p2" |

capitalize2 "v" = "v" |

capitalize2 x = capitalize x;


fun stringtoterm s = Equals(FreeVar 0,DefTerm("\""^(capitalize2 s)^"\"",nil));

fun pairtoterm (P,Q) = And(P,Q);

fun noperiods nil = nil |

noperiods ((s,t)::L) = if foundin #"." (explode s) then noperiods L
else ((s,t)::(noperiods L));

fun theorems() =

map

(fn (s,Node(n,t,[ProofReference th]))=>
if s=th then (s,(t,Node(n,t,[ProofReference ""])))

else (s,(t,Node(n,t,[ProofReference th])))

|(s,(Node(n,t,L))) => (s,(t,Node(n,t,L)))) (noperiods(!THEOREMS));

fun theoremsterm() = listtoterm (map (fn (name,(sequent,proof))=>

    pairtoterm(stringtoterm name,pairtoterm(sequenttoterm sequent,prooftoterm proof))) (theorems()));


(* use the TERMDEFS and PROPDEFS list to generate an OPERATORS list *)


datatype OperatorType = Connective | Predicate of int | Function of int | OTError;

datatype BinderType = Quantifier | SetBinder | FnBinder | BTError;

(* master list of types of operators *)

val OPERATORS = ref (nil:((string*OperatorType) list));

val BINDERS = ref (nil:((string*BinderType) list));


(* functions to declare operators of a specific type *)

fun makeconnective s = (* if optype s = OTError

   then *) OPERATORS:=(s,Connective)::(!OPERATORS)

   (*else Say1 (s^" is already declared!")*);

val _ = makeconnective "&";

val _ = makeconnective "v";

val _ = makeconnective "->";

val _ = makeconnective "==";

val _ = makeconnective "<-";

val _ = makeconnective "=/=";

fun makepredicate n s = (* if optype s = OTError 

   then*) OPERATORS:=(s,Predicate n)::(!OPERATORS)

   (*else Say1 (s^" is already declared!")*);

val _ = makepredicate 2 "=";

val _ = makepredicate 2 "E";

fun makefunction n s =(* if optype s = OTError

   then*) OPERATORS:=(s,Function n)::(!OPERATORS)

   (*else Say1 (s^" is already declared!")*);

val _ = makefunction 1 "p1";

val _ = makefunction 1 "p2";

val _ = makefunction 2 ":";

(* val _ = makefunction 2 ","; *)

fun makequantifier s = (*if find s (!BINDERS) = nil 

   then*) BINDERS:=(s,Quantifier)::(!BINDERS)

   (* else Say1 (s^" is already declared!")*);

val _ = makequantifier "A";

val _ = makequantifier "E";

fun makesetbinder s = (*if find s (!BINDERS) = nil 

   then*) BINDERS:=(s,SetBinder)::(!BINDERS)

   (*else Say1 (s^" is already declared!")*);

val _ = makesetbinder "";

fun makefnbinder s = (*if find s (!BINDERS) = nil 

   then*) BINDERS:=(s,FnBinder)::(!BINDERS)

   (*else Say1 (s^" is already declared!")*);

val _ = makefnbinder "L";

(* extract information from the TERMDEFS list to make 
declarations in new prover format *)

fun operators() = (!OPERATORS)@
(map (fn (x,y)=>(capitalize2 x,y))((map (fn(s,(L,T))=>(s,Function(length L))) (!TERMDEFS))@
(map (fn (s,(L,T))=>(s,Predicate(length L))) (!PROPDEFS))));

(* previous commands give BINDERS the correct value *)

fun optypetoterm Connective = PropVar(0,nil) |

   optypetoterm (Function n) = PropVar(1+2*n,nil) |

   optypetoterm (Predicate n) = PropVar(2+2*n,nil) |

   optypetoterm OTError = PropVar(~1,nil);

fun btypetoterm Quantifier = PropVar(0,nil) |

   btypetoterm FnBinder = PropVar(1,nil) |

   btypetoterm SetBinder = PropVar(2,nil) |

   btypetoterm BTError = PropVar(~1,nil);

fun intlisttoterm L = listtoterm(map (fn n=>PropVar(n,nil)) L);

fun maxlist nil = 0 |

maxlist [x] = x |

maxlist (x::L) = max (x, (maxlist L));

fun fixstratlist L = let val D = maxlist (map (fn n => ((abs n)-n)div 2) L)

in map (fn x=>x+D) L end;

fun operatorsterm() = listtoterm
(map (fn (s,t) => pairtoterm(stringtoterm s,optypetoterm t)) (operators()));

fun bindersterm() = listtoterm(map (fn (s,t) => pairtoterm(stringtoterm s,btypetoterm t)) (!BINDERS));

(* fun operatorstratsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,
   intlisttoterm(fixstratlist t)))(operatorstrat()));

fun binderstratsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,
   intlisttoterm(fixstratlist t)))(binderstrat())); *)

val _ = setprecrightbelow "v" "&";

val _ = setprecrightbelow "->" "v";

val _ = setprecrightbelow "==" "->";

val _ = setprecsame "<-" "->";

val _ = setprecsame "=/=" "==";


fun precsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s ,PropVar(t,nil)))
   (!PRECS));
fun axiomsterm() = listtoterm (map stringtoterm (!AXIOMS));

fun currentterm() = listtoterm(map stringtoterm (!CURRENTLEMMAS));

fun uiterm() = listtoterm(map (fn(m,n)=>pairtoterm(PropVar(m,nil),PropVar(n,nil))) (!UNKNOWNINDEX));

(* reformatted definition lists *)

fun cleantermdefs nil = nil |

cleantermdefs ((s,(L,T))::M) =

   if T = DefTerm(s,L) then cleantermdefs M

   else (s,(L,T))::(cleantermdefs M);

fun cleanpropdefs nil = nil |

cleanpropdefs ((s,(L,T))::M) =

   if T = DefProp(s,L) then cleanpropdefs M

   else (s,(L,T))::(cleanpropdefs M);

fun termdefs() = map (fn (s,(L,T))=>(s,(DefTerm(s,L),T))) (cleantermdefs(!TERMDEFS));

fun propdefs() = map (fn (s,(L,T))=>(s,(DefProp(s,L),T))) (cleanpropdefs(!PROPDEFS));

fun termdefsterm() = listtoterm (map (fn (s,(t,u))=>pairtoterm(stringtoterm s,
   Equals(t,u))) (termdefs()));

fun propdefsterm() = listtoterm (map (fn (s,(t,u))=>pairtoterm(stringtoterm s,
   Iff(t,u))) (propdefs()));

val baseopstrat = [(":", [0, 0, 1]), (",", [0, 0, 0]), ("p2", [0, 0]), ("p1", [0, 0]),
     ("=", [0, 0]), ("E", [0, 1])];

fun operatorstrat() = (baseopstrat@(map (fn (s,(b,L))=>(s,L)) (!STRATINFO)));

fun binderstrat() = [("", [1, 0, 0]), ("E", [0, 0]), ("A", [0, 0])];

fun operatorstratsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,
   intlisttoterm(fixstratlist t)))(operatorstrat()));

fun binderstratsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,
   intlisttoterm(fixstratlist t)))(binderstrat()));

fun theoryterm1() =

listtoterm[operatorsterm(),bindersterm(),precsterm(),
   operatorstratsterm(),binderstratsterm(),axiomsterm()
   (* termdefsterm(),propdefsterm(),theoremsterm()*)];

fun theoryterm2() =

listtoterm [termdefsterm(),propdefsterm()(*,theoremsterm() ,
   PropVar((!NEXTBOUND),nil),PropVar((!NEXTFREE),nil),
   prooftoterm(!THEPROOF),currentterm()*)];

fun theoryterm3() =listtoterm [PropVar((!NEXTBOUND),nil),PropVar((!NEXTFREE),nil),PropVar((!NEXTPSERIAL),nil),PropVar((!NEXTSERIAL),nil),
   (* prooftoterm(!THEPROOF), *)currentterm(),uiterm()];

(* reduce whitespace *)

fun reduce0 nil = nil |

reduce0 (#"\n"::L) = reduce0 (#" "::L) |

reduce0 (#" ":: #" ":: L) = reduce0 (#" "::L) |

reduce0 (x::L) = x::(reduce0 L);

(* remove carriage returns and extra spaces from display *)

fun stripdisplay s = implode(reduce0(explode(propdisplay s)));

fun sdisplay s = stripdisplay(sequenttoterm s);

fun proofrestorescript (Goal (n,s)) = "pushgoal "^(makestring n)^" \""^(sdisplay s)^"\";\n" |

proofrestorescript (Node(n,s,[ProofReference th])) = "pushreference "^(makestring n)^" \""^(sdisplay s)^"\" \""^th^"\";\n" |

proofrestorescript (Node(n,s,L)) = (proofrestorescriptlist L)^
   ("pushnode "^(makestring n)^" \""^(sdisplay s)^"\" "^(makestring(length L))^";\n")

and proofrestorescriptlist nil = "" |

proofrestorescriptlist (x::L) = (proofrestorescriptlist L)^(proofrestorescript x);

val FILE = ref(TextIO.openOut("dummy"));

fun thetheorem (Goal(n,s)) = s |

thetheorem (Node(n,s,L)) = s;

fun theoremlistrestorescript nil = "" |

theoremlistrestorescript ((name,(prf))::L) =

   (theoremlistrestorescript L)^
   (
   (proofrestorescript prf)^
   "THEOREMS:=(\""^name^"\",(termtosequent(parseprop(\""^
    (sdisplay (thetheorem prf))^
 "\")),hd(!PROOFSTACK)))::(!THEOREMS);\nPROOFSTACK:=nil;\ntd \""^name^"\";\n");

fun makeproofscript s = (FILE:=TextIO.openOut(setdir(s^".psc"));
TextIO.output((!FILE),(theoremlistrestorescript(noperiods(!THEOREMS))));
TextIO.output((!FILE),(proofrestorescript(!THEPROOF)));TextIO.flushOut(!FILE);
TextIO.closeOut(!FILE));


val SFILE = ref(TextIO.openOut("dummy"));

fun savetheory s = (SFILE:=TextIO.openOut(setdir(s^".thy1"));
TextIO.output((!SFILE),propdisplay(theoryterm1())^"\n\\\n");TextIO.flushOut(!SFILE);
TextIO.closeOut(!SFILE);SFILE:=TextIO.openOut(setdir(s^".thy2"));
TextIO.output((!SFILE),propdisplay(theoryterm2())^"\n\\\n");TextIO.flushOut(!SFILE);
TextIO.closeOut(!SFILE);SFILE:=TextIO.openOut(setdir(s^".thy3"));
TextIO.output((!SFILE),propdisplay(theoryterm3())^"\n\\\n");TextIO.flushOut(!SFILE);
TextIO.closeOut(!SFILE);makeproofscript s);

(* axioms just as is *)


(*

an example (NFU extensionality)

Start "((&x1.(x1Ea1==x1Ea2))->(a1=a2v(&x1.~x1Ea1)))";

another example (extensionality test)

Start "(((&x1.(x1Ea1==x1Ea2))&a3Ea1)->a3Ea2)";

*)

(* examples for talk taken from Steve's book:

p. 2-113  P = P1 S = P2  R = P3  Q = P4

Start"((&x1.(&x2.(P1(x1,x2)->(P4(x1,x2)v(P3(x2)vP2(x1))))))->((&x1.(&x2.(P1(x1,x2)->P1(x2,x2)))) ->((&x1.~P4(x1,x1)) ->((&x1.(P3(x1)->P2(x1))) ->(&x1.(&x2.(P1(x1,x2)->(P2(x1)vP2(x2)))))))))";


*)

(* example from Grantham, p. 2-115 with existential quantifiers

P1 := B  P2 := C  P3 := D  P4 := E P5 := F

Start "((&x1.((P5(x1) &P3(x1)) ->P1(x1,x1))) ->((vx1.P2(x1)) ->((vx1.P5(x1)) ->((&x1.(&x2.((P2(x1)&(P5(x1)&~P3(x1)))->P1(x1,x2)))) ->((&x1.(P5(x1)->(P2(x1)vP4(x1)))) ->((&x1.(&x2.((P2(x1)&(P4(x2)&~P3(x2)))->P1(x1,x2)))) ->(vx1.(vx2.P1(x1,x2)))))))))";



*)

(* Example 2.7.3, p.2-118

This works.  The trick is that the non-P1 witness is the witness to
the conclusion.

Start "((vx1.(P1(x1)&(&x2.(P1(x2)->P2(x1,x2))))) ->((vx1.(~P1(x1)&(&x2.(~P1(x2)->P2(x2,x1))))) ->((&x1.(P1(x1)->(vx2.(~P1(x2)&P2(x1,x2))))) ->((&x1.(&x2.(&x3.((P2(x1,x2)&P2(x2,x3))->P2(x1,x3))))) ->(vx1.(~P1(x1)&(&x2.P2(x2,x1))))))))";

*)

(* an example with sets?

Start "({x1^1|x1^1=a1}={x1^1|x1^1=a2}==a1=a2)";

(found a bug while proving this -- it does work now, but it's not short)

*)

(*

(* complete proof that objects are equal iff their singletons are equal --
demonstrating use of definition of terms *)

DefineTerm "*sing(x1^1)" "{x2^1|x2^1=x1^1}" nil;

Start "( *sing(a1)=*sing(a2)==a1=a2)";

RightRule();  RightRule();

RightRule(); RightRule();

LeftRule();

RightRule();

Witness "{x2^2|(&x1^1.(x1^1Ex2^2->x1^1Ea3))}";

LeftRule(); LeftRule(); LeftRule();

RightRule(); RightRule(); RightRule();

LeftRule();

GetRight 2;

RightRule(); RightRule(); RightRule();

GetLeft 2; LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule(); LeftRule();

GetLeft 4; Done(); Done();

GetLeft 2; LeftRule();

GetLeft 4; Done();

GetRight 3; Done();

GetLeft 2;  LeftRule();

RightRule(); RightRule(); RightRule();

LeftRule();

GetRight 2;  RightRule();

GetLeft 2;  LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule();

LeftRule();

GetLeft 4; Done(); Done();

GetLeft 2;  LeftRule();

GetLeft 4; Done();

GetRight 4; Done();

LeftRule();

Witness "a1";  LeftRule();  RightRule();

RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

GetLeft 4;  LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule();

LeftRule();

GetLeft 2; Done();  Done();

RightRule();  GetLeft 2; Done();

LeftRule();  Witness "a2";  LeftRule();  RightRule();

RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

GetLeft 3;  LeftRule(); RightRule();

RightRule();  RightRule();  LeftRule();  LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule(); LeftRule();

GetLeft 3; Done(); Done();

GetLeft 2; LeftRule();

GetLeft 3; Done();  Done();

LeftRule(); Witness "a1";  LeftRule();  RightRule();

RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

RightRule(); RightRule(); RightRule();

GetLeft 5; Done();

RightRule();

GetLeft 2; Done();

RightRule();  LeftRule();  RightRule();  

GetRight 2;  RightRule();  Witness "a1";  Witness "a1";

RightRule();  RightRule();  RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

RightRule();

RightRule(); RightRule(); RightRule();

LeftRule(); RightRule();

GetLeft 2;  Witness "{x1^1|a11=x1^1}";

LeftRule(); LeftRule(); LeftRule();  LeftRule();

GetRight 2; RightRule();

GetLeft 2; Done();

RightRule();  GetLeft 3; Done();

LeftRule();  Done();

RightRule();  LeftRule(); RightRule();

GetLeft 2; Witness "{x1^1|a11=x1^1}";

LeftRule(); LeftRule(); LeftRule(); LeftRule();

RightRule();  GetLeft 2; Done();Done();

LeftRule();  GetLeft 2;  LeftRule();  RightRule();

GetLeft 2; Done();  LeftRule(); Done();



*)

(*

(* complete proof that objects are equal iff their singletons are equal --
demonstrating use of definition of terms *)

(* this version has no type indices -- automatic stratification
is in use *)

DefineTerm "*sing(x1)" "{x2|x2=x1}" [1,0];

Start "( *sing(a1)=*sing(a2)==a1=a2)";

RightRule();  RightRule();

RightRule(); RightRule();

LeftRule();

RightRule();

Witness "{x2|(&x1.(x1Ex2->x1Ea3))}";

LeftRule(); LeftRule(); LeftRule();

RightRule(); RightRule(); RightRule();

LeftRule();

GetRight 2;

RightRule(); RightRule(); RightRule();

GetLeft 2; LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule(); LeftRule();

GetLeft 4; Done(); Done();

GetLeft 2; LeftRule();

GetLeft 4; Done();

GetRight 3; Done();

GetLeft 2;  LeftRule();

RightRule(); RightRule(); RightRule();

LeftRule();

GetRight 2;  RightRule();

GetLeft 2;  LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule();

LeftRule();

GetLeft 4; Done(); Done();

GetLeft 2;  LeftRule();

GetLeft 4; Done();

GetRight 4; Done();

LeftRule();

Witness "a1";  LeftRule();  RightRule();

RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

GetLeft 4;  LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule();

LeftRule();

GetLeft 2; Done();  Done();

RightRule();  GetLeft 2; Done();

LeftRule();  Witness "a2";  LeftRule();  RightRule();

RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

GetLeft 3;  LeftRule(); RightRule();

RightRule();  RightRule();  LeftRule();  LeftRule();

Witness "a3";

LeftRule(); LeftRule(); LeftRule(); LeftRule();

GetLeft 3; Done(); Done();

GetLeft 2; LeftRule();

GetLeft 3; Done();  Done();

LeftRule(); Witness "a1";  LeftRule();  RightRule();

RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

RightRule(); RightRule(); RightRule();

GetLeft 5; Done();

RightRule();

GetLeft 2; Done();

RightRule();  LeftRule();  RightRule();  

GetRight 2;  RightRule();  Witness "a1";  Witness "a1";

RightRule();  RightRule();  RightRule(); RightRule(); RightRule();

RightRule();  RightRule();  Done();

RightRule(); Done();

RightRule();

RightRule(); RightRule(); RightRule();

LeftRule(); RightRule();

GetLeft 2;  Witness "{x1|a11=x1}";

LeftRule(); LeftRule(); LeftRule();  LeftRule();

GetRight 2; RightRule();

GetLeft 2; Done();

RightRule();  GetLeft 3; Done();

LeftRule();  Done();

RightRule();  LeftRule(); RightRule();

GetLeft 2; Witness "{x1|a11=x1}";

LeftRule(); LeftRule(); LeftRule(); LeftRule();

RightRule();  GetLeft 2; Done();Done();

LeftRule();  GetLeft 2;  LeftRule();  RightRule();

GetLeft 2; Done();  LeftRule(); Done();



*)

(* can I prove Cantor's theorem? *)

fun proofsofar() = (

DefineProp "#relation(x1,x2,x3)" "(&x4.(x4Ex3->(p1(x4)Ex1&p2(x4)Ex2)))" [0,0,0];

DefineProp "#function(x1,x2,x3)" "((#relation(x1,x2,x3)&(&x4.(x4Ex1->(vx5.<x4,x5>Ex3))))&(&x4.(&x5.((x4Ex3&(x5Ex3&p1(x4)=p1(x5)))->p2(x4)=p2(x5)))))" [0,0,0];

DefineTerm "*image(x1,x2)" "{x3|<x2,x3>Ex1}" [1,1,0];

DefineTerm "*converse(x1)" "{x2|<p2(x2),p1(x2)>Ex1}" [0,0];

DefineProp "#samesize(x1,x2)" "(vx3.(#function(x1,x2,x3)&#function(x2,x1,*converse(x3))))" [0,0];

DefineProp "#set(x1)" "x1={x2|x2Ex1}" [0];

DefineProp "#includes(x1,x2)" "(#set(x1)&(&x3.(x3Ex1->x3Ex2))))" [0,0];

DefineTerm "*powerset(x1)" "{x2|#includes(x2,x1)}" [1,0];

DefineTerm "*sing(x1)" "{x2|x2=x1}" [1,0];

DefineTerm "*unitset(x1)" "{x2|(vx3.(x3Ex1&x2=*sing(x3)))}" [1,0];

Start "~#samesize( *unitset(a1),*powerset(a1))";

(* a1 is the set whose power set is to be shown not to be the same
size *)

RightRule();  LeftRule();  LeftRule(); LeftRule();

(* a2 is the hypothetical bijection from the unitset of a1 to the
power set of a1 *)

GetLeft 2;  LeftRule();  LeftRule();  LeftRule();

GetLeft 2;

(* the bad subset, local to this proof *)

DefineTerm "*temp(x1,x2)" "{x3|(x3Ex1&(&x4.(<*sing(x3),x4>Ex2->~x3Ex4)))}" [0,1,0];

Witness "*temp(a1,a2)";

LeftRule();

map PruneLeft [1,1,1,1];

RightRule();  RightRule();  RightRule(); RightRule();

DefEquals();  SetEquals();

RightRule();  RightRule();  RightRule();  RightRule();

RightRule();  Done();

RightRule();  LeftRule();  Done();

RightRule();  RightRule();  LeftRule();

LeftRule(); Done();

LeftRule();

(* a5 is the singleton of the element of a1 mapped by a2 
to the bad set *temp(a1,a2) *)

LeftRule();

GetLeft 4;  LeftRule(); LeftRule(); LeftRule();  LeftRule();

Witness "<a5,*temp(a1,a2)>";  LeftRule();  GetLeft 5; Done();

LeftRule();  LeftRule();  LeftRule();  LeftRule();

GetLeft 2;  LeftRule();

Witness "{x1|(vx2.(<x1,x2>Ea2&#includes(x1,x2)))}";

(* stop here *)

LeftRule(); LeftRule();  GetLeft 2; LeftRule();

RightRule();  Witness "*temp(a1,a2)";  Witness "*temp(a1,a2)";

PruneLeft 1;  RightRule();  Witness "{x1|<x1,*temp(a1,a2)>Ea2}";

LeftRule(); LeftRule(); LeftRule();  RightRule();  GetLeft 8; Done();

LeftRule(); Done();

RightRule();  RightRule(); PruneRight 2;  map PruneLeft [1,1,1,1,1,1,1,1,1,1,1];

RightRule();  DefEquals();  SetEquals();

RightRule();  RightRule();  RightRule();

RightRule();  RightRule();  Done();

RightRule(); LeftRule(); Done();

RightRule();  RightRule();  RightRule();  RightRule();  LeftRule();

LeftRule();  Witness "a1";

LeftRule(); LeftRule(); LeftRule(); LeftRule();  GetLeft 11; Done();Done();

GetLeft 2; LeftRule();  GetLeft 11; Done();Done();

LeftRule();  RightRule();  RightRule();  RightRule();

GetLeft 3;  LeftRule();  Witness "{x1|<*sing(x1),a9>Ea2}";

LeftRule(); LeftRule(); LeftRule();  RightRule();  GetLeft 15; Done();

LeftRule();  PruneLeft 2;

GetLeft 3;

GetLeft 5;  Witness "<a5,*temp(a1,a2)>";  Witness "<*sing(a6),a9>";

LeftRule();  RightRule();  GetLeft 4; Done();

RightRule();  GetLeft 11; Done();

RightRule();  GetLeft 13; Done();

LeftRule();  Witness "{x1|a8Ex1}";

LeftRule(); LeftRule(); LeftRule();  RightRule();

RightRule();  RightRule();  GetLeft 14;  Witness "a1";

LeftRule(); LeftRule(); LeftRule();  LeftRule();  GetLeft 14; Done();Done();

GetLeft 2;  LeftRule();  GetLeft 14; Done();Done();

RightRule();  RightRule();  GetLeft 2;  LeftRule();

RightRule();  GetLeft 10; Done();

LeftRule();LeftRule();LeftRule();

GetLeft 2;  Witness "a10";  LeftRule();  GetLeft 19; Done(); Done();

LeftRule();

GetLeft 2; LeftRule();

RightRule();  GetLeft 18; Done();

LeftRule();  LeftRule();  LeftRule();

GetLeft 2;  Witness "a9";

LeftRule();  GetLeft 12; Done();  LeftRule(); Done();

GetLeft 19; Done();

GetLeft 12;  LeftRule();  Done();

LeftRule();  LeftRule();  LeftRule();

GetLeft 2; LeftRule(); LeftRule();

GetLeft 2;  Witness "a6";  LeftRule();

RightRule();

RightRule(); RightRule(); RightRule(); RightRule();

RightRule(); Done(); RightRule(); Done();

GetLeft 3;  LeftRule(); LeftRule();

GetLeft 2;  Witness "{x1|(<x1,a13>Ea2&#includes(x1,a13))}";

LeftRule(); LeftRule(); LeftRule(); RightRule();  GetLeft 16; Done();

LeftRule();

LeftRule();  GetLeft 2; LeftRule();

LeftRule();

GetLeft 4;Witness "{x1|<x1,*temp(a1,a2)>Ea2}";

LeftRule(); LeftRule(); LeftRule(); RightRule();  GetLeft 8; Done();

LeftRule();

GetLeft 7;  Witness "<*sing(a6),*temp(a1,a2)>"; Witness "<*sing(a6),a11>";

LeftRule();  RightRule();  GetLeft 17; Done();

RightRule();  GetLeft 8; Done();

RightRule(); RightRule(); RightRule(); RightRule();

RightRule(); Done(); RightRule(); Done();

LeftRule();  Witness "{x1|a6Ex1}";

LeftRule(); LeftRule(); LeftRule(); RightRule();

RightRule();  RightRule();  GetLeft 9; Done();

RightRule();  RightRule();  RightRule();

GetLeft 3;  LeftRule();  RightRule();  GetLeft 11; Done();

LeftRule();  LeftRule();  LeftRule();

GetLeft 2;  Witness "a11"; LeftRule();

(* stop here *)


  GetLeft 10; Done();


LeftRule();  GetLeft 12; Done();

LeftRule();

GetLeft 2;  LeftRule();  Witness "{x1|a6Ex1}";

RightRule();  GetLeft 12; Done();

LeftRule();  LeftRule();  LeftRule();

GetLeft 2;  Witness "a11";  LeftRule();  GetLeft 10; Done();

LeftRule();  GetLeft 12; Done(); Done();



()
);



(* 

Steve's example  -- this isn't the complicated one!

((((&x1.(&x2.(P1(x1,x2)==P1(x2,x1)))) & (&x1.(&x2.(&x3.((P1(x1,x2)&P1(x2,x3))->P1(x1,x3)))))) & (&x1.(vx2.P1(x1,x2)))) -> (&x1.P1(x1,x1))) *)


(* let's see if Steve's example is easier to work with with the
new parser:

This is indeed easier to write, and left grouping of -> is useful.

Start "((Ax1.(Ax2.P1(x1,x2)==P1(x2,x1)))&(Ax1.(Ax2.(Ax3.P1(x1,x2)&P1(x2,x3)->P1(x1,x3))))&(Ax1.(Ex2.P1(x1,x2))))->(Ax1.P1(x1,x1))"; *)


(*  steve example 2

s "(Ax1.(Ex2.x1 R2 x2)) & (Ex1.(Ax2.P1(x2)v x1 R2 x2)) & (Ax1.(Ax2.(x1 R2 x2 & P1(x1) ->  x2 R2 x1))) -> (Ax1.(Ex2.x2 R2 x1))";


*)


(* matching test

Axiom "EQTEST" ["a1=a2","P1(a1)"] ["P1(a2)"];

Axiom "ID" [] ["a1=a1"];

s "(Ax1.(Ax2.x1=x2->x2=x1))";

r();r();r();

c "a1=a1";

ForceClassMatch "P1(x1)" "x1=a1";

UseThm "EQTEST" [2,1] [1];

UseThm "ID" [] [1];

(* this proof does not work, but close analysis
reveals that it is not a bug but an unanalyzed assumption
about matching that is at work. *)

s "(Ax1.(Ax2.(Ax3.x1=x2&x2=x3->x1=x3)))";

r();r();r();

r();l();

ForceClassMatch "P1(x1)" "a1=x1";

UseThm "EQTEST" [2,1] [1];

(* this proof, using the result with renamed variables, works.
A close analysis of variable use shows that there is no bug;
it's a drawback of the dynamic approach to variables that we take,
but not an insuperable one *)

(* the ability to displace variable indices in theorems so that all
are unused would fix this problem *)

s "(a3=a4)&(a4=a5)->a3=a5";

r();l();

ForceClassMatch "P1(x1)" "a3=x1";

UseThm "EQTEST" [2,1] [1];

NameSequent "TRANS1";

y

s "(Ax1.(Ax2.(Ax3.x1=x2&x2=x3->x1=x3)))";

r();r();r();

UseThm "TRANS1" [] [1];





*)

(* proof script for Steve example moved to proofscript.txt *)







(* DefineTerm "*unord(x1,x2)" "{x3|x3=x1 v x3=x2}" [1,0,0];

DefineTerm "*kpair(x1,x2)" "*unord({x3|x3=x1},*unord(x1,x2))" [2,0,0];

s "(Ax1.(Ax2.(Ax3.(Ax4. *kpair(x1,x2)=*kpair(x3,x4)->x1=x3&x2=x4))))";

r();r();r();r();

r();r();

l();


*)


(* nonce function for re-running proofs *)

(* needs to clear more stuff *)

fun cleardefs() = (TERMDEFS:=nil;PROPDEFS:=nil;STRATINFO:=nil;ARITIES:=nil;
        CURRENTLEMMAS:=nil;SAVEDPROOFS:=nil;FreshStart "x1=x1");

(* an much more succinct proof of Cantor's theorem.  This one has
a cut in it; I should revisit this and produce a better cut-free
proof. *)

fun proof2() =

(cleardefs();

DefineProp "#relation(x1,x2,x3)" "(&x4.(x4Ex3->(p1(x4)Ex1&p2(x4)Ex2)))" [0,0,0];

DefineProp "#function(x1,x2,x3)" "((#relation(x1,x2,x3)&(&x4.(x4Ex1->(vx5.<x4,x5>Ex3))))&(&x4.(&x5.((x4Ex3&(x5Ex3&p1(x4)=p1(x5)))->p2(x4)=p2(x5)))))" [0,0,0];

DefineTerm "*image(x1,x2)" "{x3|<x2,x3>Ex1}" [1,1,0];

DefineTerm "*converse(x1)" "{x2|<p2(x2),p1(x2)>Ex1}" [0,0];

DefineProp "#samesize(x1,x2)" "(vx3.(#function(x1,x2,x3)&#function(x2,x1,*converse(x3))))" [0,0];

DefineProp "Set(x1)" "x1={x2|x2Ex1}" [0];

DefineProp "#includes(x1,x2)" "(#set(x1)&(&x3.(x3Ex1->x3Ex2)))" [0,0];

DefineTerm "*powerset(x1)" "{x2|#includes(x2,x1)}" [1,0];

DefineTerm "*sing(x1)" "{x2|x2=x1}" [1,0];

(* I changed this definition; this is really the "singleton image"
operation and I found the use of "unitset" confusing.  This is
Rosser's name for this operation.   *)

DefineTerm "*usc(x1)" "{x2|(vx3.(x3Ex1&x2=*sing(x3)))}" [1,0];


Start "~#samesize(*usc(a1),*powerset(a1))";

RightRule();  LeftRule();  LeftRule();

(* at this point we have a1 a bad set and a2 a bad function (bijection
between usc(a1) and powerset(a1).  It would be handy to be able to assign
helpful aliases to these objects *)

LeftRule();

(* it is the second proposition which is most interesting.
the counterexample function which is the key to the proof
is a witness to this statement *)

GetLeft 2; 

LeftRule(); LeftRule(); LeftRule();

GetLeft 2;

(* the whole strategy of the proof hinges on choosing a witness
to this statement (1) cleverly *)

(*  1:  (Ax7.x7 E *powerset(a1)
      -> (Ex11.<x7,x11> E *converse(a2)))
2:  (Ax13.(Ax17.
     x13 E *converse(a2) & x17 E *converse(a2)
      & p1(x13) = p1(x17) -> p2(x13) = p2(x17)))
3:  #function( *usc(a1),*powerset(a1),a2)
4:  #relation( *powerset(a1),*usc(a1),*converse(a2)) *)

(* the description of the bad function requires a definition *)

(* in an ideal world, this definition would be nonce *)

DefineTerm "*badset" 
"{x1 | x1Ea1 & (&x2.<*sing(x1),x2>Ea2->~x1Ex2)}" nil;

Witness "*badset";

LeftRule();

RightRule();  RightRule();  RightRule();

(* we need a theorem #set({x1|P1(x1)}) to prove this
and similar assertions  -- but there isn't any such theorem! *)

(* BEGIN #set( *badset) module *)

RightRule();  de(); se();

RightRule();  RightRule(); RightRule();  RightRule();  RightRule();  Done();

RightRule();  LeftRule(); Done();

(* END #set( *badset) module *)

RightRule();

RightRule();

LeftRule(); LeftRule(); Done();

LeftRule();

(* here we introduce a new witness: a5 is the element of usc(a1) which
is mapped to *badset.  We are interested in its element. *)

(*

1:  <*badset,a5> E *converse(a2)
2:  (Ax7.x7 E *powerset(a1)
      -> (Ex11.<x7,x11> E *converse(a2)))
3:  (Ax13.(Ax17.
     x13 E *converse(a2) & x17 E *converse(a2)
      & p1(x13) = p1(x17) -> p2(x13) = p2(x17)))
4:  #function( *usc(a1),*powerset(a1),a2)
5:  #relation( *powerset(a1),*usc(a1),*converse(a2))


|-

*)

(* it is line 5l which will give us the fact that
a5 E *usc(a1) *)

GetLeft 5;  LeftRule(); 
Witness "<*badset,a5>";
LeftRule();
GetLeft 2; Done();
LeftRule();
GetLeft 2; LeftRule(); LeftRule();

(* a new actor heard from: *)

(*

1:  a6 E a1 & a5 = *sing(a6)
2:  (Ax54.x54 E *converse(a2)
      -> p1(x54) E *powerset(a1)
      & p2(x54) E *usc(a1))
3:  <*badset,a5> E *converse(a2)
4:  (Ax7.x7 E *powerset(a1)
      -> (Ex11.<x7,x11> E *converse(a2)))
5:  (Ax13.(Ax17.
     x13 E *converse(a2) & x17 E *converse(a2)
      & p1(x13) = p1(x17) -> p2(x13) = p2(x17)))
6:  #function( *usc(a1),*powerset(a1),a2)
7:  *badset E *powerset(a1)


|-

*)

(* a6 is the element of a1 whose singleton is mapped to *badset *)

LeftRule();

GetLeft 4; LeftRule();

(* originally, I proved the obvious <*sing(a6),*badset> E a2
in one of the branches of the cut below, and of course it had
to be duplicated! *)

GetLeft 7;  LeftRule();

Witness "{x1|<x1,*badset>Ea2}";

LeftRule();  LeftRule();  LeftRule();  RightRule();  GetLeft 4; Done();

LeftRule();  pl 2;

Cut "a6 E *badset";

LeftRule();  LeftRule();  GetLeft 2;  Witness "*badset";

LeftRule();  GetLeft 2; Done();

LeftRule();  RightRule();  RightRule();  GetLeft 10; Done(); Done();

RightRule();  RightRule();  GetLeft 9; Done();

RightRule();  RightRule();  RightRule();

(* the object a7 is demonstrably *badset -- this is what we need to
show *)

GetLeft 9;  LeftRule();  LeftRule();

GetLeft 2;

Witness "<*sing(a6),a7>";  Witness "<*sing(a6),*badset>";

LeftRule();  RightRule();  GetLeft 6; Done();

RightRule();  GetLeft 7; Done();

RightRule();  RightRule(); RightRule();  RightRule();  RightRule(); Done();

RightRule();  Done();  pl 2; pl 2;

LeftRule();  Witness "{x1|a6 E x1}";

LeftRule();  LeftRule(); LeftRule();  RightRule();  GetLeft 5; Done();

LeftRule();  LeftRule(); LeftRule();  GetLeft 2;


Witness "a7";  LeftRule();  GetLeft 7; Done();

LeftRule();  GetLeft 6; Done();  AutoPrune();
());

(*

s "(Ax1.(Ax2.P1(x1)->P1(x2)))->(Ax1.(Ax2.P1(x1)==P1(x2)))";

*)

(* begin editing theory save

(* THEORY SAVE AND RESTORE *)

(* conversion between numerals and strings is handled by built-in makestring
and the already defined getindex *)

(* conversion of lists of proposition terms to proposition terms and back *)

(* integers coded as proposition variables *)

fun listtoterm nil = PropVar(0,nil) |

listtoterm (t::L) = And(t,listtoterm L);

(* fun termtolist (PropVar(0,nil)) = nil |

termtolist (And(t,L)) = t::(termtolist L) |

termtolist x = []; *)
fun codegen (P,G) = And(P,listtoterm(map (fn x=>PropVar(x,nil)) G));

(* fun decodegen (Infix(P,"&",Q)) =

   (P,map(fn (PropVar(x,nil))=>x |y=> ~1) (termtolist Q))|

   decodegen x = (ErrorProp,nil); *)

fun sequenttoterm (Seq(L,M)) = If(listtoterm (map codegen L),listtoterm (map codegen M));

(* fun termtosequent (Infix(L,"->",M)) =

   Seq(map decodegen (termtolist L),map decodegen (termtolist M)) |

termtosequent x = Seq(nil,nil); *)

fun prooftoterm (Goal(n,s)) = And(PropVar(n,nil),sequenttoterm s) |

prooftoterm (Node(n,s,[ProofReference th])) =  

if s=th then ConvIf(PropVar(n,nil),(If(sequenttoterm s,Equal(FreeVar 0,DefTerm("\"\"",nil)))))
  
else ConvIf(PropVar(n,nil),(If(sequenttoterm s,Equal(FreeVar 0,DefTerm("\""^th^"\"",nil)))));


prooftoterm (Node(n,s,L)) = Or(PropVar(n,nil),(ConvIf(sequenttoterm s,listtoterm(map prooftoterm L)))) 

(*prooftoterm (Reference(n,s,th)) = 
    Infix(PropVar(n,nil),"<-",(Infix(sequenttoterm s,"->",Infix(Free 0,"=",Prefix("\""^th^"\"",nil)))))*);

(* fun termtoproof (Infix(PropVar(n,nil),"&",s)) = Goal(n,termtosequent s) |

termtoproof (Infix(PropVar(n,nil),"v",Infix(s,"<-",L))) =

   Node(n,termtosequent s,map termtoproof (termtolist L)) |

termtoproof (Infix(PropVar(n,nil),"<-",Infix(s,"->",Infix(Free 0,"=",Prefix(th,nil))))) =  Reference(n,termtosequent s,trim th) |

termtoproof x = Goal(0,Seq(nil,nil)); *)

(* which lists make up the theory? *)

fun stringtoterm s = Equals(FreeVar 0,DefTerm("\""^s^"\"",nil));

(* fun termtostring (Infix(Free 0,"=",Prefix(s,nil))) =
   trim s |
termtostring t = ""; *)
   

fun pairtoterm (P,Q) = And(P,Q);

(* fun termtopair (Infix(P,"&",Q)) = (P,Q)|

termtopair x = (stringtoterm "",ErrorProp); *)

(* the theoremsterm() and readtheoremslist functions work but the
parser does not handle terms that large very well...now it does... *)

fun theoremsterm() = listtoterm (map (fn (name,(sequent,proof))=>

    pairtoterm(stringtoterm name,pairtoterm(sequenttoterm sequent,prooftoterm proof))) (!THEOREMS));

(* fun readtheoremsterm T =

     map (fn (name, sp)=>(termtostring name,(fn (sequent,proof)=>(termtosequent sequent,
          termtoproof proof)) (termtopair sp)))
     (map (termtopair) (termtolist T)); *)

(* lists needed for theory state:

THEOREMS (already handled),

OPERATORS, BINDERS, PRECS, OPERATORSTRAT, BINDERSTRAT, TERMDEFS, PROPDEFS,
AXIOMS

other information needs to be set to starting state when a theory is loaded 

such as THEPROOF CURRENT *)

(* idea:  generate a genuine OPERATORS and BINDERS list *)

fun optypetoterm Connective = PropVar(0,nil) |

   optypetoterm (Function n) = PropVar(1+2*n,nil) |

   optypetoterm (Predicate n) = PropVar(2+2*n,nil) |

   optypetoterm OTError = PropVar(~1,nil);

fun termtooptype (PropVar(n,nil)) =

   if n<0 then OTError

   else if n=0 then Connective

   else if n mod 2 = 1 then Function ((n-1) div 2)

   else if n mod 2 = 0 then Predicate ((n-2) div 2)

   else OTError |

termtooptype x = OTError;

fun btypetoterm Quantifier = PropVar(0,nil) |

   btypetoterm FnBinder = PropVar(1,nil) |

   btypetoterm SetBinder = PropVar(2,nil) |

   btypetoterm BTError = PropVar(~1,nil);

fun termtobtype (PropVar(n,nil)) =

   if n = 0 then Quantifier

   else if n = 1 then FnBinder

   else if n=2 then SetBinder

   else BTError |termtobtype x = BTError;

fun intlisttoterm L = listtoterm(map (fn n=>PropVar(n,nil)) L);

fun termtointlist T = map (fn (PropVar(n,nil))=>n|x=> ~1) (termtolist T);

(* change stratification lists so they contain no negative numbers *)

fun fixstratlist L = let val D = maxlist (map (fn n => ((abs n)-n)div 2) L)

in map (fn x=>x+D) L end;

fun operatorsterm() = listtoterm
(map (fn (s,t) => pairtoterm(stringtoterm s,optypetoterm t)) (!OPERATORS));

fun readoperatorsterm T = map (fn (s,t) => (termtostring s,termtooptype t))
(map termtopair (termtolist T));

fun bindersterm() = listtoterm(map (fn (s,t) => pairtoterm(stringtoterm s,btypetoterm t)) (!BINDERS));

fun readbindersterm T = map (fn (s,t) => (termtostring s,termtobtype t))
(map termtopair (termtolist T));

fun operatorstratsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,
   intlisttoterm(fixstratlist t)))(!OPERATORSTRAT));

fun binderstratsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,
   intlisttoterm(fixstratlist t)))(!BINDERSTRAT));

fun readstratsterm T = map (fn (s,t)=>(termtostring s,termtointlist t))
   (map termtopair (termtolist T));

fun precsterm() = listtoterm (map (fn (s,t)=>pairtoterm(stringtoterm s,PropVar(t,nil)))
   (!PRECS));

fun readprecsterm T = map (fn (s,PropVar(n,nil)) => (termtostring s,n)|
   x=>("",~1)) (map termtopair (termtolist T));

fun termdefsterm() = listtoterm (map (fn (s,(t,u))=>pairtoterm(stringtoterm s,
   Infix(t,"=",u))) (!TERMDEFS));

fun propdefsterm() = listtoterm (map (fn (s,(t,u))=>pairtoterm(stringtoterm s,
   Infix(t,"==",u))) (!PROPDEFS));

fun readtermdefsterm T = map (fn(s,Infix(t,"=",u))=>(termtostring s,(t,u)) |
   x=>("",(ErrorObject,ErrorObject))) (map termtopair (termtolist T));

fun readpropdefsterm T = map (fn(s,Infix(t,"==",u))=>(termtostring s,(t,u)) |
   x=>("",(ErrorProp,ErrorProp))) (map termtopair (termtolist T));

fun axiomsterm() = listtoterm (map stringtoterm (!AXIOMS));

fun readaxiomsterm T = map termtostring (termtolist T);

fun theoryterm1() =

listtoterm[operatorsterm(),bindersterm(),precsterm(),
   operatorstratsterm(),binderstratsterm(),axiomsterm()
   (* termdefsterm(),propdefsterm(),theoremsterm()*)];

fun theoryterm2() =

listtoterm [termdefsterm(),propdefsterm(),theoremsterm()];

fun readtheoryterm1 T =

(fn [opl,b,pr,ops,bis,ax] (* td,pd,th]*)=>

(OPERATORS:=readoperatorsterm opl;BINDERS:=readbindersterm b;
PRECS:=readprecsterm pr; OPERATORSTRAT:=readstratsterm ops;
BINDERSTRAT:= readstratsterm bis;AXIOMS:=readaxiomsterm ax (*TERMDEFS:=readtermdefsterm td;
PROPDEFS:=readpropdefsterm pd;THEOREMS:=readtheoremsterm th;*)
)|x=>()) (termtolist T);

fun readtheoryterm2 T = 

(fn [td,pd,th]=>(TERMDEFS:=readtermdefsterm td;
PROPDEFS:=readpropdefsterm pd;THEOREMS:=readtheoremsterm th;
HISTORY:=nil;
start "P1->P1")|x=>()) (termtolist T);


val FILE = ref(TextIO.openOut("dummy"));

fun savetheory s = (FILE:=TextIO.openOut(setdir(s^".thy1"));
TextIO.output((!FILE),display(theoryterm1())^"\n\\\n");TextIO.flushOut(!FILE);
TextIO.closeOut(!FILE);FILE:=TextIO.openOut(setdir(s^".thy2"));
TextIO.output((!FILE),display(theoryterm2())^"\n\\\n");TextIO.flushOut(!FILE);
TextIO.closeOut(!FILE));

fun nobackslash0 nil = nil |

nobackslash0 ((#"\\")::L) = nil |

nobackslash0 (x::L) = x::(nobackslash0 L);

fun nobackslash s = implode(nobackslash0 (explode s));

val FILE2 = ref(TextIO.openIn("dummy"));

fun opentheory1 s = FILE2:=TextIO.openIn(setdir(s^".thy1"));

fun opentheory2 s = FILE2:=TextIO.openIn(setdir(s^".thy2"));

fun getlines() = let val A = (TextIO.input(!FILE2))

in if foundin (#"\\") (explode A) then nobackslash A
 else A^(getlines()) end;

fun loadtheory s = (opentheory1 s; readtheoryterm1 (parseprop(getlines()));
   TextIO.closeIn(!FILE2);opentheory2 s; readtheoryterm2 (parseprop(getlines()));
   TextIO.closeIn(!FILE2)); 

end edit theory save *)