;;;; cl-scopes/shape - really abstract basic data shape definitions. (defpackage :scopes/shape (:use :common-lisp) (:local-nicknames (:util :scopes/util)) (:export #:record #:print-fields #:head-fields #:head #:head-value #:head-plist #:data-fields #:data #:data-value)) (in-package :scopes/shape) (defclass record () ((head-fields :reader head-fields :initarg :head-fields :initform '(:taskid :username) :allocation :class) (data-fields :reader data-fields :initarg :data-fields :initform nil :allocation :class) (head :reader head :initarg :head) (data :accessor data :initarg :data :initform nil))) (defmethod initialize-instance :after ((rec record) &key head &allow-other-keys) (setf (slot-value rec 'head) (util:rfill (head-fields rec) head))) (defmethod print-object ((rec record) stream) (print-fields rec stream 'head 'data)) (defun print-fields (rec stream &rest fields) (let ((fm (util:make-vars-format fields))) (print-unreadable-object (rec stream :type t) (apply #'format stream fm (mapcar #'(lambda (x) (funcall x rec)) fields))))) (defun head-value (rec key) (elt (head rec) (position key (head-fields rec)))) (defun (setf head-value) (val rec key) (setf (elt (head rec) (position key (head-fields rec))) val)) (defun head-plist (rec) (let (pl (hv (head rec))) (dolist (hf (head-fields rec)) (setf pl (cons hf (cons (util:from-keyword (pop hv)) pl)))) pl)) (defun data-value (rec key) (getf (data rec) key)) (defun (setf data-value) (val rec key) (setf (getf (data rec) key) val))