; a list of parser handlers

(in-package "VERRAZANO")

; map of handlers for driving the parser
(defparameter +handler-map+
  '((:|ArrayType|        . handle-array-type)
    (:|Class|            . handle-class)
    (:|Constructor|      . handle-constructor)
    (:|Converter|        . handle-converter)
    (:|CvQualifiedType|  . handle-cv-qualified-type)
    (:|Destructor|       . handle-destructor)
    (:|Enumeration|      . handle-enumeration)
    (:|Function|         . handle-function)
    (:|FunctionType|     . handle-function-type)
    (:|FundamentalType|  . handle-fundamental-type)
    (:|Method|           . handle-function)
    (:|MethodType|       . handle-function-type)
    (:|Namespace|        . handle-namespace)
    (:|NamespaceAlias|   . handle-namespace-alias)
    (:|OperatorFunction| . handle-operator)
    (:|OperatorMethod|   . handle-operator)
    (:|PointerType|      . handle-pointer-type)
    (:|ReferenceType|    . handle-pointer-type)
    (:|Struct|           . handle-class)
    (:|Typedef|          . handle-typedef)
    (:|Union|            . handle-union)))

; lookup the handler for a given XML element
(defun lookup-handler (element)
  (cdr (assoc element +handler-map+)))

; add edges to all the bases of a given node
(defun add-edges-to-bases (irn node pstate)
  (declare (ignore pstate))
  (dolist (base (get-element-children node))
    (with-edge-from-xml ire 'extends irn base ':|type|)))

; add edges to all the members of a given node
(defun add-edges-to-members (irn node pstate)
  (dolist (to (split-id-list (get-element-attribute node ':|members|)))
    (let* ((tonode (gethash to (parser-state-xnodes pstate)))
	   (totype (get-element-name tonode)))
      (cond ((member totype +defined-types+)
	     (add-edge-to-defined irn tonode))
	    ((member totype +allocated-types+)
	     (if (member totype +indirect-allocated-types+)
	       (add-edge-to-indirect irn tonode)
	       (add-edge-to-direct irn tonode)))))))

; add an edge to a defined type
(defun add-edge-to-defined (irn tonode)
  (with-new-edge ire 'defines irn (get-element-id tonode)))

; add an edge to an indirectly-allocated type
(defun add-edge-to-indirect (irn tonode)
  (with-new-edge ire 'allocates irn 
		 (get-element-attribute tonode ':|type|)
    (slot-from-xml ire 'name tonode ':|name|)
    (slot-from-xml ire 'value tonode ':|init|)))

; add an edge to a directly-allocated type
(defun add-edge-to-direct (irn tonode)
  (with-new-edge ire 'allocates irn (get-element-id tonode)
    (slot-from-xml ire 'name tonode ':|name|)
    (slot-from-xml ire 'value tonode ':|init|)))

; add edges to the arguments of a function-type
(defun add-edges-to-arguments (irn node pstate)
  (declare (ignore pstate))
  (with-edge-from-xml ire 'returns irn node ':|returns|)
  (dolist (arg (get-element-children node))
    (with-new-edge ire 'receives irn (lookup-argument-type arg)
      (slot-from-xml ire 'name arg ':|name|)
      (slot-from-xml ire 'default arg ':|default|))))

; lookup the type of an argument, handling Ellipsis elements
(defun lookup-argument-type (node)
  (let ((name (get-element-name node)))
    (if (eq ':|Ellipsis| name)
      +ellipsis-type-id+
      (get-element-attribute node ':|type|))))

; add edges to the values of an enumeration
(defun add-edges-to-values (irn node pstate)
  (declare (ignore pstate))
  (dolist (valnode (get-element-children node))
    (with-new-edge ire 'allocates irn +const-integer-type-id+
      (slot-from-xml ire 'name valnode ':|name|)
      (slot-from-xml ire 'value valnode ':|init|))))

; handle ArrayType XML elements
(defun handle-array-type (node pstate)
  (with-new-node irn 'array-type node pstate
    (slot-from-xml irn 'size node ':|max|)
    (with-edge-from-xml ire 'extends irn node ':|type|)))

; handle Class XML elements
(defun handle-class (node pstate)
  (with-new-node irn 'class-type node pstate
    (slot-from-xml irn 'name node ':|name|)
    (add-edges-to-bases irn node pstate)
    (add-edges-to-members irn node pstate)))

; handle Constructor XML elements
(defun handle-constructor (node pstate)
  (with-function-type irn node pstate
    (set-note irn 'role 'constructor)))

; handle Converter XML elements
(defun handle-converter (node pstate)
  (with-function-type irn node pstate
    (set-note irn 'role 'converter)))

; handle CvQualifiedType XML elements
(defun handle-cv-qualified-type (node pstate)
  (with-new-node irn 'qualified-type node pstate
    (slot-from-xml irn 'const node ':|const|)
    (with-edge-from-xml ire 'extends irn node ':|type|)))

; handle Destructor XML elements
(defun handle-destructor (node pstate)
  (with-function-type irn node pstate
    (set-note irn 'role 'destructor)))

; handle Enumeration XML elements
(defun handle-enumeration (node pstate)
  (with-new-node irn 'enum-type node pstate
    (slot-from-xml irn 'name node ':|name|)
    (add-edges-to-values irn node pstate)))

; handle Function XML elements
(defun handle-function (node pstate)
  (with-function-type irn node pstate
    (set-note irn 'role 'plain)
    (set-note irn 'artificial t)))

; handle FunctionType XML elements
(defun handle-function-type (node pstate)
  (with-function-type irn node pstate
    (set-note irn 'role 'plain)))

; handle FundamentalType XML elements
(defun handle-fundamental-type (node pstate)
  (with-new-node irn 'fundamental-type node pstate
    (slot-from-xml irn 'name node ':|name|)))

; handle Namespace XML elements
(defun handle-namespace (node pstate)
  (with-new-node irn 'namespace-type node pstate
    (slot-from-xml irn 'name node ':|name|)
    (add-edges-to-members irn node pstate)))

; handle NamespaceAlias XML elements
(defun handle-namespace-alias (node pstate)
  (with-new-node irn 'alias-type node pstate
    (slot-from-xml irn 'name node ':|name|)
    (with-edge-from-xml ire 'extends irn node ':|namespace|)))

; handle OperatorFunction, OperatorMethod XML elements
(defun handle-operator (node pstate)
  (with-function-type irn node pstate
    (set-note irn 'role 'operator)))

; handle PointerType XML elements
(defun handle-pointer-type (node pstate)
  (with-new-node irn 'pointer-type node pstate
    (with-edge-from-xml ire 'extends irn node ':|type|)))

; handle Typedef XML elements
(defun handle-typedef (node pstate)
  (with-new-node irn 'alias-type node pstate
    (slot-from-xml irn 'name node ':|name|)
    (with-edge-from-xml ire 'extends irn node ':|type|)))

; handle Union XML elements
(defun handle-union (node pstate)
  (with-new-node irn 'union-type node pstate
    (slot-from-xml irn 'name node ':|name|)
    (add-edges-to-members irn node pstate)))