; IR definitions and manipulation functions

(in-package "VERRAZANO")

; base class for all IR types with names
(defclass named ()
  ((name :accessor named-name :initform nil :initarg :name)
   (c-name :accessor named-c-name :initform nil :initarg :c-name)))

; base class for IR types
(defclass annotable () 
  ((notes :accessor annotable-notes :initform (make-hash-table))))

; defines a node in the graph
(defclass node (annotable) 
  ((edges :accessor node-edges :initform nil) 
   (mark :accessor node-mark :initform nil)
   (order :accessor node-order :initform nil)))

; root of entire tree, defines root namespace
(defclass library (node)
  ())

; base type for all C++ types
(defclass cpp-type (node named) 
  ())

; all concrete types (types that have memory representation)
(defclass concrete-type (cpp-type)
  ((size :accessor concrete-type-size :initform nil)
   (align :accessor concrete-type-align :initform nil)))

; definition for a namespace
(defclass namespace-type (cpp-type) 
  ())

; definition for types like 'int' 
(defclass fundamental-type (concrete-type)
  ())

; definition for a qualification of another type
(defclass qualified-type (cpp-type)
  ((const :accessor qualified-type-const :initform nil)))

; definition for a pointer to another type
(defclass pointer-type (concrete-type)
  ())

; definition for an array of another type
(defclass array-type (concrete-type)
  ((length :accessor array-type-length :initform 0)))

; definition for an enumeration type
(defclass enum-type (concrete-type)
  ())

; definition for structures (or classes)
(defclass struct-type (concrete-type)
  ())

; definition for unions
(defclass union-type (concrete-type)
  ())

; definition for classes (or structures)
(defclass class-type (concrete-type)
  ())

; definition for function prototypes
(defclass function-type (cpp-type)
  ())

; definition for aliases
(defclass alias-type (cpp-type)
  ())

; pseudo-type to indicate varargs
(defclass ellipsis-type (cpp-type)
  ())

; represents edges in the graph
(defclass edge (annotable)
  ((target :accessor edge-target :initarg :target)))

; source returns object of type target
(defclass returns (edge)
  ())

; source receives object of type target as argument
(defclass receives (edge named)
  ((value :accessor receives-edge-value :initform nil :initarg :value)
   (virtual :accessor receives-edge-virtual :initform nil :initarg :virtual)
   (index :accessor receives-edge-index :initform nil :initarg :index)
   (offset :accessor receives-edge-offset :initform nil :initarg :offset)))

; source defines an object of type target
(defclass defines (edge)
  ())

; source allocates an object of type target
(defclass allocates (edge named)
  ((value :accessor allocates-edge-value :initform nil :initarg :value)
   (virtual :accessor allocates-edge-virtual :initform nil :initarg :virtual)
   (offset :accessor allocates-edge-offset :initform 0 :initarg :offset)))

; definition of source extends definition of target
(defclass extends (edge)
  ((virtual :accessor extends-edge-virtual :initform nil :initarg :virtual)
   (offset :accessor extends-edge-offset :initform 0 :initarg :offset)))

; add an edge to a node (to end of list)
(defun append-edge (from edg)
  (setf (node-edges from)
	(append (node-edges from) (list edg))))

; add an edge to a node (to beginning of list)
(defun prepend-edge (from edg)
  (push edg (node-edges from)))

; set a slot in an IR node
(defun set-slot (irelt slot value &optional default)
  (let ((val (if value value default)))
    (when val
      (setf (slot-value irelt slot) val))))

; set the annotation on an element
(defun set-note (irelt name value &optional default)
  (let ((val (if value value default)))
    (when val
      (setf (gethash name (annotable-notes irelt)) val))))

; get the annotation on an element
(defun get-note (irelt name)
  (gethash name (annotable-notes irelt)))

; mark a node as visited
(defun mark-node (node)
  (setf (node-mark node) t))

; unmark a node
(defun unmark-node (node)
  (setf (node-mark node) nil))