15.4.913  src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-queue.pkg

## threadkit-queue.pkg
#
# See comments in    src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-queue.api

# Compiled by:
#     src/lib/std/standard.lib

stipulate
    package itt =  internal_threadkit_types;                                            # internal_threadkit_types      is from   src/lib/src/lib/thread-kit/src/core-thread-kit/internal-threadkit-types.pkg
herein

    package   threadkit_queue   
    : (weak)  Threadkit_Queue                                                           # Threadkit_Queue               is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit-queue.api
    {
        Threadkit_Queue == itt::Threadkit_Queue;

        fun reverse (x,       [], rl) =>  (x, rl);
            reverse (x, y ! rest, rl) =>  reverse (y, rest, x ! rl);
        end;

        fun reverse_and_prepend (      [], l) =>  l;
            reverse_and_prepend (x ! rest, l) =>  reverse_and_prepend (rest, x ! l);
        end;

        fun make_threadkit_queue ()
            =
            THREADKIT_QUEUE
              {
                front => REF [],
                rear  => REF []
              };

        fun same_queue ( THREADKIT_QUEUE { front=>f1, ... },
                         THREADKIT_QUEUE { front=>f2, ... }
                       )
            =
            f1 == f2;

        fun is_empty (THREADKIT_QUEUE { front => REF [], rear => REF [] } ) =>   TRUE;
            is_empty _                                                      =>   FALSE;
        end;


        fun enqueue (THREADKIT_QUEUE { rear, ... }, item)
            =
            rear :=  item  !  *rear;


        exception EMPTY_THREADKIT_QUEUE;


        fun dequeue (THREADKIT_QUEUE { front, rear } )
            =
            case *front
                #
                (x ! rest)
                    =>
                    {   front := rest;
                        x;
                    };

                [] =>   case *rear
                            #
                            (x ! rest)
                                =>
                                {   (reverse (x, rest, [])) ->   (y, rr);
                                    #   
                                    front := rr;
                                    rear  := [];
                                    y;
                                    #   
                                };

                            [] =>  raise exception  EMPTY_THREADKIT_QUEUE;
                        esac;

            esac;


        fun next (THREADKIT_QUEUE { front, rear } )
            =
            case *front
                #
                (x ! rest)
                    =>
                    {   front := rest;
                        #
                        THE x;
                    };

                []  =>  case *rear
                            #
                            (x ! rest)
                                =>
                                {   (reverse (x, rest, []))
                                        ->
                                        (y, rr);

                                    front := rr;
                                    rear  := [];
                                    # 
                                    THE y;
                                };

                            [] => NULL;
                        esac;
            esac;


        fun reset (THREADKIT_QUEUE { front, rear } )
            =
            {   front := [];
                rear  := [];
            };

        exception REMOVE;

        fun remove (THREADKIT_QUEUE { front, rear }, predicate)
            =
            get_f (*front, [])
            where
                fun get_f ([], l)
                        =>
                        get_r (*rear, []);

                    get_f (x ! rest, l)
                        =>
                        if (predicate x)        front := reverse_and_prepend (l, rest);
                        else                    get_f (rest, x ! l);
                        fi;
                end 

                also
                fun get_r ([], _) =>   raise exception REMOVE;                          # XXX SUCKO FIXME this should probably be a Null_Or return instead of an exception.
                    #
                    get_r (x ! rest, l)
                        =>
                        if (predicate x)        rear := reverse_and_prepend (l, rest);
                        else                    get_r (rest, x ! l);
                        fi;
                end;
            end;
    };
end;