(in-package #:user-side-compiler)

(defclass label ()
  ((%name :accessor name :initarg :name)
   (%address :accessor address :initform nil :initarg :address)))

(defun labelp (obj)
  (typep obj 'label))

(defmethod print-object ((object label) stream)
  (with-accessors ((name name) (address address)) object
    (print-unreadable-object (object stream :type t)
      (write-string name stream)
      (unless (null address)
        (format stream " @ 0x~4,'0X" address)))))

(defvar *label-counter* 0)

(defun make-label-name (prefix)
  (format nil "~A~D" prefix (incf *label-counter*)))

(defun make-label (&key name name-prefix address)
  (when (and (not (null name)) (not (null name-prefix)))
    (warn "MAKE-LABEL with both name (~A) and prefix (~A) specified (useless)."
          name name-prefix))
  (when (null name)
    (setf name (make-label-name (if (null name-prefix) "L" name-prefix))))
  (make-instance 'label :name name :address address))

(defclass offset-label (label)
  ((%offset-from :accessor offset-from :initarg :offset-from)
   (%offset :accessor offset :initarg :offset)))

(defmethod address ((object offset-label))
  (+ (address (offset-from object))
     (offset object)))

(defmethod name ((object offset-label))
  (format nil "~A~C~D"
          (name (offset-from object))
          (if (minusp (offset object))
              #\-
              #\+)
          (offset object)))

(defun make-offset-label (src-label offset)
  (make-instance 'offset-label :offset-from src-label :offset offset))