PreviousUpNext

15.4.153  src/app/yacc/src/shrink.pkg

#  Mythryl-Yacc Parser Generator (c) 1991 Andrew W. Appel, David R. Tarditi 

# Compiled by:
#     src/app/yacc/src/mythryl-yacc.lib

###               "A room without books is like
###                a body without a soul."
###
###                        -- Marcus Tullius Cicero


 
api Sort_Arg {

     Entry;
     gt:  (Entry, Entry) -> Bool;
};

api Sort {

     Entry;
     sort:  List( Entry ) -> List( Entry );
};

api Equiv_Arg {

     Entry;
     gt:  (Entry, Entry) -> Bool;
     eq:  (Entry, Entry) -> Bool;
};

api Equiv {

     Entry;

    # equivalences: take a list of entries and divides them into
    # equivalence ilks numbered 0 to n-1.
    #
    # It returns a triple consisting of:
    #
    # * the number of equivalence ilks
    #   * a list which maps each original entry to an equivalence
    #     class.  The nth entry in this list gives the equivalence
    #     class for the nth entry in the original entry list.
    #   * a list which maps equivalence classes to some representative
    #     element.  The nth entry in this list is an element from the
    #     nth equivalence class


     equivalences:  List( Entry ) -> ((Int, List( Int ), List( Entry )) );
};

#  An O (n lg n) merge sort routine          # XXX BUGGO FIXME Generic sorts do not belong here.  We should use the library one here, or move this one to the library.

generic package merge_sort_g (a:  Sort_Arg)             # Sort_Arg      is from   src/app/yacc/src/shrink.pkg

: (weak) Sort                                           # Sort          is from   src/app/yacc/src/shrink.pkg

{
     Entry = a::Entry;

    # sort: an O (n lg n) merge sort routine.  We create a list of lists
    # and then merge these lists in passes until only one list is left.

    fun sort NIL => NIL;

        sort l
            =>
            {   #  merge: merge two lists 

                fun merge (l as a ! at, r as b ! bt)
                        =>
                        if (a::gt (a, b))
                             b ! merge (l, bt);
                        else a ! merge (at, r);fi;

                    merge (l, NIL) => l;
                    merge (NIL, r) => r;
                end;

                # scan: merge pairs of lists on a list of lists.
                # Reduces the number of lists by about 1/2

                fun scan (a ! b ! rest)
                        =>
                        merge (a, b) ! scan rest;

                   scan l
                       =>
                       l;
                end;

                # loop: calls scan on a list of lists until only
                # one list is left.  It terminates only if the list of
                # lists is nonempty.  (The pattern match for sort
                # ensures this.)

                fun loop (a ! NIL) =>   a;
                    loop l           =>   loop (scan l);
                end;

                loop (map (\\ a => [a]; end ) l);
            };
    end;
};

#  An O (n lg n) routine for placing items in equivalence ilks 

generic package equiv_g (a:  Equiv_Arg)         # Equiv_Arg     is from   src/app/yacc/src/shrink.pkg

: (weak) Equiv          # Equiv is from   src/app/yacc/src/shrink.pkg

{
    include package   rw_vector;
    include package   list;

    infix my 9 sub;

    # Our algorithm for finding equivalence ilk is simple.  The basic
    # idea is to sort the entries and place duplicates entries in the same
    #  equivalence class.
    #
    # Let the original entry list be E.  We map E to a list of a pairs
    # consisting of the entry and its position in E, where the positions
    # are numbered 0 to n-1.  Call this list of pairs EP.
    #
    # We then sort EP on the original entries.  The second elements in the
    # pairs now specify a permutation that will return us to EP.
    #
    # We then scan the sorted list to create a list R of representative
    # entries, a list P of integers which permutes the sorted list back to
    # the original list and a list SE of integers  which gives the
    # equivalence ilk for the nth entry in the sorted list .
    #
    # We then return the length of R, R, and the list that results from
    # permuting SE by P.

    Entry = a::Entry;

    fun gt ((a, _), (b, _))
        =
        a::gt (a, b);

    package sort
        =
        merge_sort_g (
             Entry = (a::Entry, Int);
            gt = gt;
        );

    fun assign_index l
        =
        loop (0, l)
        where  

            fun loop (index, NIL) => NIL;
                loop (index, h ! t) => (h, index) ! loop (index+1, t);
            end;
        end; 

    stipulate
        fun loop ((e, _) ! t, prev, ilk, rrr, se)
                =>
                if (a::eq (e, prev))
                     loop (t, e, ilk, rrr, ilk ! se);
                else loop (t, e, ilk+1, e ! rrr, (ilk + 1) ! se);           fi;

            loop (NIL, _, _, rrr, se)
                =>
                (reverse rrr, reverse se);
        end;
    herein
        create_equivalences
            =
            \\ NIL          =>   (NIL, NIL);
              (e, _) ! t =>   loop (t, e, 0, [e],[0]); end ;
    end;

    fun inverse_permute _ NIL
            =>
            NIL;

        inverse_permute permutation (l as h ! _)
            =>
            listofarray 0
            where 

                result = make_rw_vector (length l, h);

                fun loop (element ! r, dest ! s)
                        =>
                        {   set (result, dest, element);
                            loop (r, s);
                        };

                    loop _ => ();
                end;

                fun listofarray i
                    =
                    if   (i < rw_vector::length result)
                         
                         result[ i ] ! listofarray (i+1);
                    else
                         NIL;
                    fi;

                loop (l, permutation);
            end;
    end;

    fun make_permutation x
        =
        map  (\\ (_, b) => b; end )  x;

    fun equivalences l
        =
        {   ep     = assign_index l;
            sorted = sort::sort ep;
            p      = make_permutation sorted;

            my (r, se)
                =
                create_equivalences sorted;

            (length r, inverse_permute p se, r);
        };
};

