; Copyright (C) 2023, ForrestHunt, Inc.
; Written by Matt Kaufmann
; License: A 3-clause BSD license.  See the LICENSE file distributed with ACL2.
; ...
; Also Copyright (C) 2023, Regents of the University of Texas
; Written by Matt Kaufmann and J Strother Moore
; as this is derived from ACL2 source file induct.lisp.

; Last updated for git commit: 8ef94c04ca9a3c7b9d7708696479d609944db454

(defun expand-abbreviations (term alist geneqv pequiv-info
                                  fns-to-be-ignored-by-rewrite
                                  rdepth step-limit ens wrld state ttree)

; This function is essentially like rewrite but is more restrictive in its use
; of rules.  We rewrite term/alist maintaining geneqv and pequiv-info, avoiding
; the expansion or application of lemmas to terms whose fns are in
; fns-to-be-ignored-by-rewrite.  We return a new term and a ttree (accumulated
; onto our argument) describing the rewrite.  We only apply "abbreviations"
; which means we expand lambda applications and non-rec fns provided they do
; not duplicate arguments or introduce IFs, etc. (see abbreviationp), and we
; apply those unconditional :REWRITE rules with the same property.

; It used to be written:

;  Note: In a break with Nqthm and the first four versions of ACL2, in
;  Version 1.5 we also expand IMPLIES terms here.  In fact, we expand
;  several members of *expandable-boot-strap-non-rec-fns* here, and
;  IFF.  The impetus for this decision was the forcing of impossible
;  goals by simplify-clause.  As of this writing, we have just added
;  the idea of forcing rounds and the concomitant notion that forced
;  hypotheses are proved under the type-alist extant at the time of the
;  force.  But if the simplifier sees IMPLIES terms and rewrites their
;  arguments, it does not augment the context, e.g., in (IMPLIES hyps
;  concl) concl is rewritten without assuming hyps and thus assumptions
;  forced in concl are context free and often impossible to prove.  Now
;  while the user might hide propositional structure in other functions
;  and thus still suffer this failure mode, IMPLIES is the most common
;  one and by opening it now we make our context clearer.  See the note
;  below for the reason we expand other
;  *expandable-boot-strap-non-rec-fns*.

; This is no longer true.  We now expand the IMPLIES from the original theorem
; in preprocess-clause before expand-abbreviations is called, and do not expand
; any others here.  These changes in the handling of IMPLIES (as well as
; several others) are caused by the introduction of assume-true-false-if.  See
; the mini-essay at assume-true-false-if.

  (cond
   ((zero-depthp rdepth)
; patch file: my-rdepth-error instead of rdepth-error
#|
    (rdepth-error
|#
    (my-rdepth-error ;patch;
     (mv step-limit term ttree)
     t))
   ((time-limit5-reached-p ; nil, or throws
     "Out of time in preprocess (expand-abbreviations).")
    (mv step-limit nil nil))
   (t
    (let ((step-limit (decrement-step-limit step-limit)))
      (cond
       ((variablep term)
        (let ((temp (assoc-eq term alist)))
          (cond (temp (mv step-limit (cdr temp) ttree))
                (t (mv step-limit term ttree)))))
       ((fquotep term) (mv step-limit term ttree))
       ((and (eq (ffn-symb term) 'return-last)

; We avoid special treatment for return-last when the first argument is progn,
; since the user may have intended the first argument to be rewritten in that
; case; for example, the user might want to see a message printed when the term
; (prog2$ (cw ...) ...) is encountered.  But it is useful in the other cases,
; in particular for calls of return-last generated by calls of mbe, to avoid
; spending time simplifying the next-to-last argument.

             (not (equal (fargn term 1) ''progn)))
        (expand-abbreviations (fargn term 3)
                              alist geneqv pequiv-info
                              fns-to-be-ignored-by-rewrite rdepth
                              step-limit ens wrld state
                              (push-lemma
                               (fn-rune-nume 'return-last nil nil wrld)
                               ttree)))
       ((eq (ffn-symb term) 'hide)
        (mv step-limit
            (sublis-var alist term)
            ttree))
       (t
        (mv-let
         (deep-pequiv-lst shallow-pequiv-lst)
         (pequivs-for-rewrite-args (ffn-symb term) geneqv pequiv-info wrld ens)
         (sl-let
          (expanded-args ttree)
          (expand-abbreviations-lst (fargs term)
                                    alist
                                    1 nil deep-pequiv-lst shallow-pequiv-lst
                                    geneqv (ffn-symb term)
                                    (geneqv-lst (ffn-symb term) geneqv ens wrld)
                                    fns-to-be-ignored-by-rewrite
                                    (adjust-rdepth rdepth) step-limit
                                    ens wrld state ttree)
          (let* ((fn (ffn-symb term))
                 (term (cons-term fn expanded-args)))

; If term does not collapse to a constant, fn is still its ffn-symb.

            (cond
             ((fquotep term)

; Term collapsed to a constant.  But it wasn't a constant before, and so
; it collapsed because cons-term executed fn on constants.  So we record
; a use of the executable-counterpart.

              (mv step-limit
                  term
                  (push-lemma (fn-rune-nume fn nil t wrld) ttree)))
             ((member-equal fn fns-to-be-ignored-by-rewrite)
              (mv step-limit (cons-term fn expanded-args) ttree))
             ((and (all-quoteps expanded-args)
                   (enabled-xfnp fn ens wrld)
                   (or (flambda-applicationp term)
                       (not (getpropc fn 'constrainedp nil wrld))))
              (cond ((flambda-applicationp term)
                     (expand-abbreviations
                      (lambda-body fn)
                      (pairlis$ (lambda-formals fn) expanded-args)
                      geneqv pequiv-info
                      fns-to-be-ignored-by-rewrite
                      (adjust-rdepth rdepth) step-limit ens wrld state ttree))
                    ((programp fn wrld)

; We formerly thought this case was possible during admission of recursive
; definitions.  Best if it's not!  So we cause an error; if we ever hit this
; case, we can think about whether allowing :program mode functions into the
; prover processes is problematic.  Our concern about :program mode functions
; in proofs has led us in May 2016 to change the application of meta functions
; and clause-processors to insist that the result is free of :program mode
; function symbols.

                     (mv step-limit
;                        (cons-term fn expanded-args)
                         (er hard! 'expand-abbreviations
                             "Implementation error: encountered :program mode ~
                              function symbol, ~x0"
                             fn)
                         ttree))
                    (t
                     (mv-let
                      (erp val bad-fn)
                      (pstk
                       (ev-fncall+ fn (strip-cadrs expanded-args) t state))
                      (declare (ignore bad-fn))
                      (cond
                       (erp

; We originally followed a suggestion from Matt Wilding and attempt to simplify
; the term before applying HIDE.  Now, we partially follow an idea from Eric
; Smith of avoiding the application of HIDE -- we do this only here in
; expand-abbreviations, expecting that the rewriter will apply HIDE if
; appropriate.

                        (expand-abbreviations-with-lemma
                         (cons-term fn expanded-args)
                         geneqv pequiv-info
                         fns-to-be-ignored-by-rewrite
                         rdepth step-limit ens wrld state ttree))
                       (t (mv step-limit
                              (kwote val)
                              (push-lemma (fn-rune-nume fn nil t wrld)
                                          ttree))))))))
             ((flambdap fn)
              (cond ((abbreviationp nil
                                    (lambda-formals fn)
                                    (lambda-body fn))
                     (expand-abbreviations
                      (lambda-body fn)
                      (pairlis$ (lambda-formals fn) expanded-args)
                      geneqv pequiv-info
                      fns-to-be-ignored-by-rewrite
                      (adjust-rdepth rdepth) step-limit ens wrld state ttree))
                    (t

; Once upon a time (well into v1-9) we just returned (mv term ttree)
; here.  But then Jun Sawada pointed out some problems with his proofs
; of some theorems of the form (let (...) (implies (and ...)  ...)).
; The problem was that the implies was not getting expanded (because
; the let turns into a lambda and the implication in the body is not
; an abbreviationp, as checked above).  So we decided that, in such
; cases, we would actually expand the abbreviations in the body
; without expanding the lambda itself, as we do below.  This in turn
; often allows the lambda to expand via the following mechanism.
; Preprocess-clause calls expand-abbreviations and it expands the
; implies into IFs in the body without opening the lambda.  But then
; preprocess-clause calls clausify-input which does another
; expand-abbreviations and this time the expansion is allowed.  We do
; not imagine that this change will adversely affect proofs, but if
; so, well, the old code is shown on the first line of this comment.

                     (sl-let (body ttree)
                             (expand-abbreviations
                              (lambda-body fn)
                              nil
                              geneqv
                              nil ; pequiv-info
                              fns-to-be-ignored-by-rewrite
                              (adjust-rdepth rdepth) step-limit ens wrld state
                              ttree)

; Rockwell Addition:

; Once upon another time (through v2-5) we returned the fcons-term
; shown in the t clause below.  But Rockwell proofs indicate that it
; is better to eagerly expand this lambda if the new body would make
; it an abbreviation.

                             (cond
                              ((abbreviationp nil
                                              (lambda-formals fn)
                                              body)
                               (expand-abbreviations
                                body
                                (pairlis$ (lambda-formals fn) expanded-args)
                                geneqv pequiv-info
                                fns-to-be-ignored-by-rewrite
                                (adjust-rdepth rdepth) step-limit ens wrld state
                                ttree))
                              (t
                               (mv step-limit
                                   (mcons-term (list 'lambda (lambda-formals fn)
                                                     body)
                                               expanded-args)
                                   ttree)))))))
             ((member-eq fn '(iff synp mv-list cons-with-hint return-last
                                  wormhole-eval force case-split
                                  double-rewrite))

; The list above is an arbitrary subset of *expandable-boot-strap-non-rec-fns*.
; Once upon a time we used the entire list here, but Bishop Brock complained
; that he did not want EQL opened.  So we have limited the list to just the
; propositional function IFF and the no-ops.

; Note: Once upon a time we did not expand any propositional functions
; here.  Indeed, one might wonder why we do now?  The only place
; expand-abbreviations was called was from within preprocess-clause.
; And there, its output was run through clausify-input and then
; remove-trivial-clauses.  The latter called tautologyp on each clause
; and that, in turn, expanded all the functions above (but discarded
; the expansion except for purposes of determining tautologyhood).
; Thus, there is no real case to make against expanding these guys.
; For sanity, one might wish to keep the list above in sync with
; that in tautologyp, where we say about it: "The list is in fact
; *expandable-boot-strap-non-rec-fns* with NOT deleted and IFF added.
; The main idea here is to include non-rec functions that users
; typically put into the elegant statements of theorems."  But now we
; have deleted IMPLIES from this list, to support the assume-true-false-if
; idea, but we still keep IMPLIES in the list for tautologyp because
; if we can decide it's a tautology by expanding, all the better.

              (with-accumulated-persistence
               (fn-rune-nume fn nil nil wrld)
               ((the #.*fixnum-type* step-limit) term ttree)
               t
               (expand-abbreviations (bbody fn)
                                     (pairlis$ (formals fn wrld) expanded-args)
                                     geneqv pequiv-info
                                     fns-to-be-ignored-by-rewrite
                                     (adjust-rdepth rdepth)
                                     step-limit ens wrld state
                                     (push-lemma (fn-rune-nume fn nil nil wrld)
                                                 ttree))))

; Rockwell Addition:  We are expanding abbreviations.  This is new treatment
; of IF, which didn't used to receive any special notice.

             ((eq fn 'if)

; There are no abbreviation (or rewrite) rules hung on IF, so coming out
; here is ok.

              (let ((a (car expanded-args))
                    (b (cadr expanded-args))
                    (c (caddr expanded-args)))
                (cond
                 ((equal b c) (mv step-limit b ttree))
                 ((quotep a)
                  (mv step-limit
                      (if (eq (cadr a) nil) c b)
                      ttree))
                 ((and (equal geneqv *geneqv-iff*)
                       (equal b *t*)
                       (or (equal c *nil*)
                           (ffn-symb-p c 'HARD-ERROR)))

; Some users keep HARD-ERROR disabled so that they can figure out
; which guard proof case they are in.  HARD-ERROR is identically nil
; and we would really like to eliminate the IF here.  So we use our
; knowledge that HARD-ERROR is nil even if it is disabled.  We don't
; even put it in the ttree, because for all the user knows this is
; primitive type inference.

                  (mv step-limit a ttree))
                 (t (mv step-limit
                        (mcons-term 'if expanded-args)
                        ttree)))))

; Rockwell Addition: New treatment of equal.

             ((and (eq fn 'equal)
                   (equal (car expanded-args) (cadr expanded-args)))
              (mv step-limit *t* ttree))
             (t
              (expand-abbreviations-with-lemma
               term geneqv pequiv-info
               fns-to-be-ignored-by-rewrite rdepth step-limit ens
               wrld state ttree))))))))))))

;;; See also patch-induct-2.lsp

