skip rts clause when one is already supplied

[ecpeterson]

Closes #58.

[karalekas]

Doesn't seem to work -- still getting the same warning from #58 when working off this branch:

; file: /var/tmp/slime3no11A
; in: DEFINE-PROCESS-UPKEEP ((SUPERVISOR SUPERVISOR))
;     (AETHER:WITH-REPLIES (ANATEVKA::REPLIES :RETURNED? ANATEVKA::RETURNED?)
;         (AETHER:SEND-MESSAGE-BATCH #'ANATEVKA::MAKE-MESSAGE-RELEASE-ROOT
;                                    ANATEVKA::CLAIMED-ROOTS)
;       (AETHER:LOG-ENTRY :ENTRY-TYPE ':RELEASED-ROOTS))
; 
; caught STYLE-WARNING:
;   Duplicate key MESSAGE-RTS in TYPECASE form, occurring in clause 1:
;     (MESSAGE-RTS
;      (Q-DEQ-FIRST #:INBOX43 (LAMBDA (#:X44) (TYPEP #:X44 'MESSAGE-RTS)))
;      (RETURN-FROM #:BLOCK-NAME42
;        (VALUES (PROGN (WHEN T (UNREGISTER #:LISTENER28)) (SETF RETURNED? T) NIL)
;                T))), and clause 3:
;     (MESSAGE-RTS
;      (Q-DEQ-FIRST #:INBOX43 (LAMBDA (#:X44) (TYPEP #:X44 'MESSAGE-RTS)))
;      (RETURN-FROM #:BLOCK-NAME42 (VALUES (PROGN (ERROR "Got an RTS.")) T))).

; --> FLET #:REPEATER90 BLOCK LOOP BLOCK LET 
; --> SB-LOOP::WITH-LOOP-LIST-COLLECTION-HEAD LET* TAGBODY IF 
; --> AETHER:RECEIVE-MESSAGE LET LET BLOCK AETHER::DOQ LET BLOCK LET 
; --> LOOP BLOCK LET LET TAGBODY 
; ==>
;   (TYPECASE #:MESSAGE29
;     (AETHER:MESSAGE-RTS
;      (AETHER:Q-DEQ-FIRST #:INBOX96
;                          (LAMBDA (#:X97) (TYPEP #:X97 'AETHER:MESSAGE-RTS)))
;      (RETURN-FROM #:BLOCK-NAME95 (VALUES (PROGN # # NIL) T)))
;     (AETHER:MESSAGE-RPC-DONE
;      (AETHER:Q-DEQ-FIRST #:INBOX96
;                          (LAMBDA (#:X97)
;                            (TYPEP #:X97 'AETHER:MESSAGE-RPC-DONE)))
;      (RETURN-FROM #:BLOCK-NAME95 (VALUES (PROGN # # NIL) T)))
;     (AETHER:MESSAGE-RTS
;      (AETHER:Q-DEQ-FIRST #:INBOX96
;                          (LAMBDA (#:X97) (TYPEP #:X97 'AETHER:MESSAGE-RTS)))
;      (RETURN-FROM #:BLOCK-NAME95 (VALUES (PROGN #) T))))
; 
; caught STYLE-WARNING:
;   Duplicate key MESSAGE-RTS in TYPECASE form, occurring in clause 1:
;     (MESSAGE-RTS
;      (Q-DEQ-FIRST #:INBOX96 (LAMBDA (#:X97) (TYPEP #:X97 'MESSAGE-RTS)))
;      (RETURN-FROM #:BLOCK-NAME95
;        (VALUES (PROGN (WHEN T (UNREGISTER #:LISTENER28)) (SETF RETURNED? T) NIL)
;                T))), and clause 3:
;     (MESSAGE-RTS
;      (Q-DEQ-FIRST #:INBOX96 (LAMBDA (#:X97) (TYPEP #:X97 'MESSAGE-RTS)))
;      (RETURN-FROM #:BLOCK-NAME95 (VALUES (PROGN (ERROR "Got an RTS.")) T))).
; 
; compilation unit finished
;   caught 2 STYLE-WARNING conditions

[karalekas]

see my comment

[ecpeterson]

I do get a type warning when compiling supervisor check-pong:

; caught WARNING:
;   Derived type of ANATEVKA::REPLICA-PONG is
;     (VALUES NULL &OPTIONAL),
;   conflicting with its asserted type
;     ANATEVKA::MESSAGE-PONG.
;   See also:
;     The SBCL Manual, Node "Handling of Types"

but I no longer see any redundant case warnings, which I used to see when compiling supervisor halt. Can you give a more specific repro? "DEFINE-PROCESS-UPKEEP ((SUPERVISOR SUPERVISOR))" is not enough to tell what you're doing.

[ecpeterson]

pushed another message-rts mute lower down, covers with-replies now too