[Axiom-developer] noisy knownInfo function

[root]

*,

I've rewritten the knownInfo function to be a bit noisier.
It basically prints out which branch of the COND it takes
(0 thru 10) and the value of |pred|. You may find this
useful for debugging the )co xpoly )con XPR bug

The nature of the bug, as I understand it so far, is that Axiom
algebra code can contain conditions on operations based on categories.
Thus you can say that 
if (a domain) R HAS (some category)
  then (it has this operation)

This allows Axiom to conditionally define functions (say inverse)
only if the domain is built on something which has division.

You can save this into the file knownInfo.lisp and load it when
you start Axiom:

)lisp (load "knownInfo.lisp")

Then when you run the compiler it will complain bitterly:

)co xpoly )con XPR

and you can watch the compiler work.

Tim
address@hidden
address@hidden
=====================================================================
(in-package 'boot)
(DEFUN |knownInfo| (|pred|) 
 (PROG (|attr| |x| |cat| |a| |vmode| |l| |LETTMP#1| |vv| |catlist| |u| 
        |ISTMP#1| |name| |ISTMP#2| |op| |ISTMP#3| |sig| |v| |ww|) 
(format t "knownInfo (0) ~a~%" |pred|)
  (cond 
   ((eq |pred| t) 
(format t "fastexit~%")
t)
   (t
  (RETURN 
   (SEQ 
    (COND 
     ((BOOT-EQUAL |pred| (QUOTE T))
(format t "knownInfo (1) ~a~%" |pred|)
      (QUOTE T))
     ((|member| |pred| (|get| (QUOTE |$Information|) (QUOTE |special|) |$e|))
(format t "knownInfo (2) ~a~%" |pred|)
      (QUOTE T))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE OR))
       (PROGN (SPADLET |l| (QCDR |pred|)) (QUOTE T)))
(format t "knownInfo (3) ~a~%" |pred|)
      (PROG (#0=#:G3573) 
       (SPADLET #0# NIL)
       (RETURN 
        (DO ((#1=#:G3579 NIL #0#) (#2=#:G3580 |l| (CDR #2#)) (|u| NIL))
            ((OR #1# (ATOM #2#) (PROGN (SETQ |u| (CAR #2#)) NIL)) #0#)
            (SEQ (EXIT (SETQ #0# (OR #0# (|knownInfo| |u|)))))))))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE AND))
       (PROGN (SPADLET |l| (QCDR |pred|)) (QUOTE T)))
(format t "knownInfo (4) ~a~%" |pred|)
      (PROG (#3=#:G3587) 
       (SPADLET #3# (QUOTE T))
       (RETURN 
        (DO ((#4=#:G3593 NIL (NULL #3#)) (#5=#:G3594 |l| (CDR #5#)) (|u| NIL))
        ((OR #4# (ATOM #5#) (PROGN (SETQ |u| (CAR #5#)) NIL)) #3#)
        (SEQ (EXIT (SETQ #3# (AND #3# (|knownInfo| |u|)))))))))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE |or|))
       (PROGN (SPADLET |l| (QCDR |pred|)) (QUOTE T)))
(format t "knownInfo (5) ~a~%" |pred|)
      (PROG (#6=#:G3601) 
       (SPADLET #6# NIL)
       (RETURN 
        (DO ((#7=#:G3607 NIL #6#) (#8=#:G3608 |l| (CDR #8#)) (|u| NIL))
            ((OR #7# (ATOM #8#) (PROGN (SETQ |u| (CAR #8#)) NIL)) #6#)
            (SEQ (EXIT (SETQ #6# (OR #6# (|knownInfo| |u|)))))))))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE |and|))
       (PROGN (SPADLET |l| (QCDR |pred|)) (QUOTE T)))
(format t "knownInfo (6) ~a~%" |pred|)
      (PROG (#9=#:G3615) 
       (SPADLET #9# (QUOTE T))
       (RETURN 
        (DO ((#10=#:G3621 NIL (NULL #9#))
             (#11=#:G3622 |l| (CDR #11#))
             (|u| NIL))
            ((OR #10# (ATOM #11#) (PROGN (SETQ |u| (CAR #11#)) NIL)) #9#)
            (SEQ (EXIT (SETQ #9# (AND #9# (|knownInfo| |u|)))))))))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE ATTRIBUTE))
       (PROGN 
        (SPADLET |ISTMP#1| (QCDR |pred|))
        (AND 
         (PAIRP |ISTMP#1|)
         (PROGN 
          (SPADLET |name| (QCAR |ISTMP#1|))
          (SPADLET |ISTMP#2| (QCDR |ISTMP#1|))
          (AND 
           (PAIRP |ISTMP#2|)
           (EQ (QCDR |ISTMP#2|) NIL)
           (PROGN (SPADLET |attr| (QCAR |ISTMP#2|)) (QUOTE T)))))))
(format t "knownInfo (7) ~a~%" |pred|)
      (SPADLET |v| (|compForMode| |name| |$EmptyMode| |$e|))
      (COND 
       ((NULL |v|) 
        (|stackSemanticError| 
         (CONS 
          (QUOTE |can't find category of |)
          (CONS |name| NIL)) NIL))
       ((QUOTE T) 
        (SPADLET |LETTMP#1| (|compMakeCategoryObject| (CADR |v|) |$e|))
        (SPADLET |vv| (CAR |LETTMP#1|))
        (COND 
         ((NULL |vv|) 
          (|stackSemanticError| 
           (CONS 
            (QUOTE |can't make category of |)
            (CONS |name| NIL)) NIL))
         ((|member| |attr| (ELT |vv| 2)) (QUOTE T))
         ((SPADLET |x| (|assoc| |attr| (ELT |vv| 2))) (|knownInfo| (CADR |x|)))
         ((QUOTE T) NIL)))))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE |has|))
       (PROGN 
        (SPADLET |ISTMP#1| (QCDR |pred|))
        (AND 
         (PAIRP |ISTMP#1|)
         (PROGN 
          (SPADLET |name| (QCAR |ISTMP#1|))
          (SPADLET |ISTMP#2| (QCDR |ISTMP#1|))
          (AND 
           (PAIRP |ISTMP#2|)
           (EQ (QCDR |ISTMP#2|) NIL)
           (PROGN (SPADLET |cat| (QCAR |ISTMP#2|)) (QUOTE T)))))))
(format t "knownInfo (8) ~a~%" |pred|)
      (COND 
       ((AND 
         (PAIRP |cat|)
         (EQ (QCAR |cat|) (QUOTE ATTRIBUTE))
         (PROGN (SPADLET |a| (QCDR |cat|)) (QUOTE T)))
(format t "knownInfo (8a) ~a~%" |pred|)
        (|knownInfo| (CONS (QUOTE ATTRIBUTE) (CONS |name| |a|))))
       ((AND 
          (PAIRP |cat|)
          (EQ (QCAR |cat|) (QUOTE SIGNATURE))
          (PROGN (SPADLET |a| (QCDR |cat|)) (QUOTE T)))
(format t "knownInfo (8b) ~a~%" |pred|)
         (|knownInfo| (CONS (QUOTE SIGNATURE) (CONS |name| |a|))))
       ((AND 
          (PAIRP |name|)
          (EQ (QCAR |name|) (QUOTE |Union|)))
(format t "knownInfo (8c) ~a~%" |pred|)
         NIL)
       ((QUOTE T) 
(format t "knownInfo (8d) ~a~%" |pred|)
         (SPADLET |v| (|compForMode| |name| |$EmptyMode| |$e|))
(format t "compForMode v ~a~%" |v|)
         (COND 
          ((NULL |v|)
(format t "knownInfo (8da) ~a~%" |pred|) 
           (|stackSemanticError| 
            (CONS 
             (QUOTE |can't find category of |) 
             (CONS |name| NIL)) NIL))
          ((QUOTE T) 
(format t "knownInfo (8db) ~a~%" |pred|)
           (SPADLET |vmode| (CADR |v|))
           (COND 
            ((BOOT-EQUAL |cat| |vmode|)
(format t "knownInfo (8dba) ~a~%" |pred|)
              (QUOTE T))
            ((AND 
               (PAIRP |vmode|)
               (EQ (QCAR |vmode|) (QUOTE |Join|))
               (PROGN (SPADLET |l| (QCDR |vmode|)) (QUOTE T))
               (|member| |cat| |l|))
(format t "knownInfo (8dbb) ~a~%" |pred|)
              (QUOTE T))
            ((QUOTE T) 
(format t "knownInfo (8dbc) ~a~%" |pred|)
              (SPADLET |LETTMP#1| (|compMakeCategoryObject| |vmode| |$e|))
;(format t "LETTMP#1 ~a~%" |LETTMP#1|)
              (SPADLET |vv| (CAR |LETTMP#1|))
;(format t "vv ~a~%" |vv|)
              (SPADLET |catlist| (ELT |vv| 4))
(format t "catlist ~a~%" |catlist|)
              (COND 
               ((NULL |vv|)
(format t "knownInfo (8dbba) ~a~%" |pred|) 
                (|stackSemanticError| 
                 (CONS 
                  (QUOTE |can't make category of |)
                  (CONS |name| NIL)) NIL))
               ((|member| |cat| (CAR |catlist|))
(format t "knownInfo (8dbbb) ~a~%" |pred|)
                (QUOTE T))
               ((AND 
                  (SPADLET |u| (|assoc| |cat| (CADR |catlist|)))
(progn
 (format t "cadr catlist ~a~%" (CADR |catlist|))
 (format t "u ~a~%" |u|)
 (format t "cadr u ~a~%" (CADR |u|))
 t)
                  (|knownInfo| (CADR |u|)))
(format t "knownInfo (8dbbc) ~a~%" |pred|)
                 (QUOTE T))
               ((PROG (#12=#:G3629) 
                 (SPADLET #12# NIL)
                 (RETURN 
                  (DO ((#13=#:G3635 NIL #12#)
                       (#14=#:G3636 (CADR |catlist|) (CDR #14#))
                       (|u| NIL))
                      ((OR #13# (ATOM #14#) (PROGN (SETQ |u| (CAR #14#)) NIL))
                        #12#)
                      (SEQ 
                       (EXIT 
                        (SETQ #12# 
                         (OR #12# 
                          (AND 
                           (|AncestorP| |cat| (LIST (CAR |u|)))
(and (format t "knownInfo (8dbbd) ~a~%" |pred|) t)
                           (|knownInfo| (CADR |u|))))))))))
                 (QUOTE T))
               ((QUOTE T) NIL)))))))))
     ((AND 
       (PAIRP |pred|)
       (EQ (QCAR |pred|) (QUOTE SIGNATURE))
       (PROGN 
        (SPADLET |ISTMP#1| (QCDR |pred|))
        (AND 
         (PAIRP |ISTMP#1|)
         (PROGN 
          (SPADLET |name| (QCAR |ISTMP#1|))
          (SPADLET |ISTMP#2| (QCDR |ISTMP#1|))
          (AND 
           (PAIRP |ISTMP#2|)
           (PROGN 
            (SPADLET |op| (QCAR |ISTMP#2|))
            (SPADLET |ISTMP#3| (QCDR |ISTMP#2|))
            (AND 
             (PAIRP |ISTMP#3|)
             (PROGN (SPADLET |sig| (QCAR |ISTMP#3|)) (QUOTE T)))))))))
(format t "knownInfo (9) ~a~%" |pred|)
      (SPADLET |v| (|get| |op| (QUOTE |modemap|) |$e|))
      (DO ((#15=#:G3648 |v| (CDR #15#)) (|w| NIL))
          ((OR (ATOM #15#) (PROGN (SETQ |w| (CAR #15#)) NIL)) NIL)
          (SEQ 
           (EXIT 
            (PROGN 
             (SPADLET |ww| (CDAR |w|))
             (SEQ 
              (COND 
               ((AND 
                 (BOOT-EQUAL (LENGTH |ww|) (LENGTH |sig|))
                 (|SourceLevelSubsume| |ww| |sig|))
               (COND 
                ((BOOT-EQUAL (CAADR |w|) (QUOTE T))
                 (EXIT (RETURN (QUOTE T)))))))))))))
     ((QUOTE T)
(format t "knownInfo (10) ~a~%" |pred|)
       NIL)))) 
 ))
))