(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "BATCHES" (USE "LISP" "PT") (NICKNAMES "BT")
 (PREFIX-NAME "BT")))

(il:filecreated " 8-Jan-89 17:46:32" il:{qv}<idl>next>batches.\;3
 4708   

      il:|changes| il:|to:|  (il:vars il:batchescoms)

      il:|previous| il:|date:| "18-Dec-88 19:07:33" il:{qv}<idl>next>batches.\;2)


; Copyright (c) 1988, 1989 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:batchescoms)

(il:rpaqq il:batchescoms ((il:coms (il:* il:|;;| "Batches") (il:structures batch) (il:functions print-batch) (il:functions construct-batch adjust-batch subset-batch)) (il:coms (il:* il:|;;| "Identifiers") (il:structures identifier) (il:functions print-identifier) (il:functions identifier-name identifier-index-p identifier-index identifier-name-p) (il:functions subset-identifier)) (eval-when (load compile) (il:p (export (quote (batch batch-p make-batch batch-vector batch-measurement construct-batch adjust-batch subset-batch identifier make-identifier identifier-p identifier-measurement identifier-vector identifier-name identifier-index-p identifier-index identifier-name-p subset-identifier)) (find-package "BATCHES")))) (xcl:file-environments "BATCHES")))



(il:* il:|;;| "Batches")



(defstruct (batch (:print-function print-batch)) measurement vector)

(defun print-batch (batch stream print-level) (write-string "#<" stream) (princ (quote batch) stream) (write-string " " stream) (princ (mt:measurement-documentation (batch-measurement batch)) stream) (write-string " " stream) (let ((*print-level* (and *print-level* (max 0 (- *print-level* print-level))))) (prin1 (batch-vector batch) stream)) (write-string ">" stream))

(defun construct-batch (vector &key documentation) (let ((numeric-p (every (function numberp) vector))) (make-batch :measurement (if numeric-p (mt:make-measurement (quote mt:numeric) documentation) (mt:make-measurement (quote mt:non-numeric) documentation)) :vector vector)))

(defun adjust-batch (batch &key new-measurement new-vector) (when new-measurement (let ((vector (batch-vector batch))) (dotimes (i (length vector)) (let ((element (aref vector i))) (unless (mt:measurement-member-p element new-measurement) (error "~s is not a ~s" element new-measurement)))) (setf (batch-measurement batch) new-measurement))) (when new-vector (let ((measurement (batch-measurement batch))) (dotimes (i (length new-vector)) (let ((element (aref new-vector i))) (unless (mt:measurement-member-p element measurement) (error "~s is not a ~s" element measurement))))) (setf (batch-vector batch) new-vector)) batch)

(defun subset-batch (batch indices) (make-batch :measurement (batch-measurement batch) :vector (ea:vector-select (batch-vector batch) indices)))



(il:* il:|;;| "Identifiers")



(defstruct (identifier (:include batch) (:print-function print-identifier)))

(defun print-identifier (identifier stream print-level) (write-string "#<" stream) (princ (quote identifier) stream) (write-string " " stream) (princ (mt:measurement-documentation (identifier-measurement identifier)) stream) (write-string " " stream) (let ((*print-level* (and *print-level* (max 0 (- *print-level* print-level))))) (prin1 (identifier-vector identifier) stream)) (write-string ">" stream))

(defun identifier-name (identifier index) (let ((vector (identifier-vector identifier))) (if (identifier-index-p vector index) (aref (identifier-vector identifier) index) (error "Index out of bounds: ~s" index))))

(defun identifier-index-p (identifier index) (array-in-bounds-p (identifier-vector identifier) index))

(defun identifier-index (identifier name) (or (position name (identifier-vector identifier)) (error "No such name: ~s" name)))

(defun identifier-name-p (identifier name) (position name (identifier-vector identifier)))

(defun subset-identifier (identifier &key indices names) (when (null indices) (setq indices (ea:array-apply (function identifier-index) identifier names))) (make-identifier :measurement (identifier-measurement identifier) :vector (ea:vector-select (identifier-vector identifier) indices)))
(eval-when (load compile)

(export (quote (batch batch-p make-batch batch-vector batch-measurement construct-batch adjust-batch subset-batch identifier make-identifier identifier-p identifier-measurement identifier-vector identifier-name identifier-index-p identifier-index identifier-name-p subset-identifier)) (find-package "BATCHES"))
)

(xcl:define-file-environment "BATCHES" :readtable "XCL" :package (xcl:defpackage "BATCHES" (:use "LISP" "PT") (:nicknames "BT") (:prefix-name "BT")) :compiler :compile-file)
(il:putprops il:batches il:copyright ("Xerox Corporation" 1988 1989))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop