(UNSET-WATERFALL-PARALLELISM)
(ASSIGN SCRIPT-MODE T)
 T
(SET-LD-PROMPT T STATE)
 T
ACL2 !>>(SET-INHIBITED-SUMMARY-TYPES '(TIME STEPS))
 (TIME STEPS)
ACL2 !>>(SET-INHIBIT-OUTPUT-LST '(PROOF-TREE))
 (PROOF-TREE)
ACL2 !>>(LOOP$ FOR I IN '(1 2 3 4) SUM (* I I))
30
ACL2 !>>(LOOP$ WITH SUM = 0 WITH LST = '(1 2 3 4)
               DO
               (IF (CONSP LST)
                   (LET ((SQ (* (CAR LST) (CAR LST))))
                     (PROGN (SETQ SUM (+ SQ SUM))
                            (SETQ LST (CDR LST))))
                 (RETURN SUM)))
30
ACL2 !>>(INCLUDE-BOOK "projects/apply/top"
                      :DIR :SYSTEM)

Summary
Form:  ( INCLUDE-BOOK "projects/apply/top" ...)
Rules: NIL
 (:SYSTEM . "projects/apply/top.lisp")
ACL2 !>>(DEFSTOBJ ST FLD)

Summary
Form:  ( DEFSTOBJ ST ...)
Rules: NIL
 ST
ACL2 !>>(DEFWARRANT FLD)


FLD is now warranted by APPLY$-WARRANT-FLD, with badge 
(APPLY$-BADGE 1 1 . T).

 :WARRANTED
ACL2 !>>(DEFWARRANT UPDATE-FLD)


UPDATE-FLD is now warranted by APPLY$-WARRANT-UPDATE-FLD, with badge
(APPLY$-BADGE 2 1 . T).

 :WARRANTED
ACL2 !>>(LOOP$
         WITH SUM = 0 WITH LST = '(1 2 3 4)
         DO :VALUES (NIL ST)
         (IF (CONSP LST)
             (LET ((SQ (* (CAR LST) (CAR LST))))
               (PROGN (MV-SETQ (SUM ST)
                               (LET ((ST (UPDATE-FLD (CONS SQ (FLD ST)) ST)))
                                 (MV (+ SQ SUM) ST)))
                      (SETQ LST (CDR LST))))
           (RETURN (MV SUM ST))))
(30 <st>)
ACL2 !>>(FLD ST)
(16 9 4 1)
ACL2 !>>(LOOP$ WITH SUM =
               0 WITH I = 1 DO :MEASURE (NFIX (- 5 I))
               (IF (<= I 4)
                   (LET ((SQ (* I I)))
                     (PROGN (SETQ SUM (+ SQ SUM))
                            (SETQ I (1+ I))))
                 (LOOP-FINISH))
               FINALLY (RETURN SUM))
30
ACL2 !>>(DEFUN F (N)
          (DECLARE (XARGS :GUARD (NATP N)))
          (LOOP$ WITH SUM OF-TYPE INTEGER
                 = 0 WITH I = N DO :GUARD (NATP I)
                 (IF (ZP I)
                     (RETURN SUM)
                   (LET ((SQ (* I I)))
                     (PROGN (SETQ SUM (+ SQ SUM))
                            (SETQ I (1- I)))))))

Since F is non-recursive, its admission is trivial.  We could deduce
no constraints on the type of F.

Computing the guard conjecture for F....

The non-trivial part of the guard conjecture for F, given the :executable-
counterparts of APPLY$-GUARD, CONS and WEAK-DOLIA-P, primitive type
reasoning and the :type-prescription rules ASSOC-EQ-SAFE and 
DO-BODY-GUARD-WRAPPER, is

Goal
(AND
 (LET
  ((TRIPLE
    (TRUE-LIST-FIX
     (APPLY$
      (LAMBDA$ (ALIST)
       (DECLARE
          (XARGS :GUARD (DO-BODY-GUARD-WRAPPER
                             (AND (ALISTP ALIST)
                                  (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                                  (NATP (CDR (ASSOC-EQ-SAFE 'I ALIST))))
                             'NIL)))
       (LET ((SUM (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
             (I (CDR (ASSOC-EQ-SAFE 'I ALIST))))
         (DECLARE (IGNORABLE SUM I))
         (IF (ZP I)
             (CONS ':RETURN
                   (CONS SUM
                         (CONS (CONS (CONS 'SUM SUM)
                                     (CONS (CONS 'I I) 'NIL))
                               'NIL)))
           ((LAMBDA (SQ I SUM)
              ((LAMBDA (SUM I)
                 (RETURN-LAST
                      'PROGN
                      (CHECK-DCL-GUARDIAN
                           (INTEGERP SUM)
                           '(SETQ SUM (THE INTEGER (BINARY-+ SQ SUM))))
                      (CONS 'NIL
                            (CONS 'NIL
                                  (CONS ((LAMBDA (I SUM)
                                           (CONS (CONS 'SUM SUM)
                                                 (CONS (CONS 'I I) 'NIL)))
                                         (BINARY-+ '-1 I)
                                         SUM)
                                        'NIL)))))
               (BINARY-+ SQ SUM)
               I))
            (BINARY-* I I)
            I SUM))))
      (LIST ALIST)))))
  (LET ((EXIT-FLG (CAR TRIPLE))
        (NEW-ALIST (CADDR TRIPLE)))
   (IMPLIES
    (DO-BODY-GUARD-WRAPPER (AND (ALISTP ALIST)
                                (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                                (NATP (CDR (ASSOC-EQ-SAFE 'I ALIST))))
                           NIL)
    (CASE EXIT-FLG
     ((NIL)
      (AND
       (DO-BODY-GUARD-WRAPPER
            (AND (ALISTP NEW-ALIST)
                 (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM NEW-ALIST)))
                 (NATP (CDR (ASSOC-EQ-SAFE 'I NEW-ALIST))))
            NIL)
       (L<
        (LEX-FIX
         (APPLY$
          (LAMBDA$ (ALIST)
           (DECLARE
            (XARGS
                 :GUARD (DO-BODY-GUARD-WRAPPER
                             (AND (ALISTP ALIST)
                                  (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                                  (NATP (CDR (ASSOC-EQ-SAFE 'I ALIST))))
                             'NIL)))
           (LET ((SUM (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                 (I (CDR (ASSOC-EQ-SAFE 'I ALIST))))
             (DECLARE (IGNORABLE SUM I))
             (ACL2-COUNT I)))
          (LIST NEW-ALIST)))
        (LEX-FIX
         (APPLY$
          (LAMBDA$ (ALIST)
           (DECLARE
            (XARGS
                 :GUARD (DO-BODY-GUARD-WRAPPER
                             (AND (ALISTP ALIST)
                                  (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                                  (NATP (CDR (ASSOC-EQ-SAFE 'I ALIST))))
                             'NIL)))
           (LET ((SUM (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                 (I (CDR (ASSOC-EQ-SAFE 'I ALIST))))
             (DECLARE (IGNORABLE SUM I))
             (ACL2-COUNT I)))
          (LIST ALIST))))))
     (:LOOP-FINISH (DO-BODY-GUARD-WRAPPER
                        (AND (ALISTP NEW-ALIST)
                             (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM NEW-ALIST))))
                        NIL))
     (OTHERWISE T)))))
 (IMPLIES
     (NATP N)
     (DO-BODY-GUARD-WRAPPER
          (AND (ALISTP (LIST '(SUM . 0) (CONS 'I N)))
               (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM
                                             (LIST '(SUM . 0) (CONS 'I N)))))
               (NATP (CDR (ASSOC-EQ-SAFE 'I
                                         (LIST '(SUM . 0) (CONS 'I N))))))
          NIL))
 (IMPLIES (AND (DO-BODY-GUARD-WRAPPER (NATP (CDR (ASSOC-EQ-SAFE 'I ALIST)))
                                      NIL)
               (INTEGERP (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
               (ALISTP ALIST))
          (LET ((SUM (CDR (ASSOC-EQ-SAFE 'SUM ALIST)))
                (I (CDR (ASSOC-EQ-SAFE 'I ALIST))))
            (AND (INTEGERP I)
                 (<= 0 I)
                 (OR (ZP I) (ACL2-NUMBERP I))
                 (OR (ZP I)
                     (LET ((SQ (* I I)))
                       (AND (ACL2-NUMBERP SQ)
                            (ACL2-NUMBERP SUM)
                            (LET ((SUM (+ SQ SUM)))
                              (AND (INTEGERP SUM)
                                   (ACL2-NUMBERP I)))))))))).
Subgoal 2

Splitter note (see :DOC splitter) for Subgoal 2 (3 subgoals).
  if-intro: ((:DEFINITION NOT) (:REWRITE ZP-OPEN))

Subgoal 2.3
Subgoal 2.2
Subgoal 2.2'
Subgoal 2.1
Subgoal 1

Q.E.D.

That completes the proof of the guard theorem for F.  F is compliant
with Common Lisp.

Summary
Form:  ( DEFUN F ...)
Rules: ((:COMPOUND-RECOGNIZER NATP-COMPOUND-RECOGNIZER)
        (:DEFINITION ACL2-COUNT)
        (:DEFINITION ALISTP)
        (:DEFINITION CHECK-DCL-GUARDIAN)
        (:DEFINITION DO-BODY-GUARD-WRAPPER)
        (:DEFINITION INTEGER-ABS)
        (:DEFINITION L<)
        (:DEFINITION LEN)
        (:DEFINITION LEX-FIX)
        (:DEFINITION NATP)
        (:DEFINITION NFIX)
        (:DEFINITION NOT)
        (:DEFINITION PAIRLIS$)
        (:DEFINITION RETURN-LAST)
        (:DEFINITION SYNP)
        (:EXECUTABLE-COUNTERPART <)
        (:EXECUTABLE-COUNTERPART ALISTP)
        (:EXECUTABLE-COUNTERPART APPLY$-GUARD)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART INTEGERP)
        (:EXECUTABLE-COUNTERPART PAIRLIS$)
        (:EXECUTABLE-COUNTERPART TAU-SYSTEM)
        (:EXECUTABLE-COUNTERPART WEAK-DOLIA-P)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE ASSOC-EQ-SAFE-CONS-CONS)
        (:REWRITE BETA-REDUCTION)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE EV$-OPENER)
        (:REWRITE TRUE-LISTP-TRUE-LIST-FIX-ID)
        (:REWRITE ZP-OPEN)
        (:TYPE-PRESCRIPTION ASSOC-EQ-SAFE)
        (:TYPE-PRESCRIPTION DO-BODY-GUARD-WRAPPER)
        (:TYPE-PRESCRIPTION NONNEGATIVE-PRODUCT))
Splitter rules (see :DOC splitter):
  if-intro: ((:DEFINITION NOT) (:REWRITE ZP-OPEN))
 F
ACL2 !>>(F 4)
30
ACL2 !>>Bye.
