(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

(FILECREATED "18-Jul-88 19:21:28" |{POGO:AISNORTH:XEROX}<LOOPSCORE>TRUCKIN>PLAYERS>FIXRULES.;3|
 9117   

      |changes| |to:|  (FNS CONVERT-RULES MANUAL-CONVERT-RULES)
                       (VARS FIXRULESCOMS)

      |previous| |date:| "12-Jul-88 23:16:38" |{POGO:AISNORTH:XEROX}<LOOPSCORE>TRUCKIN>FIXRULES.;1|
)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT FIXRULESCOMS)

(RPAQQ FIXRULESCOMS
 ((FNS CONVERT-RULES MANUAL-CONVERT-RULES |NoticeMethodChanged|)))
(DEFINEQ

(CONVERT-RULES

  (LAMBDA (|file|)
                                           (* \; "Edited 15-Jul-88 15:46 by jrb:")


    (LET* ((|methods| (FILECOMSLST |file| 'METHODS))
           (|instances| (CL:SET-DIFFERENCE (FILECOMSLST |file| 'INSTANCES)
                               |methods|))
           |badrules| \m |rs| |rsname|)
          
          (* |;;| 

          "(className (CAR (FILECOMSLST file 'CLASSES))) (ruletail (CONCAT className \"Rules\"))")


(* |;;;| "Special-purpose hack to convert Truckin rules.  Truckin's rules are of this form:")


(* |;;;| "(Method ((Player.RuleSet) self) (PlayerRuleSetRules self))")


(* |;;;| "where PlayerRuleSetRules is a RuleSet.  We want the RuleSet to be Player.RuleSet, so when we run into one of these, we have to switch stuff around and recompile the ruleset")


          (|for|
 |mname| |in|
 |methods| |bind|
 |className|
             |do|
 (SETQ \m ($! |mname|))
                  (SETQ |className| (@ \m |className|))
                  (|if|
 (AND (SETQ |rsname| (|GetValue| \m '|method| '|RuleSet|))
                             (CL:SYMBOLP |rsname|)
                             (SETQ |rs| ($! |rsname|))
                             (_ |rs| |InstOf| ($ |RuleSet|)))
                      |then|
 (SETQ |instances| (CL:REMOVE |rsname| |instances|))
                            (DELFROMFILE |rsname| 'INSTANCES |file|)
                            (DELFROMFILE |rsname| 'FNS |file|)
                            (LET ((|selector| (@ \m |selector|))
                                  |newrs|)
                                 (_ ($! (@ \m |className|))
                                    |Delete|
                                    '|Method|
                                    (@ \m |selector|)
                                    T)
                                 (SETQ |newrs| (_ ($ |RuleSet|)
                                                  |New| NIL |mname|))
                                 (_@ |newrs| |className| |className|)
                                 (_@ |newrs| |workSpace| |className|)
                                 (_@ |newrs| |selector| |selector|)
                                 (_@ |newrs| |method:,RuleSet| |newrs|)
                                 (_@ |newrs| |tempVars| (@ |rs| |tempVars|))
                                 (_@ |newrs| |taskVars| (@ |rs| |taskVars|))
                                 (_@ |newrs| |debugVars| (@ |rs| |debugVars|))
                                 (SETQ |rsRuleClass| (@ |newrs| |ruleClass|))
                                 (SETQ |ruleSetSource| (_ |newrs| |GetPersp| '|Source|))
                                 (|SaveRules| |ruleSetSource| |newrs| (_ (_ |rs| |GetPersp|
                                                                                 '|Source|)
                                                                         |GetSource|))
                                 (ADDTOFILE |mname| 'METHODS |file|)
                                 (_ |newrs| |CompileRules|)
                                 (|if|
 |parseErrorFlg|
                                     |then|
 (|push|
 |badrules| |mname|)))))
          (|for|
 |className| |in|
 (FILECOMSLST |file| 'CLASSES) |bind|
 |ruletail|
             |do|
 (SETQ |ruletail| (CONCAT |className| "Rules"))
                  (|for|
 |rsname| |in|
 |instances| |bind|
 |mname| |when|
 (STRPOS |ruletail| |rsname|)
                     |do|
 (LET ((|selector| (MKATOM (SUBSTRING |rsname| 1 (SUB1 (STRPOS |ruletail| 
                                                                                       |rsname|)))))
                                |newrs|)
                               (SETQ |mname| (PACK* |className| "." |selector|))
                               (SETQ |rs| ($! |rsname|))
                               (CL:FORMAT T "Hack-converting ~A to ~A~%" |rsname| |mname|)
                               (SETQ |newrs| (_ ($ |RuleSet|)
                                                |New| NIL |mname|))
                               (_@ |newrs| |className| |className|)
                               (_@ |newrs| |workSpace| |className|)
                               (_@ |newrs| |selector| |selector|)
                               (_@ |newrs| |method:,RuleSet| |newrs|)
                               (_@ |newrs| |tempVars| (@ |rs| |tempVars|))
                               (_@ |newrs| |taskVars| (@ |rs| |taskVars|))
                               (_@ |newrs| |debugVars| (@ |rs| |debugVars|))
                               (SETQ |rsRuleClass| (@ |newrs| |ruleClass|))
                               (SETQ |ruleSetSource| (_ |newrs| |GetPersp| '|Source|))
                               (|SaveRules| |ruleSetSource| |newrs| (_ (_ |rs| |GetPersp|
                                                                               '|Source|)
                                                                       |GetSource|))
                               (ADDTOFILE |mname| 'METHODS |file|)
                               (SETQ |instances| (CL:REMOVE |rsname| |instances|))
                               (DELFROMFILE |rsname| 'INSTANCES |file|)
                               (DELFROMFILE |rsname| 'FNS |file|)
                               (_ |newrs| |CompileRules|)
                               (|if|
 |parseErrorFlg|
                                   |then|
 (|push|
 |badrules| |mname|)))))
          (|if|
 (|for|
 \i |in|
 |instances| |thereis|
 (_ ($! \i)
                                                        |InstOf|
                                                        ($ |RuleSet|)))
              |then|
 (CL:FORMAT *ERROR-OUTPUT* "There are unconverted RuleSets on file ~A~%" |file|))
          (|if|
 |badrules|
              |then|
 (CL:FORMAT *ERROR-OUTPUT* 
                         "The following rule sets did not compile and are not installed as methods~%"
                            )
                    (CL:FORMAT *ERROR-OUTPUT* "To edit them, do:~%(_ ($ <method-name>) ER)")
                    |badrules|))))

(MANUAL-CONVERT-RULES

  (LAMBDA (|file| |rsname| |className| |selector|)
           (* \; "Edited 15-Jul-88 16:55 by jrb:")


    (LET (|newrs| (|mname| (PACK* |className| "." |selector|)))
         (SETQ |rs| ($! |rsname|))
         (CL:FORMAT T "Hack-converting ~A to ~A~%" |rsname| |mname|)
         (SETQ |newrs| (_ ($ |RuleSet|)
                          |New| NIL |mname|))
         (_@ |newrs| |className| |className|)
         (_@ |newrs| |workSpace| |className|)
         (_@ |newrs| |selector| |selector|)
         (_@ |newrs| |method:,RuleSet| |newrs|)
         (_@ |newrs| |tempVars| (@ |rs| |tempVars|))
         (_@ |newrs| |taskVars| (@ |rs| |taskVars|))
         (_@ |newrs| |debugVars| (@ |rs| |debugVars|))
         (SETQ |rsRuleClass| (@ |newrs| |ruleClass|))
         (SETQ |ruleSetSource| (_ |newrs| |GetPersp| '|Source|))
         (|SaveRules| |ruleSetSource| |newrs| (_ (_ |rs| |GetPersp| '|Source|)
                                                 |GetSource|))
         (ADDTOFILE |mname| 'METHODS |file|)
         (DELFROMFILE |rsname| 'INSTANCES |file|)
         (DELFROMFILE |rsname| 'FNS |file|)
         (_ |newrs| |CompileRules|))))

(|NoticeMethodChanged|

  (LAMBDA (|name| |type| |reason|)
                           (* \; "Edited 11-Jul-88 21:31 by jrb:")


(* |;;;| "The method has changed.")

                                                             (* \; 

                                                          "Patch up the comment in the method object")


    (LET ((|methObj| ($! |name|)))
         (COND
            ((AND |methObj| (NOT (|\\Loading-File?|))
                  (NOT (MEMB |reason| '(LOAD DELETED)))
                  (@ |methObj| |className|)
                  ($! (@ |methObj| |className|))
                  (@ |methObj| |selector|))
             (_ ($! (@ |methObj| |className|))
                |CommentMethods|
                (@ |methObj| |selector|)
                T))))                                        (* \; 

                                                    "Tell MasterScope that the function has changed.")

          
          (* |;;| "JRB - No longer necessary for Lyric - Masterscope analyzes the METHOD-FNS directly. (MSMARKCHANGED name 'FNS reason)")


    ))
)
(PUTPROPS FIXRULES COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (576 9037 (CONVERT-RULES 586 . 6744) (MANUAL-CONVERT-RULES 6746 . 7919) (
|NoticeMethodChanged| 7921 . 9035)))))
STOP