   with TEXT_IO;
   with STRINGS_PACKAGE; use STRINGS_PACKAGE;
   with WORD_PARAMETERS; use WORD_PARAMETERS;
   with DEVELOPER_PARAMETERS; use DEVELOPER_PARAMETERS;
   with INFLECTIONS_PACKAGE; use INFLECTIONS_PACKAGE;
   with DICTIONARY_PACKAGE; use DICTIONARY_PACKAGE;
   with WORD_SUPPORT_PACKAGE; use WORD_SUPPORT_PACKAGE;
   with WORD_PACKAGE; use WORD_PACKAGE;
   with PUT_STAT;
   package body TRICKS_PACKAGE is    
     
      function IS_A_VOWEL(C : CHARACTER) return BOOLEAN is
      begin
         if LOWER_CASE(C) = 'a'  or
         LOWER_CASE(C) = 'e'  or
         LOWER_CASE(C) = 'i'  or
         LOWER_CASE(C) = 'o'  or
         LOWER_CASE(C) = 'u'  or
         LOWER_CASE(C) = 'y'  then
            return TRUE;
         else
            return FALSE;
         end if;
      end IS_A_VOWEL;
   
   
   
   
      function A_ROMAN_DIGIT(CHAR : CHARACTER) return BOOLEAN is
      begin
         case CHAR is
            when 'M' | 'm'  => 
               return TRUE;
            when 'D' | 'd'  => 
               return TRUE;
            when 'C' | 'c'  => 
               return TRUE;
            when 'L' | 'l'  => 
               return TRUE;
            when 'X' | 'x'  => 
               return TRUE;
          --when 'U' | 'u'  => return TRUE;  --  possible but unlikely
            when 'V' | 'v'  => 
               return TRUE;
            when 'I' | 'i'  => 
               return TRUE;
            when others => 
               return FALSE;
         end case;
      end A_ROMAN_DIGIT;
   
      function VALUE(CHAR : CHARACTER) return NATURAL is
      begin
         case CHAR is
            when 'M' | 'm'  => 
               return 1000;
            when 'D' | 'd'  => 
               return  500;
            when 'C' | 'c'  => 
               return  100;
            when 'L' | 'l'  => 
               return   50;
            when 'X' | 'x'  => 
               return   10;
          --when 'U' | 'u'  => return    5;  --  possible but unlikely 
            when 'V' | 'v'  => 
               return    5;
            when 'I' | 'i'  => 
               return    1;
            when others => 
               return    0;
         end case;
      end VALUE;
   
      function ONLY_ROMAN_DIGITS(S : STRING) return BOOLEAN is
      begin
      
      
         for I in S'range  loop
            if not A_ROMAN_DIGIT(S(I))  then
               return FALSE;
            end if;
         end loop;
         return TRUE;
      end ONLY_ROMAN_DIGITS;
   
      function ROMAN_NUMBER(ST : STRING) return NATURAL is
      --  Determines and returns the value of a Roman numeral, or 0 if invalid
      
         use TEXT_IO;
         TOTAL : NATURAL := 0;
         INVALID : exception;
         DECREMENTED : BOOLEAN := FALSE;
         J : INTEGER := 0;
         S : constant STRING := UPPER_CASE(ST);
         
         
      begin
        if ONLY_ROMAN_DIGITS(S)  then
    
--
--NUMERALS IN A STRING ARE ADDED: CC = 200 ; CCX = 210. 
--ONE NUMERAL TO THE LEFT of A LARGER NUMERAL IS SUBTRACTED FROM THAT NUMBER: IX = 9 
--
--SUBTRACT ONLY A SINGLE LETTER FROM A SINGLE NUMERAL. 
--VIII FOR 8, NOT IIX; 19 IS XIX, NOT IXX. 
--
--SUBTRACT ONLY POWERS of TEN, SUCH AS I, X, or C. 
--NOT VL FOR 45, BUT XLV. 
--
--DON'T SUBTRACT A LETTER FROM ANOTHER LETTER MORE THAN TEN TIMES GREATER. 
--ONLY SUBTRACT I FROM V or X, and X FROM L or C.
--NOT IL FOR 49, BUT XLIX. MIM is ILLEGAL. 
--
--ONLY IF ANY NUMERAL PRECEEDING IS AT LEAST TEN TIMES LARGER. 
--NOT VIX FOR 14, BUT XIV. 
--NOT  IIX, BUT VIII. 
--ONLY IF ANY NUMERAL FOLLOWING IS SMALLER. 
--NOT XCL FOR 140, BUT CXL. 
--        
        J := S'LAST;
        
        EVALUATE:
        while J >= S'FIRST  loop
--           
--Legal in the Ones position
--  I
--  II
--  III
--  IIII    IV
--  V
--  VI
--  VII
--  VIII
--  VIIII   IX
--    
--        
              --  Ones
          if S(J) = 'I' then
            TOTAL := TOTAL + 1;
           J := J - 1;
            exit EVALUATE when J < S'FIRST;
            whiLe S(J) = 'I'  loop
              TOTAL := TOTAL + 1;
             if TOTAL >= 5  then raise INVALID; end if;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end loop;
          end if;
       
          if S(J) = 'V'  then
            TOTAL := TOTAL + 5;
           J := J - 1;
            exit EVALUATE when J < S'FIRST;
            if S(J) = 'I'  and TOTAL = 5  then
              TOTAL := TOTAL - 1;
             J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end if;
            
            if S(J) = 'I' or S(J) = 'V'  then raise INVALID; end if;
          end if;
        
