## rw-queue.pkg
#
# See comments in src/lib/src/rw-queue.api# Compiled by:
# src/lib/std/standard.libstipulate
herein
package rw_queue
: (weak) Rw_Queue # Rw_Queue is from src/lib/src/rw-queue.api {
Rw_Queue(X) = RW_QUEUE { front: Ref( List(X) ), # Simple queue using the usual trick of adding to the input list,
back: Ref( List(X) ) # removing from the output list, and when the output list is empty,
}; # reversing the input list and making it the output list.
# A nice simple algorithm where both push and pull are O(1).
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_rw_queue ()
=
RW_QUEUE { front => REF [],
back => REF []
};
fun same_queue ( RW_QUEUE { front=> refcell1, ... },
RW_QUEUE { front=> refcell2, ... }
)
=
refcell1 == refcell2; # Taking advantage of the fact that refcells are equal only to themselves and thus uniquely identify a queue.
fun queue_is_empty (RW_QUEUE { front => REF [],
back => REF []
}
)
=> TRUE;
queue_is_empty _ => FALSE;
end;
fun put_on_back_of_queue (RW_QUEUE { back, ... }, item)
=
back := item ! *back;
fun put_on_front_of_queue (RW_QUEUE { front, ... }, item) # We occasionally use this when a thread needs to run immediately.
=
front := item ! *front;
fun take_from_front_of_queue_or_raise_exception (RW_QUEUE { front, back } )
=
case *front
#
(x ! rest)
=>
{ front := rest;
x;
};
[] => case *back
#
(x ! rest)
=>
{ (reverse (x, rest, [])) -> (y, rr);
#
front := rr;
back := [];
y;
#
};
[] => raise exception DIE "queue is empty";
esac;
esac;
fun take_from_front_of_queue (RW_QUEUE { front, back } ) # Normal case.
=
case *front
#
(x ! rest) => { front := rest;
#
THE x;
};
[] => case *back
#
(x ! rest) => { (reverse (x, rest, []))
->
(y, rr);
front := rr;
back := [];
#
THE y;
};
[] => NULL;
esac;
esac;
fun take_from_back_of_queue (RW_QUEUE { front, back } ) # Abnormal case included only for completeness -- currently unused. -- 2012-03-28 CrT
= # This is the exact reverse of the above fn.
case *back
#
(x ! rest) => { back := rest;
#
THE x;
};
[] => case *front
#
(x ! rest) => { (reverse (x, rest, []))
->
(y, rr);
back := rr;
front := [];
#
THE y;
};
[] => NULL;
esac;
esac;
fun clear_queue_to_empty (RW_QUEUE { front, back } )
=
{ front := [];
back := [];
};
fun to_list (RW_QUEUE { back, front } )
=
(*front @ (list::reverse *back));
# For debug and unit testing:
#
fun frontq (RW_QUEUE { front, ... }) = *front;
fun backq (RW_QUEUE { back, ... }) = *back;
fun find_first_matching_item_and_remove_from_queue
(
RW_QUEUE { front, back },
predicate
)
=
remove_from_front (*front, [])
where
fun remove_from_front ([], l)
=>
remove_from_back (*back, []);
remove_from_front (x ! rest, l)
=>
if (predicate x) { front := reverse_and_prepend (l, rest);
THE x;
};
else remove_from_front (rest, x ! l);
fi;
end
also
fun remove_from_back ([], _) => NULL;
#
remove_from_back (x ! rest, l)
=>
if (predicate x) { back := reverse_and_prepend (l, rest);
THE x;
};
else remove_from_back (rest, x ! l);
fi;
end;
end;
# Some synonyms:
#
push = put_on_back_of_queue;
pull = take_from_front_of_queue;
#
unpull = put_on_front_of_queue;
unpush = take_from_back_of_queue;
};
end;