## bounded-queue-via-paired-lists.pkg
#
# The Bounded_Queue api implemented via paired lists.
#
# For unbounded queues see:
#
# src/lib/src/queue-via-paired-lists.pkg#
# For mutable queues see:
#
# src/lib/src/rw-queue.pkg# Compiled by:
# src/lib/std/standard.libpackage bounded_queue_via_paired_lists
: (weak) Bounded_Queue # Bounded_Queue is from src/lib/src/bounded-queue.api{
Queue(X) = QUEUE { front: List(X), # No harm in publishing the structure -- it is not going to change.
back: List(X), #
length: Int, # Current combined lengths of front+back lists.
bound: Int
};
fun make_queue (bound: Int): Queue(X)
=
QUEUE { front => []: List(X), # No harm in publishing the structure -- it is not going to change.
back => []: List(X), #
length => 0: Int, # Current combined lengths of front+back lists.
bound
};
fun queue_is_empty (QUEUE { length => 0, ... } ) => TRUE;
queue_is_empty _ => FALSE;
end;
fun take_from_back_of_queue ( QUEUE { back=>(head ! tail), front, length, bound } ) => (QUEUE { back=>tail, front, bound, length => length - 1 }, THE head);
take_from_back_of_queue (q as QUEUE { front => [], ... } ) => (q, NULL);
take_from_back_of_queue ( QUEUE { front, length, bound, ... } ) => take_from_back_of_queue (QUEUE { back=>reverse front, front => [], length, bound } );
end;
# This is just the above with 'front' and 'back' swapped:
#
fun take_from_front_of_queue ( QUEUE { front=>(head ! tail), back, length, bound } ) => (QUEUE { front=>tail, back, bound, length => length - 1 }, THE head);
take_from_front_of_queue (q as QUEUE { back => [], ... } ) => (q, NULL);
take_from_front_of_queue ( QUEUE { back, length, bound, ... } ) => take_from_front_of_queue (QUEUE { front=>reverse back, back => [], length, bound } );
end;
# This is just the above without returning the removed value:
#
fun drop_from_front_of_queue ( QUEUE { front=>(head ! tail), back, length, bound } ) => (QUEUE { front=>tail, back, bound, length => length - 1 });
drop_from_front_of_queue (q as QUEUE { back => [], ... } ) => q;
drop_from_front_of_queue ( QUEUE { back, length, bound, ... } ) => drop_from_front_of_queue (QUEUE { front=>reverse back, back => [], length, bound } );
end;
fun enforce_bound (q as QUEUE { length, bound, ... })
=
if (length <= bound) q;
else enforce_bound (drop_from_front_of_queue q);
fi;
fun put_on_back_of_queue (QUEUE { front, back, length, bound }, x)
=
enforce_bound (
#
QUEUE { front,
back => x ! back,
length => length + 1,
bound
}
);
fun put_on_front_of_queue (QUEUE { front, back, length, bound }, x)
=
enforce_bound (
#
QUEUE { front => x ! front,
back,
length => length + 1,
bound
}
);
fun to_list (QUEUE { back, front, ... } )
=
(front @ (reverse back));
fun from_list (items, bound)
=
QUEUE { back => [],
front => items,
bound,
length => list::length items
};
# 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;
fun push' (QUEUE { front, back, length, bound }, items)
=
enforce_bound (
#
QUEUE { front,
back => list::reverse_and_prepend (items, back),
bound,
length => length + list::length items
}
);
fun unpull' (QUEUE { front, back, length, bound }, items)
=
enforce_bound (
#
QUEUE { back,
front => items @ front,
bound,
length => length + list::length items
}
);
fun length (QUEUE { length, ... })
=
length;
};
## COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.