--    
--Legal in the tens position
--  X
--  XX
--  XXX
--  XXXX    XL
--  L
--  LX
--  LXX
--  LXXX
--  LXXXX   XC
--    
        
          --  Tens 
          if S(J) = 'X'  then
            TOTAL := TOTAL + 10;
           J := J - 1;
            exit EVALUATE when J < S'FIRST;
            whiLe S(J) = 'X'  loop
              TOTAL := TOTAL + 10;
              if TOTAL >= 50  then raise INVALID; end if;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end loop;
            if S(J) = 'I'  and TOTAL = 10  then
              TOTAL := TOTAL - 1;
               J := J - 1;
               exit EVALUATE when J < S'FIRST;
            end if;
            if S(J) = 'I' or S(J) = 'V'  then
              raise INVALID;
            end if;
          end if;
            
          if S(J) = 'L'  then
            TOTAL := TOTAL + 50;
            J := J - 1;
            exit EVALUATE when J < S'FIRST;

            if S(J) = 'X'  and TOTAL <= 59  then
              TOTAL := TOTAL - 10;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end if;
            if S(J) = 'I' or S(J) = 'V'  or S(J) = 'X'  or S(J) = 'L'  then raise INVALID; end if;
            
            if S(J) = 'C'  then
              TOTAL := TOTAL + 100;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
              if S(J) = 'X'  and TOTAL = 100  then
                TOTAL := TOTAL - 10;
                J := J - 1;
                exit EVALUATE when J < S'FIRST;
              end if;
            end if;
 
            if S(J) = 'I' or S(J) = 'V'  or S(J) = 'X'  or S(J) = 'L'  then raise INVALID; end if;
            end if;
              
          
            if S(J) = 'C'  then
              TOTAL := TOTAL + 100;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
              whiLe S(J) = 'C'  loop
                TOTAL := TOTAL + 100;
                if TOTAL >= 500  then raise INVALID; end if;
                J := J - 1;
                exit EVALUATE when J < S'FIRST;
              end loop;
              if S(J) = 'X'  and TOTAL <= 109  then
                TOTAL := TOTAL - 10;
                J := J - 1;
                exit EVALUATE when J < S'FIRST;
              end if;
              if S(J) = 'I' or S(J) = 'V'  or S(J) = 'X'  or S(J) = 'L'  then raise INVALID; end if;
            end if;
            

    
          if S(J) = 'D'  then
            TOTAL := TOTAL + 500;
            J := J - 1;
            exit EVALUATE when J < S'FIRST;
            if S(J) = 'C'  and TOTAL <= 599  then
              TOTAL := TOTAL - 100;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end if;
            if S(J) = 'M'  then
              TOTAL := TOTAL + 1000;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end if;
            if S(J) = 'C'  and TOTAL <= 1099  then
              TOTAL := TOTAL - 100;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
            end if;
            if S(J) = 'I' or S(J) = 'V'  or S(J) = 'X'  or S(J) = 'L' or S(J) = 'C' or S(J) = 'D'  then raise INVALID; end if;
          end if;
         

            if S(J) = 'M'  then
              TOTAL := TOTAL + 1000;
              J := J - 1;
              exit EVALUATE when J < S'FIRST;
              whiLe S(J) = 'M'  loop
                TOTAL := TOTAL + 1000;
                if TOTAL >= 5000  then raise INVALID; end if;
                J := J - 1;
                exit EVALUATE when J < S'FIRST;
              end loop;
              if S(J) = 'C'  and TOTAL <= 1099  then
                TOTAL := TOTAL - 100;
                J := J - 1;
                exit EVALUATE when J < S'FIRST;
              end if;
              if S(J) = 'I' or S(J) = 'V'  or S(J) = 'X'  or S(J) = 'L' or S(J) = 'C' or S(J) = 'D'  then raise INVALID; end if;
            end if;
 
            
        end loop EVALUATE;
           
          
       end if;  --  On Only Roman digits
      
         return TOTAL;
         exception
            when INVALID  =>
              return 0;
            when CONSTRAINT_ERROR  =>
               return 0;
      end ROMAN_NUMBER;
   
   
      procedure ROMAN_NUMERALS(INPUT_WORD : STRING;
                               PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER) is
      
         W : constant STRING := TRIM(INPUT_WORD);
         ROMAN_NUMBER_W : INTEGER := ROMAN_NUMBER(W);
      
      begin
         if ONLY_ROMAN_DIGITS(W) and then (ROMAN_NUMBER_W /= 0)  then
            PA_LAST := PA_LAST + 1;
            PA(PA_LAST) := ( STEM => HEAD(W, MAX_STEM_SIZE),
                              IR => (
                                    QUAL => (
                                            POFS => NUM,
                                            NUM => (
                                                   DECL   => (2, 0),
                                                   CS     => X,
                                                   NUMBER => X,
                                                   GENDER => X,
                                                   SORT   => CARD) ),
                                    
                                    KEY => 0,
                                    ENDING => NULL_ENDING_RECORD,
                                    AGE => X,
                                    FREQ => A),
                              D_K => RRR,
                              MNPC => NULL_MNPC);
            RRR_MEANING := HEAD(INTEGER'IMAGE(ROMAN_NUMBER_W) & "  as a ROMAN NUMERAL;", 
                                MAX_MEANING_SIZE); 
         else
            null;    --  Is not ROMAN NUMERAL, so go on and try something else
         end if;
      end ROMAN_NUMERALS;
   
   
      function BAD_ROMAN_NUMBER(S : STRING) return NATURAL is
      --  Determines and returns the value of a Roman numeral, or 0 if invalid
      --  This seems to allow all of Caesar's.   Actually there are no rules 
      --  if you look at some of the 12-15 century stuff
         use TEXT_IO;
         TOTAL : INTEGER := 0;
         DECREMENTED_FROM : INTEGER := 0;
         
      begin
      
      --  Already known that all the characters may be valid numerals
      --  Loop over the string to check validity, start with second place
      --PUT_LINE(" In function BAD_ROMAN_NUMBER ");
      --PUT_LINE(" BEFORE LOOP      S = " & S);
         TOTAL := VALUE(S(S'LAST));
         DECREMENTED_FROM := VALUE(S(S'LAST));
         for I in reverse S'FIRST..S'LAST-1  loop
         
            if VALUE(S(I)) < VALUE(S(I+1))  then   
            --  Decrement
               TOTAL := TOTAL - VALUE(S(I));
               DECREMENTED_FROM := VALUE(S(I+1));
            elsif VALUE(S(I)) = VALUE(S(I+1))  then
              if  VALUE(S(I)) < DECREMENTED_FROM  then
                TOTAL := TOTAL - VALUE(S(I));   --  IIX = 8 !
              else
                TOTAL := TOTAL + VALUE(S(I));      
              end if;
            elsif  VALUE(S(I)) > VALUE(S(I+1))  then  
               TOTAL := TOTAL + VALUE(S(I));
               DECREMENTED_FROM := VALUE(S(I+1));
            end if;
         end loop;
         if TOTAL > 0  then
            return TOTAL;
         else
            return 0;
         end if;
      
         exception
            when others  =>
               return 0;
      end BAD_ROMAN_NUMBER;
   
   
   
      procedure SYNCOPE(W : STRING;
                        PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER) is
         S  : constant STRING(1..W'LENGTH) := LOWER_CASE(W);
         PA_SAVE : INTEGER := PA_LAST;
         SYNCOPE_INFLECTION_RECORD : INFLECTION_RECORD := NULL_INFLECTION_RECORD;
      --     ((V, ((0, 0), (X, X, X), 0, X, X)), 0, NULL_ENDING_RECORD, X, A);
      begin
      
      --  Syncopated forms (see Gildersleeve and Lodge, 131)
      
         YYY_MEANING := NULL_MEANING_TYPE;
      
         
         
         --  This one has to go first --  special for 3 4 
         --  ivi  => ii ,  in perfect  (esp. for V 3 4) 
         --  This is handled in WORDS as syncope
         --  It seems to appear in texts as alternative stems  ii and ivi
             for I in reverse S'FIRST..S'LAST-1  loop
               if (S(I..I+1) = "ii")  then
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST) := ("Syncope  ii => ivi", SYNCOPE_INFLECTION_RECORD,
                                    YYY, NULL_MNPC);
                  WORD(S(S'FIRST..I) & "v" & S(I+1..S'LAST), PA, PA_LAST);
                  if PA_LAST > PA_SAVE + 1  then
                     exit;
                  end if;
               end if;
               PA_LAST := PA_SAVE;     --  No luck, or it would have exited above
            end loop;
            if PA_LAST > PA_SAVE + 1  and then
            PA(PA_LAST).IR.QUAL.POFS = V and then
            --PA(PA_LAST).IR.QUAL.V.CON = (3, 4)/(6, 1) and then 
            PA(PA_LAST).IR.KEY = 3  then          --  Perfect system
               YYY_MEANING := HEAD(
                                  "Syncopated perfect ivi can drop 'v' without contracting vowel "
                                  , MAX_MEANING_SIZE);
            
               PUT_STAT("SYNCOPE  ivi at "
                        & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                        & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
               return;
            else
               PA_LAST := PA_SAVE;
            end if;
         
            
            
         
         -- avis => as, evis => es, ivis => is, ovis => os   in perfect 
            for I in reverse S'FIRST..S'LAST-2  loop     --  Need isse 
               if ((S(I..I+1) = "as")  or
                      (S(I..I+1) = "es")  or
                      (S(I..I+1) = "is")  or
                      (S(I..I+1) = "os")) then
               --TEXT_IO.PUT_LINE("SYNCOPE vis   S = " & S & "    PA_SAVE = " & INTEGER'IMAGE(PA_SAVE));
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST)         := ("Syncope   s => vis", SYNCOPE_INFLECTION_RECORD,
                                          YYY, NULL_MNPC);
               --TEXT_IO.PUT_LINE("SYNCOPE vis   S+ = " & S(S'FIRST..I) & "vi" & S(I+1..S'LAST) & "  " & INTEGER'IMAGE(PA_LAST));
                  WORD(S(S'FIRST..I) & "vi" & S(I+1..S'LAST), PA, PA_LAST);
               --TEXT_IO.PUT_LINE("SYNCOPE vis   DONE "  & "    PA_LAST = " & INTEGER'IMAGE(PA_LAST));
                  if PA_LAST > PA_SAVE + 1  then
                     exit;               --  Exit loop here if SYNCOPE found hit
                  end if;
               end if;
               PA_LAST := PA_SAVE;     --  No luck, or it would have exited above
            end loop;
         --  Loop over the resulting solutions
            if PA_LAST > PA_SAVE + 1  and then
            PA(PA_LAST).IR.QUAL.POFS = V and then
            PA(PA_LAST).IR.KEY = 3  then          --  Perfect system
               YYY_MEANING := HEAD(
                                  "Syncopated perfect often drops the 'v' and contracts vowel "
                                  , MAX_MEANING_SIZE);
               PUT_STAT("SYNCOPE  vis at "
                        & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                        & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
            end if;
         --  end loop;   --  over resulting solutions
            if PA_LAST > PA_SAVE + 1  then
            
               return;
            
            else
               PA_LAST := PA_SAVE;
            end if;
            
            
            
            
         
         -- aver => ar, ever => er, in perfect 
            for I in reverse S'FIRST+1..S'LAST-2  loop
               if ((S(I..I+1) = "ar")  or
                      (S(I..I+1) = "er")  or
                      (S(I..I+1) = "or")) then
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST) := ("Syncope   r => v.r", SYNCOPE_INFLECTION_RECORD,
                                    YYY, NULL_MNPC);
                  WORD(S(S'FIRST..I) & "ve" & S(I+1..S'LAST), PA, PA_LAST);
                  if PA_LAST > PA_SAVE + 1  then
                     exit;
                  end if;
               end if;
               PA_LAST := PA_SAVE;     --  No luck, or it would have exited above
            end loop;
            
            
            if PA_LAST > PA_SAVE + 1  and then
            PA(PA_LAST).IR.QUAL.POFS = V and then
            PA(PA_LAST).IR.KEY = 3  then          --  Perfect system
               YYY_MEANING := HEAD(
                                  "Syncopated perfect often drops the 'v' and contracts vowel "
                                  , MAX_MEANING_SIZE);
            
               PUT_STAT("SYNCOPE  ver at "
                        & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                        & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
               return;
            else
               PA_LAST := PA_SAVE;
            end if;
            
            
            
         
         -- iver => ier,  in perfect 
            for I in reverse S'FIRST..S'LAST-3  loop
               if (S(I..I+2) = "ier")  then
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST) := ("Syncope  ier=>iver", SYNCOPE_INFLECTION_RECORD,
                                    YYY, NULL_MNPC);
                  WORD(S(S'FIRST..I) & "v" & S(I+1..S'LAST), PA, PA_LAST);
                  if PA_LAST > PA_SAVE + 1  then
                     exit;
                  end if;
               end if;
               PA_LAST := PA_SAVE;     --  No luck, or it would have exited above
            end loop;
            if PA_LAST > PA_SAVE + 1  and then
               PA(PA_LAST).IR.QUAL.POFS = V and then
               PA(PA_LAST).IR.KEY = 3  then          --  Perfect system
               YYY_MEANING := HEAD(
                                  "Syncopated perfect often drops the 'v' and contracts vowel "
                                  , MAX_MEANING_SIZE);
            
               PUT_STAT("SYNCOPE  ier at "
                        & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                        & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
               return;
            else
               PA_LAST := PA_SAVE;
            end if;
         
            
                  
            
         
--         -- sis => s, xis => x, in perfect 
            for I in reverse S'FIRST..S'LAST-2  loop     
               if ((S(I) = 's')  or
                   (S(I) = 'x'))  then
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST)         := ("Syncope s/x => +is", SYNCOPE_INFLECTION_RECORD,
                                          YYY, NULL_MNPC);
                  WORD(S(S'FIRST..I) & "is" & S(I+1..S'LAST), PA, PA_LAST);
                  if PA_LAST > PA_SAVE + 1  then
                     exit;               --  Exit loop here if SYNCOPE found hit
                  end if;
               end if;
               PA_LAST := PA_SAVE;     --  No luck, or it would have exited above
            end loop;
         --  Loop over the resulting solutions
            if PA_LAST > PA_SAVE + 1  and then
            PA(PA_LAST).IR.QUAL.POFS = V and then
            PA(PA_LAST).IR.KEY = 3  then          --  Perfect system
               YYY_MEANING := HEAD(
                                  "Syncopated perfect sometimes drops the 'is' after 's' or 'x' "
                                  , MAX_MEANING_SIZE);
               PUT_STAT("SYNCOPEx/sis at "
                        & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                        & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                   return;
            else
               PA_LAST := PA_SAVE;
            end if;
         
            
            
            
            
            
         --  end loop;   --  over resulting solutions
            if PA_LAST > PA_SAVE + 1  then
            
               return;
            
            else
               PA_LAST := PA_SAVE;
            end if;            
       
            
         
         
            PA(PA_LAST+1) := NULL_PARSE_RECORD;     --  Just to clear the trys
         
      
         exception
            when others  =>
               PA_LAST := PA_SAVE;
               PA(PA_LAST+1) := NULL_PARSE_RECORD;     --  Just to clear the trys
      
      end SYNCOPE;
   
   
   
      procedure TRY_TRICKS(W : STRING;
                           PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER;
                           LINE_NUMBER : INTEGER; WORD_NUMBER : INTEGER) is
      --  Since the chances are 1/1000 that we have one,
      --  Ignore the possibility of two in the same word
      --  That is called lying with statistics                
         use INFLECTIONS_PACKAGE.INTEGER_IO;
         S  : constant STRING(1..W'LENGTH) := W;
         PA_SAVE : INTEGER := PA_LAST;
      
      
         procedure TWORD(W : STRING;
                         PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER) is
         begin
            WORD_PACKAGE.WORD(W, PA, PA_LAST);
            SYNCOPE(W, PA, PA_LAST);
         end TWORD;
      
      
         procedure FLIP(X1, X2 : STRING; EXPLANATION : STRING := "") is
         --  At the begining of input word, replaces X1 by X2
            PA_SAVE : INTEGER := PA_LAST;
         begin
            if S'LENGTH >= X1'LENGTH+2  and then
            S(S'FIRST..S'FIRST+X1'LENGTH-1) = X1   then
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := (HEAD("Word mod " & X1 & "/" & X2, MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
               TWORD(X2 & S(S'FIRST+X1'LENGTH..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)   and then
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD(
                                        "An initial '" & X1 & "' may have replaced usual '" & X2 & "'"
                                        , MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("TRICK   FLIP at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            end if;
            PA_LAST := PA_SAVE;
         end FLIP;
      
      
      
         procedure FLIP_FLOP(X1, X2 : STRING; EXPLANATION : STRING := "") is
         --  At the begining of input word, replaces X1 by X2 - then X2 by X1
         --  To be uesd only when X1 and X2 start with the same letter because it 
         --  will be called from a point where the first letter is established
            PA_SAVE : INTEGER := PA_LAST;
         begin
--TEXT_IO.PUT_LINE("FLIP_FLOP called    " & X1 & "  " & X2);
             if S'LENGTH >= X1'LENGTH+2  and then
              S(S'FIRST..S'FIRST+X1'LENGTH-1) = X1   then
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := (HEAD("Word mod " & X1 & "/" & X2, MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
 --TEXT_IO.PUT_LINE("Trying " & X2 & S(S'FIRST+X1'LENGTH..S'LAST));
               TWORD(X2 & S(S'FIRST+X1'LENGTH..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)   and then
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
 --TEXT_IO.PUT_LINE("FLIPF worked");
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD(
                                        "An initial '" & X1 & "' may be rendered by '" & X2 & "'"
                                        , MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("TRICK  FLIPF at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            end if;
 --TEXT_IO.PUT_LINE("FLIPF failed");
 --TEXT_IO.PUT_LINE("Try FFLOP");
           
          
              
            if S'LENGTH >= X2'LENGTH+2  and then
            S(S'FIRST..S'FIRST+X2'LENGTH-1) = X2   then
 --TEXT_IO.PUT_LINE("Trying FFLOP");
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := (HEAD("Word mod " & X2 & "/" & X1, MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
  --TEXT_IO.PUT_LINE("Trying " & X1 & S(S'FIRST+X2'LENGTH..S'LAST));
              TWORD(X1 & S(S'FIRST+X2'LENGTH..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)   and then
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
 --TEXT_IO.PUT_LINE("FFLOP worked");
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD(
                                        "An initial '" & X2 & "' may be rendered by '" & X1 & "'"
                                        , MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("TRICK  FFLOP at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            
            end if;
 --TEXT_IO.PUT_LINE("FFLIP failed");
            PA_LAST := PA_SAVE;
         end FLIP_FLOP;
      
      
      
         procedure INTERNAL(X1, X2 : STRING; EXPLANATION : STRING := "") is
         --  Replaces X1 with X2 anywhere in word and tries it for validity
            PA_SAVE : INTEGER := PA_LAST;
         begin
            for I in S'FIRST..S'LAST-X1'LENGTH+1  loop  
               if S(I..I+X1'LENGTH-1) = X1   then
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST) := (HEAD("Word mod " & X1 & "/" & X2, MAX_STEM_SIZE),
                                    NULL_INFLECTION_RECORD,
                                    XXX, NULL_MNPC);
                  TWORD(S(S'FIRST..I-1) & X2 & S(I+X1'LENGTH..S'LAST), PA, PA_LAST);
                  if (PA_LAST > PA_SAVE + 1)   and then
                     (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                     if EXPLANATION = ""  then
                        XXX_MEANING := HEAD(
                                           "An internal '" & X1 & "' might be rendered by '" & X2 & "'"
                                           , MAX_MEANING_SIZE);
                     else
                        XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                     end if;
                     PUT_STAT("TRICK   INTR at "
                              & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                              & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                     return;
                  else
                     PA_LAST := PA_SAVE;
                  end if;
               end if;
            end loop;
            PA_LAST := PA_SAVE;
         end INTERNAL;
      
         procedure ADJ_TERMINAL_IIS(EXPLANATION : STRING := "") is
            PA_SAVE : INTEGER := PA_LAST;
            I : INTEGER := 0;
            TRICK_TRANSLATION_RECORD : TRANSLATION_RECORD := NULL_TRANSLATION_RECORD;
         begin
            if S'LENGTH > 3  and then
            S(S'LAST-1..S'LAST) = "is"   then   --  Terminal 'is'
               PA_LAST := PA_LAST + 1;
               TRICK_TRANSLATION_RECORD.FREQ := C;
               PA(PA_LAST) := (HEAD("Word mod iis -> is", MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
               WORD(S(S'FIRST..S'LAST-2) & "iis", PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)    then
                  I := PA_LAST;
                  while I > PA_SAVE + 1  loop
                     if PA(I).IR.QUAL.POFS = ADJ  and then
                     PA(I).IR.QUAL.ADJ.DECL = (1, 1)  and then
                        ((PA(I).IR.QUAL.ADJ.CS = DAT) or
                            (PA(I).IR.QUAL.ADJ.CS = ABL))   and then
                     PA(I).IR.QUAL.ADJ.NUMBER = P   then
                        null;       --  Only for ADJ 1 1 DAT/ABL P
                     else
                        PA(I..PA_LAST-1) := PA(I+1..PA_LAST);
                        PA_LAST := PA_LAST - 1;
                     end if;
                     I := I - 1;
                  end loop;
               end if;
               if (PA_LAST > PA_SAVE + 1)    then
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD("A Terminal 'iis' on ADJ 1 1 DAT/ABL P might drop 'i'",
                                         MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("TRICK  ADJIS at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            end if;
            PA_LAST := PA_SAVE;
         end ADJ_TERMINAL_IIS;
      
      
      --  Now SLUR is handled in TRY_SLURY
      --
      --    procedure SLUR(X1 : STRING; EXPLANATION : STRING := "") is
      --      PA_SAVE : INTEGER := PA_LAST;
      --      SL : INTEGER := X1'LENGTH;
      --    begin
      --      if S'LENGTH >= X1'LENGTH+2  then
      --        if S(S'FIRST..S'FIRST+X1'LENGTH-1) = X1   and then   --  Initial  X1
      --          not IS_A_VOWEL(S(S'FIRST+SL))                  then
      --          PA_LAST := PA_LAST + 1;
      --          PA(PA_LAST)           := (HEAD("Slur " & X1 & "/" & X1(1..SL-1) & "~", MAX_STEM_SIZE),
      --                    NULL_INFLECTION_RECORD,
      --                    XXX, NULL_MNPC);
      --          TWORD(X1(1..SL-1) & S(S'FIRST+SL) & S(S'FIRST+SL..S'LAST), PA, PA_LAST);
      --          if (PA_LAST > PA_SAVE + 1)   and then
      --            (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
      --            if EXPLANATION = ""  then
      --              XXX_MEANING := HEAD(
      --                    "An initial '" & X1 & "' may be rendered by " & X1(1) & "~"
      --                                 , MAX_MEANING_SIZE);
      --            else
      --              XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
      --            end if;
      --PUT_STAT("TRICK   SLUR at "
      --                       & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
      --                       & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
      --            return;
      --          else
      --            PA_LAST := PA_SAVE;
      --          end if;
      --
      --        elsif (S(S'FIRST..S'FIRST+SL-1) = X1(1..SL-1))  and then
      --              (S(S'FIRST+SL-1) = S(S'FIRST+SL))   and then   --  Double letter
      --          not IS_A_VOWEL(S(S'FIRST+SL))           then  
      --          PA_LAST := PA_LAST + 1;
      --          PA(PA_LAST) := (HEAD("Slur " & X1(1..SL-1) & "~" & "/" & X1, MAX_STEM_SIZE),
      --                    NULL_INFLECTION_RECORD,
      --                    XXX, NULL_MNPC);
      --           TWORD(X1 & S(S'FIRST+SL..S'LAST), PA, PA_LAST);
      --          if (PA_LAST > PA_SAVE + 1)   and then
      --            (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
      --            if EXPLANATION = ""  then
      --              XXX_MEANING := HEAD(
      --                    "An initial '" & X1(1..SL-1) & "~" & "' may be rendered by " & X1
      --                                 , MAX_MEANING_SIZE);
      --            else
      --              XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
      --            end if;
      --PUT_STAT("TRICK   SLUR at "
      --                       & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
      --                       & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
      --            return;
      --          else
      --            PA_LAST := PA_SAVE;
      --      end if;
      --
      --        end if;
      --      end if;
      --      PA_LAST := PA_SAVE;
      --    end SLUR;
      --
      --
      
         procedure DOUBLE_CONSONANTS(EXPLANATION : STRING := "") is
            PA_SAVE : INTEGER := PA_LAST;
         begin
         --  Medieval often replaced a classical doubled consonant with single
         --  The problem is to take possible medieval words 
         --  and double (all) (isolated) consonants
            for I in S'FIRST+1..S'LAST-1 loop  --  probably dont need to go to end
               if (not IS_A_VOWEL(S(I))) and then 
                  (IS_A_VOWEL(S(I-1)) and IS_A_VOWEL(S(I+1))) then
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST)           := (HEAD("Word mod " & S(I) &
                                                 " -> " & S(I) & S(I), MAX_STEM_SIZE),
                                            NULL_INFLECTION_RECORD,
                                            XXX, NULL_MNPC);
                  TWORD(S(S'FIRST..I) & S(I) & S(I+1..S'LAST), PA, PA_LAST);
               --TEXT_IO.PUT_LINE(S(S'FIRST..I) & S(I) & S(I+1..S'LAST));
                  if (PA_LAST > PA_SAVE + 1)   and then
                     (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                     if EXPLANATION = ""  then
                        XXX_MEANING := HEAD(
                                           "A doubled consonant may be rendered by just the single"
                                           & "  MEDIEVAL", MAX_MEANING_SIZE);
                     else
                        XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                     end if;
                     PUT_STAT("TRICK   2CON at "
                              & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                              & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                     return;
                  else
                     PA_LAST := PA_SAVE;
                  end if;
               
               end if;
            end loop;
            PA_LAST := PA_SAVE;
         end DOUBLE_CONSONANTS;
      
      
         procedure TWO_WORDS(EXPLANATION : STRING := "") is
         --  This procedure examines the word to determine if it is made up
         --  of two separate inflectted words
         --  They are usually an adjective and a noun or two nouns
            PA_SAVE, PA_SECOND : INTEGER := PA_LAST;
            NUM_HIT_ONE, NUM_HIT_TWO : BOOLEAN := FALSE;
         --MID : INTEGER := S'LENGTH/2;
            I, I_MID : INTEGER := 0;
            REMEMBER_SYNCOPE : BOOLEAN := FALSE;
            procedure WORDS_NO_SYNCOPE (W : STRING;
                                        PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER) is
            begin
               if WORDS_MDEV(DO_SYNCOPE)  then
                  REMEMBER_SYNCOPE := TRUE;
                  WORDS_MDEV(DO_SYNCOPE) := FALSE;
               end if;
               WORD_PACKAGE.WORD(W, PA, PA_LAST);
               if REMEMBER_SYNCOPE  then
                  WORDS_MDEV(DO_SYNCOPE) := TRUE;
               end if;         
            end WORDS_NO_SYNCOPE;
         
         
            function COMMON_PREFIX(S : STRING) return BOOLEAN is
            --  Common prefixes that have corresponding words (prepositions usually) 
            --  which could confuse TWO_WORDS.  We wish to reject these.
            begin
               if S = "dis"  or
               S = "ex"   or
               S = "in"   or
               S = "per"  or
               S = "prae" or
               S = "pro"  or
               S = "re"   or
               S = "si"  or
               S = "sub"  or
               S = "super" or
               S = "trans"    then
                  return TRUE;
               else
                  return FALSE;
               end if;
            end COMMON_PREFIX;
         
         begin
         --TEXT_IO.PUT_LINE("Entering TWO_WORDS  PA_LAST = " & INTEGER'IMAGE(PA_LAST));
         --if S(S'FIRST) /= 'q'  then    --  qu words more complicated
            
               
            if S'LENGTH  < 5  then    --  Dont try on too short words
               return;
            end if;
         
            I := 2;    --  Smallest is re-publica, but that killed by PREFIX, meipsum
         OUTER_LOOP:
            while I < S'LENGTH - 2  loop
            
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST):= (HEAD("Two words", MAX_STEM_SIZE),
                                NULL_INFLECTION_RECORD,
                                XXX, NULL_MNPC);
            --TEXT_IO.PUT_LINE("Setting PA TWO_WORDS  PA_LAST = " & INTEGER'IMAGE(PA_LAST));
            
               while I < S'LENGTH - 2  loop
    --TEXT_IO.PUT_LINE("Trying  " & S(S'FIRST..S'FIRST+I-1));
                  if not COMMON_PREFIX(S(S'FIRST..S'FIRST+I-1))  then 
                     WORDS_NO_SYNCOPE(S(S'FIRST..S'FIRST+I-1), PA, PA_LAST);
                     if (PA_LAST > PA_SAVE + 1)     then 
                        I_MID := I;
                        for J in PA_SAVE+1..PA_LAST  loop
                           if PA(J).IR.QUAL.POFS = NUM  then
                              NUM_HIT_ONE := TRUE;
                              exit;
                           end if;
                        end loop;
                     
                     --TEXT_IO.PUT_LINE("HIT first  " & S(S'FIRST..I_MID-1) & "  PA_LAST = " & INTEGER'IMAGE(PA_LAST));
                     --PARSE_RECORD_IO.PUT(PA(PA_LAST)); TEXT_IO.NEW_LINE;
                     
                        exit;
                     end if; 
                  end if; 
                  I := I + 1;
               end loop;  
            
               if (PA_LAST > PA_SAVE + 1)     then  
                  null;
               --TEXT_IO.PUT_LINE("Confirm first  " & S(S'FIRST..I_MID) & "    PA_LAST =" & INTEGER'IMAGE(PA_LAST));
               else
               --TEXT_IO.PUT_LINE("No possible first  " & S(S'FIRST..I_MID));
                  PA_LAST := PA_SAVE;  
                  return;
               end if;
            
            --  Now for second word
            --TEXT_IO.PUT_LINE("Looking for second  >" & S(I_MID+1..S'LAST));
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := NULL_PARSE_RECORD;     --  Separator
               PA_SECOND := PA_LAST;
               WORDS_NO_SYNCOPE(S(I_MID+1..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SECOND)   and then       --  No + 1 since XXX taken care of above
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                  for J in PA_SECOND..PA_LAST  loop
                     if PA(J).IR.QUAL.POFS = NUM  then
                        NUM_HIT_TWO := TRUE;
                        exit;
                     end if;
                  end loop;
               
               --TEXT_IO.PUT_LINE("Found       second  " & S(I_MID+1..S'LAST) & "  PA_LAST = " & INTEGER'IMAGE(PA_LAST));
               
                  if EXPLANATION = ""  then
                  
                     if WORDS_MODE(TRIM_OUTPUT)  and then
                     --  Should check that cases correspond
                        (NUM_HIT_ONE and NUM_HIT_TWO)  then
                     --  Clear out any non-NUM if we are in TRIM
                        for J in PA_SAVE+1..PA_LAST  loop
                           if PA(J).D_K in GENERAL..UNIQUE  and then 
                           PA(J).IR.QUAL.POFS /= NUM  then
                              PA(J..PA_LAST-1) := PA(J+1..PA_LAST);
                              PA_LAST := PA_LAST - 1;
                           end if;
                        end loop;
                     
                     
                        XXX_MEANING := HEAD(
                                           "It is very likely a compound number    " &
                                           S(S'FIRST..S'FIRST+I-1) & " + " & 
                                           S(S'FIRST+I..S'LAST), MAX_MEANING_SIZE);
                        PUT_STAT("TRICK   2NUM at "
                                 & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                                 & "   " & HEAD(W, 20) & "   "  & S(1..I_MID) & '+' & S(I_MID+1..S'LAST));
                     else                
                        XXX_MEANING := HEAD(
                                           "May be 2 words combined (" &
                                           S(S'FIRST..S'FIRST+I-1) & "+" & 
                                           S(S'FIRST+I..S'LAST) & 
                                           ") If not obvious, probably incorrect", MAX_MEANING_SIZE);
                        PUT_STAT("TRICK   2WDS at "
                                 & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                                 & "   " & HEAD(W, 20) & "   "  & S(1..I_MID) & '+' & S(I_MID+1..S'LAST));
                     end if;
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;  
               
               --TEXT_IO.PUT_LINE("Returing from 2WDS  PA_SAVE+1 = " & INTEGER'IMAGE(PA_SAVE+1) & "  " & PA(PA_SAVE+1).STEM);           
               
               
                  return;
               else
                  PA_LAST := PA_SAVE; 
               end if;
            
               I := I + 1;
            end loop OUTER_LOOP;   
         
            PA_LAST := PA_SAVE;   --  No success, so reset to clear the TRICK PA 
         
          
            
         
         --  I could try to check cases/gender/number for matches
         --  Discard all that do not have a match
         --  ADJ, N, NUM
         --  But that is probably being too pedantic for a case which may be sloppy
         end TWO_WORDS;
      
      
      --------------------------------------------------------------------------
      --------------------------------------------------------------------------
      --------------------------------------------------------------------------
      --------------------------------------------------------------------------
      
      begin
      --  These things might be genericized, at least the PA(1) assignments 
--TEXT_IO.PUT_LINE("TRICKS called");

     XXX_MEANING := NULL_MEANING_TYPE;
      
      
      
      
      --  If there is no satisfaction from above, we will try further
      
       case S(S'FIRST) is      
      
         when 'a'  =>
         
         
         --FLIP_FLOP("abs", "aps");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("acq", "adq");   if PA_LAST > 0  then return; end if;
            FLIP_FLOP("adgn", "agn");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("adsc", "asc");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("adsp", "asp");   
            if PA_LAST > 0  then 
               return; end if;
         --FLIP_FLOP("ante",  "anti");   if PA_LAST > 0  then return; end if;
            FLIP_FLOP("arqui",  "arci");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("arqu",  "arcu");   
            if PA_LAST > 0  then 
               return; end if;
         --FLIP_FLOP("auri",  "aure");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("auri",  "auru");   if PA_LAST > 0  then return; end if;
         --SLUR("ad");           if PA_LAST > 0  then return; end if;
            FLIP("ae",  "e");     
            if PA_LAST > 0  then 
               return; end if;
            FLIP("al",  "hal");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("am",  "ham");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("ar",  "har");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("aur",  "or");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         
         
         --  when 'c'  =>
         
         --FLIP("circum" , "circun");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("con", "com");   if PA_LAST > 0  then return; end if;
         --FLIP("co" , "com");   if PA_LAST > 0  then return; end if;
         --FLIP("co" , "con");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("conl" , "coll");   if PA_LAST > 0  then return; end if;
         
         
         when 'd'  =>
         
           FLIP("dampn" , "damn");   
           if PA_LAST > 0  then 
             return; end if;
           FLIP_FLOP("dij"  , "disj");       --  OLD p.543
           if PA_LAST > 0  then 
             return; end if;    
           FLIP_FLOP("dir"  , "disr");       --  OLD p.556
           if PA_LAST > 0  then 
             return; end if;    
           FLIP_FLOP("dir"  , "der");        --  OLD p.547
           if PA_LAST > 0  then 
             return; end if;    
           FLIP_FLOP("del"  , "dil");        --  OLD p.507/543
           if PA_LAST > 0  then 
             return; end if;    
               
               
         when 'e'  =>
         
            FLIP_FLOP("ecf" , "eff");  
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("ecs" , "exs");  
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("es"  , "ess");  
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("ex"  , "exs");  
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP("eid",  "id");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("el",  "hel");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("e",  "ae");   
            if PA_LAST > 0  then 
               return; end if;
         
         when 'f'  =>
         
            FLIP_FLOP("faen" , "fen");  
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP_FLOP("faen" , "foen");  
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP_FLOP("fed" , "foed");  
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP_FLOP("fet" , "foet");  
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP("f",  "ph");   
            if PA_LAST > 0  then 
               return; end if;  -- Try lead then all
         
         when 'g'  =>
         
            FLIP("gna",  "na");   
            if PA_LAST > 0  then 
               return; end if;
         
         when 'h'  =>
         
            FLIP("har",  "ar");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("hal",  "al");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("ham",  "am");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("hel",  "el");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("hol",  "ol");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("hum",  "um");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         when 'i'  =>
         
         
         --SLUR("in");            if PA_LAST > 1 then return; end if;
         
         --FLIP_FLOP("inb", "imb");    if PA_LAST > 1 then return; end if;
         --FLIP_FLOP("inp", "imp");    if PA_LAST > 1 then return; end if;
         
         
         
         -- for some forms of eo the stem "i" grates with an "is..." ending
            if S'LENGTH > 1 and then
            S(S'FIRST..S'FIRST+1) = "is"   then
               PA(1) := ("Word mod is => iis", NULL_INFLECTION_RECORD,
                           XXX, NULL_MNPC);
               PA_LAST := 1;
               TWORD("i" & S(S'FIRST..S'LAST), PA, PA_LAST);
            end if;
            if (PA_LAST > PA_SAVE + 1)   and then
               (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  and then
            PA(PA_LAST).IR.QUAL.POFS = V and then
            PA(PA_LAST).IR.QUAL.V.CON = (6, 1) then  --    Check it is V 6 1 eo
               XXX_MEANING := HEAD(
                                  "Some forms of eo stem 'i' grates with an 'is...' ending, so 'is' -> 'iis' "
                                  , MAX_MEANING_SIZE);
               return;
            else
               PA_LAST := 0;
            end if;
         
         
         
         
         
         
         when 'k'  =>
         
            FLIP("k",  "c");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("c",  "k");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         when 'l'  =>
         
         
            FLIP_FLOP("lub", "lib");    
            if PA_LAST > 1 then 
               return; end if;
         
         
         when 'm'  =>
         
         
            FLIP_FLOP("mani", "manu");    
            if PA_LAST > 1 then 
               return; end if;
         
         
         
         when 'n'  =>
         
         
            FLIP("na",  "gna");   
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP_FLOP("nihil",  "nil");   
            if PA_LAST > 0  then 
               return; end if;
         
         --FLIP("nun",  "non");   if PA_LAST > 0  then return; end if;
         
         
         
         when 'o'  =>
         
         --SLUR("ob");           if PA_LAST > 0  then return; end if;
            FLIP_FLOP("obt", "opt");    
            if PA_LAST > 1 then 
               return; end if;
            FLIP_FLOP("obs", "ops");    
            if PA_LAST > 1 then 
               return; end if;
            FLIP("ol",  "hol");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("opp", "op");    
            if PA_LAST > 1 then 
               return; end if;
            FLIP("or",  "aur");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         
         when 'p'  =>
         
         
            FLIP("ph",  "f");   
            if PA_LAST > 0  then 
               return; end if;  -- Try lead then all
            FLIP_FLOP("pre", "prae");    
            if PA_LAST > 1 then 
               return; end if;
         
         
         --  when 'q'  =>
         
         
         --FLIP_FLOP("quadri",  "quadru");   if PA_LAST > 0  then return; end if;
         
         
         when 's'  =>
              
               
         --  From Oxford Latin Dictionary p.1835 "sub-"
         
         --SLUR("sub");
         
            FLIP_FLOP("subsc",  "susc");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("subsp",  "susp");   
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP_FLOP("subc",  "susc");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("succ",  "susc");   
            if PA_LAST > 0  then 
               return; end if;
         
            FLIP_FLOP("subt",  "supt");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("subt",  "sust");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         when 't'  =>
         
         
            FLIP_FLOP("transv",  "trav");   
            if PA_LAST > 0  then 
               return; end if;
--            FLIP("trig",  "tric");   
--            if PA_LAST > 0  then 
--               return; end if;
         
         
         
         
         when 'u'  =>
         
            FLIP("ul",  "hul");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("uol",  "vul");   
            if PA_LAST > 0  then 
               return; end if;  --  u is not v for this purpose
         
         
         
         when 'y'  =>
         
            FLIP("y",  "i");   
            if PA_LAST > 0  then 
               return; end if;
         
         when 'z'  =>
         
            FLIP("z",  "di");   
            if PA_LAST > 0  then 
               return; end if;
         
         when others  =>  null;
         
       end case;   --  case on first letter
      
      
      
         INTERNAL("ae",  "e");   
         if PA_LAST > 0  then 
            return; end if;
      
         INTERNAL("bul",  "bol");   
         if PA_LAST > 0  then 
            return; end if;
         INTERNAL("bol",  "bul");   
         if PA_LAST > 0  then 
            return; end if;
      
         INTERNAL("cl",  "cul");   
         if PA_LAST > 0  then 
            return; end if;
      
         INTERNAL("cu",  "quu");   
         if PA_LAST > 0  then 
            return; end if;
      
         INTERNAL("f",  "ph");   
         if PA_LAST > 0  then 
            return; end if;
         INTERNAL("ph",  "f");   
         if PA_LAST > 0  then 
            return; end if;
      
         INTERNAL("h",  "");   
         if PA_LAST > 0  then 
            return; end if;
      
      
         INTERNAL("oe",  "e");   
         if PA_LAST > 0  then 
            return; end if;
      
         INTERNAL("vul",  "vol");   
         if PA_LAST > 0  then 
            return; end if;
         INTERNAL("vol",  "vul");   
         if PA_LAST > 0  then 
            return; end if;
         INTERNAL("uol",  "vul");   
         if PA_LAST > 0  then 
            return; end if;
      
      
         ADJ_TERMINAL_IIS;   
         if PA_LAST > 0  then 
            return; end if;
      
      
      
      ---------------------------------------------------------------
      
      
         if WORDS_MDEV(DO_MEDIEVAL_TRICKS)  then
         --      Medieval  ->  Classic
         
         --  Harrington/Elliott    1.1.1
         
            INTERNAL("col",  "caul");   
            if PA_LAST > 0  then 
               return; end if;
         
         --TEXT_IO.PUT_LINE("Trying com -> con");
         --INTERNAL("com",  "con");   if PA_LAST > 0  then return; end if;   --  My own
         
         --INTERNAL("cl",  "cul");   if PA_LAST > 0  then return; end if;
         
         
         --  Harrington/Elliott    1.3   
         
            INTERNAL("e",  "ae");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("o",  "u");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("i",  "y");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         --  Harrington/Elliott    1.3.1
         
            INTERNAL("ism",  "sm");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("isp",  "sp");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("ist",  "st");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("iz",  "z");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("esm",  "sm");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("esp",  "sp");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("est",  "st");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("ez",  "z");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         --  Harrington/Elliott    1.4  
         
            INTERNAL("di",  "z");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("f",  "ph");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("is",  "ix");   
            if PA_LAST > 0  then 
               return; end if;
         
         
            INTERNAL("b",  "p");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("d",  "t");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("v",  "b");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("v",  "f");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("v",  "f");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("s",  "x");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         
         --  Harrington/Elliott    1.4.1
         
            INTERNAL("ci",  "ti");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         --  Harrington/Elliott    1.4.2
         
            INTERNAL("nt",  "nct");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("s",  "ns");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         --  Others
         
            INTERNAL("ch",  "c");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("c",  "ch");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("th",  "t");   
            if PA_LAST > 0  then 
               return; end if;
         
            INTERNAL("t",  "th");   
            if PA_LAST > 0  then 
               return; end if;
         
            
         
         
            DOUBLE_CONSONANTS;
         
         
         end if;   --  Medieval Tricks
      ---------------------------------------------------------------
      
         if not (WORDS_MODE(IGNORE_UNKNOWN_NAMES)  and CAPITALIZED)  then   --  Don't try on Names
           if WORDS_MDEV(DO_TWO_WORDS)  then
             TWO_WORDS;
           end if;
         end if;
      
      
      
      --  It could be an improperly formed Roman Numeral
         if ONLY_ROMAN_DIGITS(W)  then
         
         
            PA_LAST := 1;
            PA(1) := ("Bad Roman Numeral?", NULL_INFLECTION_RECORD,
                        XXX, NULL_MNPC);
                XXX_MEANING := NULL_MEANING_TYPE;
                
                RRR_MEANING := HEAD(INTEGER'IMAGE(BAD_ROMAN_NUMBER(W)) & "  as ill-formed ROMAN NUMERAL?;", 
                                MAX_MEANING_SIZE); 
                    PA_LAST := PA_LAST + 1;
            PA(PA_LAST) := ( STEM => HEAD(W, MAX_STEM_SIZE),
                              IR => (
                                    QUAL => (
                                            POFS => NUM,
                                            NUM => (
                                                   DECL   => (2, 0),
                                                   CS     => X,
                                                   NUMBER => X,
                                                   GENDER => X,
                                                   SORT   => CARD) ),
                                    
                                    KEY => 0,
                                    ENDING => NULL_ENDING_RECORD,
                                    AGE => X,
                                    FREQ => D),
                              D_K => RRR,
                              MNPC => NULL_MNPC         );
         
            return;
         end if;
      
      
      
      
         exception
            when others  =>    --  I want to ignore anything that happens in TRICKS
               PA_LAST := PA_SAVE;
               PA(PA_LAST+1) := NULL_PARSE_RECORD;     --  Just to clear the trys
            
               TEXT_IO.PUT_LINE(    --  ERROR_FILE,
                               "Exception in TRY_TRICKS processing " & W);
      end TRY_TRICKS;
   

      
      
      
      
      
      
      
         
      procedure TRY_SLURY(W : STRING;
                          PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER;
                          LINE_NUMBER : INTEGER; WORD_NUMBER : INTEGER) is
      --  Since the chances are 1/1000 that we have one,
      --  Ignore the possibility of two in the same word
      --  That is called lying with statistics                
         use INFLECTIONS_PACKAGE.INTEGER_IO;
         S  : constant STRING(1..W'LENGTH) := W;
         PA_SAVE : INTEGER := PA_LAST;
      
      
         procedure TWORD(W : STRING;
                         PA : in out PARSE_ARRAY; PA_LAST : in out INTEGER) is
            SAVE_USE_PREFIXES : BOOLEAN := WORDS_MDEV(USE_PREFIXES);
         begin
            WORDS_MDEV(USE_PREFIXES) := FALSE;
            WORD_PACKAGE.WORD(W, PA, PA_LAST);
            SYNCOPE(W, PA, PA_LAST);
            WORDS_MDEV(USE_PREFIXES) := SAVE_USE_PREFIXES;
         end TWORD;
      
      
      
         procedure FLIP(X1, X2 : STRING; EXPLANATION : STRING := "") is
         --  At the begining of input word, replaces X1 by X2
            PA_SAVE : INTEGER := PA_LAST;
         begin
            if S'LENGTH >= X1'LENGTH+2  and then
            S(S'FIRST..S'FIRST+X1'LENGTH-1) = X1   then
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := (HEAD("Word mod " & X1 & "/" & X2, MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
               TWORD(X2 & S(S'FIRST+X1'LENGTH..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)   and then
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD(
                                        "An initial '" & X1 & "' may be rendered by '" & X2 & "'"
                                        , MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("SLURY   FLIP at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            end if;
            PA_LAST := PA_SAVE;
         end FLIP;
      
      
      
         procedure FLIP_FLOP(X1, X2 : STRING; EXPLANATION : STRING := "") is
         --  At the begining of input word, replaces X1 by X2 - then X2 by X1
         --  To be uesd only when X1 and X2 start with the same letter because it 
         --  will be called from a point where the first letter is established
            PA_SAVE : INTEGER := PA_LAST;
         begin
            if S'LENGTH >= X1'LENGTH+2  and then
            S(S'FIRST..S'FIRST+X1'LENGTH-1) = X1   then
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := (HEAD("Word mod " & X1 & "/" & X2, MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
               TWORD(X2 & S(S'FIRST+X1'LENGTH..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)   and then
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD(
                                        "An initial '" & X1 & "' may be rendered by '" & X2 & "'"
                                        , MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("SLURY   FLOP at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            
            elsif S'LENGTH >= X2'LENGTH+2  and then
            S(S'FIRST..S'FIRST+X2'LENGTH-1) = X2   then
               PA_LAST := PA_LAST + 1;
               PA(PA_LAST) := (HEAD("Word mod " & X2 & "/" & X1, MAX_STEM_SIZE),
                                 NULL_INFLECTION_RECORD,
                                 XXX, NULL_MNPC);
               TWORD(X1 & S(S'FIRST+X2'LENGTH..S'LAST), PA, PA_LAST);
               if (PA_LAST > PA_SAVE + 1)   and then
                  (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                  if EXPLANATION = ""  then
                     XXX_MEANING := HEAD(
                                        "An initial '" & X1 & "' may be rendered by '" & X2 & "'"
                                        , MAX_MEANING_SIZE);
                  else
                     XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                  end if;
                  PUT_STAT("SLURY   FLOP at "
                           & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                           & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                  return;
               else
                  PA_LAST := PA_SAVE;
               end if;
            
            end if;
            PA_LAST := PA_SAVE;
         end FLIP_FLOP;
      
      
      
      
      
         procedure SLUR(X1 : STRING; EXPLANATION : STRING := "") is
            PA_SAVE : INTEGER := PA_LAST;
            SL : INTEGER := X1'LENGTH;
         begin
            if S'LENGTH >= X1'LENGTH+2  then
               if S(S'FIRST..S'FIRST+X1'LENGTH-1) = X1   and then   --  Initial  X1
               not IS_A_VOWEL(S(S'FIRST+SL))           then   
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST)           := (HEAD("Slur " & X1 & "/" & X1(1..SL-1) & "~", MAX_STEM_SIZE),
                                            NULL_INFLECTION_RECORD,
                                            XXX, NULL_MNPC);
                  TWORD(X1(1..SL-1) & S(S'FIRST+SL) & S(S'FIRST+SL..S'LAST), PA, PA_LAST);
                  if (PA_LAST > PA_SAVE + 1)   and then
                     (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                     if EXPLANATION = ""  then
                        XXX_MEANING := HEAD(
                               "An initial '" & X1 & "' may be rendered by " & X1(1..X1'LAST-1) & "~",
                                            MAX_MEANING_SIZE);
                     else
                        XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                     end if;
                     PUT_STAT("SLURY   SLUR at "
                              & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                              & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                     return;
                  else
                     PA_LAST := PA_SAVE;
                  end if;
               
               elsif (S(S'FIRST..S'FIRST+SL-1) = X1(1..SL-1))  and then
                  (S(S'FIRST+SL-1) = S(S'FIRST+SL))   and then   --  double letter
               not IS_A_VOWEL(S(S'FIRST+SL))           then    
                  PA_LAST := PA_LAST + 1;
                  PA(PA_LAST) := (HEAD("Slur " & X1(1..SL-1) & "~" & "/" & X1, MAX_STEM_SIZE),
                                    NULL_INFLECTION_RECORD,
                                    XXX, NULL_MNPC);
                  TWORD(X1 & S(S'FIRST+SL..S'LAST), PA, PA_LAST);
                  if (PA_LAST > PA_SAVE + 1)   and then
                     (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  then
                     if EXPLANATION = ""  then
                        XXX_MEANING := HEAD(
                                           "An initial '" & X1(1..SL-1) & "~" & "' may be rendered by " & X1
                                           , MAX_MEANING_SIZE);
                     else
                        XXX_MEANING := HEAD(EXPLANATION, MAX_MEANING_SIZE);
                     end if;
                     PUT_STAT("SLURY   SLUR at "
                              & HEAD(INTEGER'IMAGE(LINE_NUMBER), 8) & HEAD(INTEGER'IMAGE(WORD_NUMBER), 4)
                              & "   " & HEAD(W, 20) & "   "  & PA(PA_SAVE+1).STEM);
                     return;
                  else
                     PA_LAST := PA_SAVE;
                  end if;
               
               end if;
            end if;
            PA_LAST := PA_SAVE;
         end SLUR;
      
      begin
      
      --XXX_MEANING := NULL_MEANING_TYPE;
      
      
      --  If there is no satisfaction from above, we will try further
      
         if S(S'FIRST) = 'a'  then
         
         
            FLIP_FLOP("abs", "aps");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("acq", "adq");   
            if PA_LAST > 0  then 
               return; end if;
         --FLIP_FLOP("adgn", "agn");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("adsc", "asc");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("adsp", "asp");   if PA_LAST > 0  then return; end if;
            FLIP_FLOP("ante",  "anti");   
            if PA_LAST > 0  then 
               return; end if;
         --FLIP_FLOP("arqui",  "arci");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("arqu",  "arcu");   if PA_LAST > 0  then return; end if;
            FLIP_FLOP("auri",  "aure");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("auri",  "auru");   
            if PA_LAST > 0  then 
               return; end if;
            SLUR("ad");           
            if PA_LAST > 0  then 
               return; end if;
         --FLIP("ae",  "e");     if PA_LAST > 0  then return; end if;
         --FLIP("al",  "hal");   if PA_LAST > 0  then return; end if;
         --FLIP("am",  "ham");   if PA_LAST > 0  then return; end if;
         --FLIP("ar",  "har");   if PA_LAST > 0  then return; end if;
         --FLIP("aur",  "or");   if PA_LAST > 0  then return; end if;
         
         
         
         
         elsif S(S'FIRST) = 'c'  then
         
            FLIP("circum" , "circun");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("con", "com");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("co" , "com");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP("co" , "con");   
            if PA_LAST > 0  then 
               return; end if;
            FLIP_FLOP("conl" , "coll");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         --elsif S(S'FIRST) = 'e'  then
         
         --FLIP_FLOP("ecf" , "eff");  if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("ecs" , "exs");  if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("es"  , "ess");  if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("ex"  , "exs");  if PA_LAST > 0  then return; end if;
         
         --FLIP("el",  "hel");   if PA_LAST > 0  then return; end if;
         --FLIP("e",  "ae");   if PA_LAST > 0  then return; end if;
         
         --elsif S(S'FIRST) = 'f'  then
         
         --FLIP_FLOP("faen" , "foen");  if PA_LAST > 0  then return; end if;
         
         --FLIP("f",  "ph");   if PA_LAST > 0  then return; end if;  -- Try lead then all
         
         --elsif S(S'FIRST) = 'g'  then
         
         --FLIP("gna",  "na");   if PA_LAST > 0  then return; end if;
         
         --elsif S(S'FIRST) = 'h'  then
         
         --FLIP("har",  "ar");   if PA_LAST > 0  then return; end if;
         --FLIP("hal",  "al");   if PA_LAST > 0  then return; end if;
         --FLIP("ham",  "am");   if PA_LAST > 0  then return; end if;
         --FLIP("hel",  "el");   if PA_LAST > 0  then return; end if;
         --FLIP("hol",  "ol");   if PA_LAST > 0  then return; end if;
         --FLIP("hum",  "um");   if PA_LAST > 0  then return; end if;
         
         
         elsif S(S'FIRST) = 'i'  then
         
         
            SLUR("in");            
            if PA_LAST > 1 then 
               return; end if;
         
            FLIP_FLOP("inb", "imb");    
            if PA_LAST > 1 then 
               return; end if;
            FLIP_FLOP("inp", "imp");    
            if PA_LAST > 1 then 
               return; end if;
         
         
         
         --    -- for some forms of eo the stem "i" grates with an "is..." ending
         --    if S'LENGTH > 1 and then
         --       S(S'FIRST..S'FIRST+1) = "is"   then
         --      PA(1) := ("Word mod is => iis", NULL_INFLECTION_RECORD,
         --                XXX, NULL_MNPC);
         --      PA_LAST := 1;
         --      TWORD("i" & S(S'FIRST..S'LAST), PA, PA_LAST);
         --    end if;
         --    if (PA_LAST > PA_SAVE + 1)   and then
         --       (PA(PA_LAST-1).IR.QUAL.POFS /= TACKON)  and then
         --        PA(PA_LAST).IR.QUAL.POFS = V and then
         --        PA(PA_LAST).IR.QUAL.V.CON = (6, 1) then  --    Check it is V 6 1 eo
         --      XXX_MEANING := HEAD(
         --"Some forms of eo stem 'i' grates with an 'is...' ending, so 'is' -> 'iis' "
         --                             , MAX_MEANING_SIZE);
         --      return;
         --    else
         --      PA_LAST := 0;
         --    end if;
         
         
         
         
         
         
         --elsif S(S'FIRST) = 'k'  then
         
         --FLIP("k",  "c");   if PA_LAST > 0  then return; end if;
         --FLIP("c",  "k");   if PA_LAST > 0  then return; end if;
         
         
         --elsif S(S'FIRST) = 'l'  then
         
         
         --FLIP_FLOP("lub", "lib");    if PA_LAST > 1 then return; end if;
         
         
         --elsif S(S'FIRST) = 'm'  then
         
         
         --FLIP_FLOP("mani", "manu");    if PA_LAST > 1 then return; end if;
         
         
         
         elsif S(S'FIRST) = 'n'  then
         
         
         --FLIP("na",  "gna");   if PA_LAST > 0  then return; end if;
         
         --FLIP_FLOP("nihil",  "nil");   if PA_LAST > 0  then return; end if;
         
            FLIP("nun",  "non");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         
         elsif S(S'FIRST) = 'o'  then
         
            SLUR("ob");           
            if PA_LAST > 0  then 
               return; end if;
         --FLIP_FLOP("obt", "opt");    if PA_LAST > 1 then return; end if;
         --FLIP_FLOP("obs", "ops");    if PA_LAST > 1 then return; end if;
         --FLIP("ol",  "hol");   if PA_LAST > 0  then return; end if;
         --FLIP("opp", "op");    if PA_LAST > 1 then return; end if;
         --FLIP("or",  "aur");   if PA_LAST > 0  then return; end if;
         
         
         
         --elsif S(S'FIRST) = 'p'  then
         
         
         --FLIP("ph",  "f");   if PA_LAST > 0  then return; end if;  -- Try lead then all
         --FLIP_FLOP("pre", "prae");    if PA_LAST > 1 then return; end if;
         
         
         elsif S(S'FIRST) = 'q'  then
         
         
            FLIP_FLOP("quadri",  "quadru");   
            if PA_LAST > 0  then 
               return; end if;
         
         
         elsif S(S'FIRST) = 's'  then
              
            FLIP("se",  "ce");     --  Latham
            if PA_LAST > 0  then 
               return; end if; 
              
        --  From Oxford Latin Dictionary p.1835 "sub-"
         
            SLUR("sub");
         
         --FLIP_FLOP("subsc",  "susc");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("subsp",  "susp");   if PA_LAST > 0  then return; end if;
         
         --FLIP_FLOP("subc",  "susc");   if PA_LAST > 0  then return; end if;
         --FLIP_FLOP("succ",  "susc");   if PA_LAST > 0  then return; end if;
         
         --FLIP_FLOP("subt",  "sust");   if PA_LAST > 0  then return; end if;
         
         
         --elsif S(S'FIRST) = 't'  then
         
         
         --FLIP_FLOP("transv",  "trav");   if PA_LAST > 0  then return; end if;
         
         
         
         
         --elsif S(S'FIRST) = 'u'  then
         
         --FLIP("ul",  "hul");   if PA_LAST > 0  then return; end if;
         --FLIP("uol",  "vul");   if PA_LAST > 0  then return; end if;  --  u is not v for this purpose
         
         
         
         --elsif S(S'FIRST) = 'y'  then
         
         --FLIP("y",  "i");   if PA_LAST > 0  then return; end if;
         
         
         end if;   --  if on first letter
      
      
      --  All INTERNAL out
      --INTERNAL("ae",  "e");   if PA_LAST > 0  then return; end if;
      --
      --
      --INTERNAL("cl",  "cul");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("cu",  "quu");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("f",  "ph");   if PA_LAST > 0  then return; end if;
      --INTERNAL("ph",  "f");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("h",  "");   if PA_LAST > 0  then return; end if;
      --
      --
      --INTERNAL("vul",  "vol");   if PA_LAST > 0  then return; end if;
      --INTERNAL("vol",  "vul");   if PA_LAST > 0  then return; end if;
      --INTERNAL("uol",  "vul");   if PA_LAST > 0  then return; end if;
      --
      --
      --ADJ_TERMINAL_IIS;   if PA_LAST > 0  then return; end if;
      
      
      
      ---------------------------------------------------------------
      
      
      --if WORDS_MDEV(DO_MEDIEVAL_TRICKS)  then
      ----      Medieval  ->  Classic
      --
      ----  Harrington/Elliott    1.1.1
      --
      --INTERNAL("col",  "caul");   if PA_LAST > 0  then return; end if;
      --
      ----TEXT_IO.PUT_LINE("Trying com -> con");
      ----INTERNAL("com",  "con");   if PA_LAST > 0  then return; end if;   --  My own
      --
      ----INTERNAL("cl",  "cul");   if PA_LAST > 0  then return; end if;
      --
      --
      ----  Harrington/Elliott    1.3   
      --
      --INTERNAL("e",  "ae");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("o",  "u");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("i",  "y");   if PA_LAST > 0  then return; end if;
      --
      --
      ----  Harrington/Elliott    1.3.1
      --
      --INTERNAL("ism",  "sm");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("isp",  "sp");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("ist",  "st");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("iz",  "z");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("esm",  "sm");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("esp",  "sp");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("est",  "st");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("ez",  "z");   if PA_LAST > 0  then return; end if;
      --
      --
      ----  Harrington/Elliott    1.4  
      --
      --INTERNAL("di",  "z");   if PA_LAST > 0  then return; end if;
      --
      ----INTERNAL("f",  "ph");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("is",  "ix");   if PA_LAST > 0  then return; end if;
      --
      --
      --INTERNAL("b",  "p");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("d",  "t");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("v",  "b");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("v",  "f");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("v",  "f");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("s",  "x");   if PA_LAST > 0  then return; end if;
      --
      --
      --
      ----  Harrington/Elliott    1.4.1
      --
      --INTERNAL("ci",  "ti");   if PA_LAST > 0  then return; end if;
      --
      --
      ----  Harrington/Elliott    1.4.2
      --
      --INTERNAL("nt",  "nct");   if PA_LAST > 0  then return; end if;
      --
      --INTERNAL("nt",  "nct");   if PA_LAST > 0  then return; end if;
      --
      --
      --DOUBLE_CONSONANTS;
      --
      --
      --end if;   --  Medieval Tricks
      ---------------------------------------------
      
         exception
            when others  =>    --  I want to ignore anything that happens in SLURY
               PA_LAST := PA_SAVE;
               PA(PA_LAST+1) := NULL_PARSE_RECORD;     --  Just to clear the trys
            
               TEXT_IO.PUT_LINE(    --  ERROR_FILE,
                               "Exception in TRY_SLURY processing " & W);
      end TRY_SLURY;
   
   
   end TRICKS_PACKAGE;
