#!/home/dbane/openlisp-10.9.0/uxlisp -shell

;;; UUID V1 from https://tools.ietf.org/html/rfc4122#page-18, ported to Lisp.

(require "sysdep")
(defpackage #:uuid
  (:use #:openlisp #:sysdep)
  (:export
    #:main))
(in-package #:uuid)
(defclass <uuid> () ((time-low :accessor time-low)
                      (time-mid :accessor time-mid)
                      (time-hi-and-version :accessor time-hi-and-version)
                      (clock-seq-hi-and-reserved :accessor clock-seq-hi-and-reserved)
                      (clock-seq-low :accessor clock-seq-low)
                      (node :accessor node)))
(defgeneric format-v1 (obj clockseq timestamp node))
(defmethod format-v1 ((obj <uuid>) clock-seq timestamp node)
  (setf (time-low obj) (logand timestamp #xFFFFFFFF))
  (setf (time-mid obj) (logand (ash timestamp -32) #xFFFF))
  (setf (time-hi-and-version obj) (logand (ash timestamp -48) #x0FFF))
  (setf (time-hi-and-version obj) (logior (time-hi-and-version obj) (ash 1 12)))
  (setf (clock-seq-low obj) (logand clock-seq #xFF))
  (setf (clock-seq-hi-and-reserved obj) (ash (logand clock-seq #x3F00) -8))
  (setf (clock-seq-hi-and-reserved obj) (logior (clock-seq-hi-and-reserved obj) #x80))
  (setf (node obj) node))
(defun get-current-time ()
  )

(defmethod initialize-object :after ((self <uuid>) initargs)
  (let ((timestamp (get-current-time))
         (node (get-ieee-node-identifier)))
    (format-v1 self clockseq timestamp node)))
(defgeneric print-object (obj))
(defmethod print-object ((obj <uuid>))
  (format (standard-output) ""))
(defun main ()
  (let ((u (create (class <uuid>))))
    (format (standard-output) "(create (class <uuid>)): ")
    (print-object u)))
(provide "uuid")
(main)