generic package shrink_lr_table_g (package lr_table:  Lr_Table;)                # Lr_Table      is from   src/app/yacc/lib/base.api

: (weak)  Shrink_Lr_Table                                               # Shrink_Lr_Table       is from   src/app/yacc/src/shrink-lr-table.api

{
    package lr_table = lr_table;

    include package   lr_table;

    fun gt_action (a, b)
        =
        case a
          
             SHIFT (STATE s)
                 => 
                 case  b
                       SHIFT (STATE s')  =>  s > s';
                       _                 =>   TRUE;
                 esac;

             REDUCE i
                 =>
                 case b
                      SHIFT _   =>   FALSE;
                      REDUCE i' =>   i > i';
                      _         =>   TRUE;
                 esac;

             ACCEPT
                 =>
                 case b
                   
                      ERROR => TRUE;
                      _     => FALSE;
                 esac;

             ERROR =>  FALSE;
        esac;

    package action_entry_list
        =
        package {
             Entry = (Pairlist (Terminal, Action), Action);

            stipulate
                fun eqlist (EMPTY, EMPTY) => TRUE;
                    eqlist (PAIR (TERM t, d, r), PAIR (TERM t', d', r')) =>
                     t==t' and d==d' and eqlist (r, r');
                    eqlist _ => FALSE;
                end;

                fun gtlist (PAIR _, EMPTY) => TRUE;
                    gtlist (PAIR (TERM t, d, r), PAIR (TERM t', d', r')) =>
                     t>t' or (t==t' and
                                  (gt_action (d, d') or
                                   (d==d' and gtlist (r, r'))));
                    gtlist _ => FALSE;
                end;
            herein
                fun eq ((l, a): Entry, (l', a'): Entry)
                    =
                    a == a' and eqlist (l, l');

                fun gt ((l, a): Entry, (l', a'): Entry)
                    =
                    gt_action (a, a') or (a==a' and gtlist (l, l'));
            end;
        };

#    package goto_entry_list {
#            type entry = pairlist( nonterm, state ) 
#
#            my rec eq = 
#               \\ (EMPTY, EMPTY) => TRUE
#                | (PAIR (t, d, r), PAIR (t', d', r')) =>
#                       t=t' and d=d' and eq (r, r')
#                | _ => FALSE
#
#            my rec gt =
#               \\ (PAIR _, EMPTY) => TRUE
#                | (PAIR (NT t, STATE d, r), PAIR (NT t', STATE d', r')) =>
#                      t>t' or (t=t' and
#                      (d>d' or (d=d' and gt (r, r'))))
#                | _ => FALSE
#       }

    package equiv_action_list
        =
        equiv_g( action_entry_list );

    fun states max
        =
        f 0
        where 

            fun f i
                =
                if   (i < max)
                    
                     STATE i ! f (i+1);
                else
                     NIL;
                fi;
        end;

    fun length l
         =
         g (l, 0)
         where 

             fun g (EMPTY,         len) =>   len;
                 g (PAIR(_, _, r), len) =>   g (r, len+1);
             end;
         end;

    fun size l
        =
        {   c = REF 0;
            { apply (\\ (row, _) =  c := *c + length row) l; *c;};
        };

    fun shrink_action_list (table, verbose)
        =
        case (equiv_action_list::equivalences
                 (map (describe_actions table) (states (state_count table))))
          
             result as (_, _, l)
                 =>
                 (   result,

                     verbose   ??  size l
                               ::       0
                 );
        esac;
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext