[ Avaa Bypassed ]




Upload:

Command:

www-data@18.221.165.81: ~ $
;;;; q.scm --- Queues
;;;;
;;;; 	Copyright (C) 1995, 2001, 2004, 2006 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;

;;; Commentary:

;;; Q: Based on the interface to
;;;
;;; "queue.scm"  Queues/Stacks for Scheme
;;;  Written by Andrew Wilcox (awilcox@astro.psu.edu) on April 1, 1992.

;;; {Q}
;;;
;;; A list is just a bunch of cons pairs that follows some constrains,
;;; right?  Association lists are the same.  Hash tables are just
;;; vectors and association lists.  You can print them, read them,
;;; write them as constants, pun them off as other data structures
;;; etc. This is good.  This is lisp.  These structures are fast and
;;; compact and easy to manipulate arbitrarily because of their
;;; simple, regular structure and non-disjointedness (associations
;;; being lists and so forth).
;;;
;;; So I figured, queues should be the same -- just a "subtype" of cons-pair
;;; structures in general.
;;;
;;; A queue is a cons pair:
;;;		( <the-q> . <last-pair> )
;;;
;;; <the-q> is a list of things in the q.  New elements go at the end
;;; of that list.
;;;
;;; <last-pair> is #f if the q is empty, and otherwise is the last
;;; pair of <the-q>.
;;;
;;; q's print nicely, but alas, they do not read well because the
;;; eq?-ness of <last-pair> and (last-pair <the-q>) is lost by read.
;;;
;;; All the functions that aren't explicitly defined to return
;;; something else (a queue element; a boolean value) return the queue
;;; object itself.

;;; Code:

(define-module (ice-9 q)
  :export (sync-q! make-q q? q-empty? q-empty-check q-front q-rear
	   q-remove! q-push! enq! q-pop! deq! q-length))

;;; sync-q!
;;;   The procedure
;;;
;;;		(sync-q! q)
;;;
;;;   recomputes and resets the <last-pair> component of a queue.
;;;
(define (sync-q! q)
  (set-cdr! q (if (pair? (car q)) (last-pair (car q))
		  #f))
  q)

;;; make-q
;;;  return a new q.
;;;
(define (make-q) (cons '() #f))

;;; q? obj
;;;   Return true if obj is a Q.
;;;   An object is a queue if it is equal? to '(() . #f)
;;;   or it is a pair P with (list? (car P))
;;;                      and (eq? (cdr P) (last-pair (car P))).
;;;
(define (q? obj)
  (and (pair? obj)
       (if (pair? (car obj))
	   (eq? (cdr obj) (last-pair (car obj)))
	   (and (null? (car obj))
		(not (cdr obj))))))

;;; q-empty? obj
;;;
(define (q-empty? obj) (null? (car obj)))

;;; q-empty-check q
;;;  Throw a q-empty exception if Q is empty.
(define (q-empty-check q) (if (q-empty? q) (throw 'q-empty q)))

;;; q-front q
;;;  Return the first element of Q.
(define (q-front q) (q-empty-check q) (caar q))

;;; q-rear q
;;;  Return the last element of Q.
(define (q-rear q) (q-empty-check q) (cadr q))

;;; q-remove! q obj
;;;  Remove all occurences of obj from Q.
(define (q-remove! q obj)
  (set-car! q (delq! obj (car q)))
  (sync-q! q))

;;; q-push! q obj
;;;  Add obj to the front of Q
(define (q-push! q obj)
  (let ((h (cons obj (car q))))
    (set-car! q h)
    (or (cdr q) (set-cdr! q h)))
  q)

;;; enq! q obj
;;;  Add obj to the rear of Q
(define (enq! q obj)
  (let ((h (cons obj '())))
    (if (null? (car q))
	(set-car! q h)
	(set-cdr! (cdr q) h))
    (set-cdr! q h))
  q)

;;; q-pop! q
;;;  Take the front of Q and return it.
(define (q-pop! q)
  (q-empty-check q)
  (let ((it (caar q))
	(next (cdar q)))
    (if (null? next)
	(set-cdr! q #f))
    (set-car! q next)
    it))

;;; deq! q
;;;  Take the front of Q and return it.
(define deq! q-pop!)

;;; q-length q
;;;  Return the number of enqueued elements.
;;;
(define (q-length q) (length (car q)))

;;; q.scm ends here

Filemanager

Name Type Size Permission Actions
peg Folder 0755
and-let-star.scm File 2.53 KB 0644
arrays.scm File 2.63 KB 0644
atomic.scm File 1.55 KB 0644
binary-ports.scm File 1.99 KB 0644
boot-9.scm File 143.94 KB 0644
buffered-input.scm File 4.82 KB 0644
calling.scm File 10.54 KB 0644
channel.scm File 5.19 KB 0644
command-line.scm File 18.2 KB 0644
common-list.scm File 8.95 KB 0644
control.scm File 4.08 KB 0644
curried-definitions.scm File 1.79 KB 0644
debug.scm File 1.09 KB 0644
deprecated.scm File 2.95 KB 0644
documentation.scm File 7.41 KB 0644
eval-string.scm File 2.99 KB 0644
eval.scm File 25.12 KB 0644
expect.scm File 5.5 KB 0644
fdes-finalizers.scm File 1.06 KB 0644
format.scm File 74.37 KB 0644
ftw.scm File 24.17 KB 0644
futures.scm File 10.49 KB 0644
gap-buffer.scm File 10.14 KB 0644
getopt-long.scm File 16.49 KB 0644
hash-table.scm File 1.77 KB 0644
hcons.scm File 2.55 KB 0644
history.scm File 2.29 KB 0644
i18n.scm File 20.51 KB 0644
iconv.scm File 3.65 KB 0644
lineio.scm File 3.85 KB 0644
list.scm File 1.29 KB 0644
local-eval.scm File 9.96 KB 0644
ls.scm File 3.2 KB 0644
mapping.scm File 4.84 KB 0644
match.scm File 2 KB 0644
match.upstream.scm File 35.92 KB 0644
networking.scm File 3.33 KB 0644
null.scm File 1.13 KB 0644
occam-channel.scm File 7.26 KB 0644
optargs.scm File 15.75 KB 0644
peg.scm File 1.64 KB 0644
poe.scm File 3.3 KB 0644
poll.scm File 5.79 KB 0644
popen.scm File 6.82 KB 0644
ports.scm File 18.89 KB 0644
posix.scm File 2.73 KB 0644
pretty-print.scm File 16.88 KB 0644
psyntax-pp.scm File 180.55 KB 0644
psyntax.scm File 148.7 KB 0644
q.scm File 4.2 KB 0644
quasisyntax.scm File 5.22 KB 0644
r5rs.scm File 1.56 KB 0644
r6rs-libraries.scm File 9.43 KB 0644
rdelim.scm File 7.72 KB 0644
readline.scm File 9.56 KB 0644
receive.scm File 1.06 KB 0644
regex.scm File 8.87 KB 0644
runq.scm File 8.18 KB 0644
rw.scm File 1.02 KB 0644
safe-r5rs.scm File 3.72 KB 0644
safe.scm File 1.25 KB 0644
sandbox.scm File 34.23 KB 0644
save-stack.scm File 2.15 KB 0644
scm-style-repl.scm File 11.62 KB 0644
serialize.scm File 3.78 KB 0644
session.scm File 17.72 KB 0644
slib.scm File 1.55 KB 0644
stack-catch.scm File 1.94 KB 0644
streams.scm File 5.86 KB 0644
string-fun.scm File 8.59 KB 0644
suspendable-ports.scm File 29.87 KB 0644
syncase.scm File 1.52 KB 0644
textual-ports.scm File 2.29 KB 0644
threads.scm File 12.54 KB 0644
time.scm File 2.07 KB 0644
top-repl.scm File 2.75 KB 0644
unicode.scm File 1005 B 0644
vlist.scm File 21.56 KB 0644
weak-vector.scm File 1.2 KB 0644