#include "Rts.h"
#include "Internals.h"

#define app2(A, B) rts_apply((A),(B))
#define app3(A, B, C) rts_apply(rts_apply((A),(B)),(C))
#define app4(A, B, C, D) rts_apply(rts_apply(rts_apply((A),(B)),(C)),(D))
#define app5(A, B, C, D, E) rts_apply(rts_apply(rts_apply(rts_apply((A),(B)),(C)),(D)),(E))
#define app6(A, B, C, D, E, F) rts_apply(rts_apply(rts_apply(rts_apply(rts_apply((A),(B)),(C)),(D)),(E)),(F))

HaskellObj reifyC_ ( GraphNode* node
                   , StgClosure *AppNode
                   , StgClosure *CharNode
                   , StgClosure *IntNode
                   , StgClosure *IntegerNode
                   , StgClosure *FloatNode
                   , StgClosure *DoubleNode
                   , StgClosure *NullNode
                   , StgClosure *Nil
                   , StgClosure *Cons );


StgStablePtr reifyC ( StgStablePtr ptrObj
                    , StgStablePtr ptrAppNode
                    , StgStablePtr ptrCharNode
                    , StgStablePtr ptrIntNode
                    , StgStablePtr ptrIntegerNode
                    , StgStablePtr ptrFloatNode
                    , StgStablePtr ptrDoubleNode
                    , StgStablePtr ptrNullNode
                    , StgStablePtr ptrNil
                    , StgStablePtr ptrCons )
{
   HaskellObj obj;
   HaskellObj AppNode;
   HaskellObj CharNode;
   HaskellObj IntNode;
   HaskellObj IntegerNode;
   HaskellObj FloatNode;
   HaskellObj DoubleNode;
   HaskellObj NullNode;
   HaskellObj Nil;
   HaskellObj Cons;

   HaskellObj graph; 

   StgPtr sptrGraph;

   GraphNode *heapGraph;

   heapGraph = makeHeapGraph (ptrObj);

   AppNode = (HaskellObj) deRefStablePtr (ptrAppNode);
   CharNode = (HaskellObj) deRefStablePtr (ptrCharNode);
   IntNode = (HaskellObj) deRefStablePtr (ptrIntNode);
   IntegerNode = (HaskellObj) deRefStablePtr (ptrIntegerNode);
   FloatNode = (HaskellObj) deRefStablePtr (ptrFloatNode);
   DoubleNode = (HaskellObj) deRefStablePtr (ptrDoubleNode);
   NullNode = (HaskellObj) deRefStablePtr (ptrNullNode);
   Nil = (HaskellObj) deRefStablePtr (ptrNil);
   Cons = (HaskellObj) deRefStablePtr (ptrCons);

   graph = reifyC_ ( heapGraph 
                   , AppNode
                   , CharNode
                   , IntNode
                   , IntegerNode
                   , FloatNode
                   , DoubleNode
                   , NullNode
                   , Nil
                   , Cons );

   freeGraph (heapGraph);
   sptrGraph = (getStablePtr ((StgPtr) graph));
   return (sptrGraph);
}

HaskellObj reifyC_ ( GraphNode* node
                   , StgClosure *AppNode
                   , StgClosure *CharNode
                   , StgClosure *IntNode
                   , StgClosure *IntegerNode
                   , StgClosure *FloatNode
                   , StgClosure *DoubleNode
                   , StgClosure *NullNode
                   , StgClosure *Nil
                   , StgClosure *Cons )
{

   switch (node->tag)
   {
      case Node:
      {
         int i;
         HaskellObj list;
         HaskellObj child;

         /* nullary constructors */
         if (node->numChildren == 0)
         {
            return (app6 ( AppNode
                         , rts_mkInt (node->unique)
                         , rts_mkString (node->val.descriptor)
                         , rts_mkInt (node->tag)
                         , rts_mkInt (0)
                         , Nil 
                         ));
         } 
         /* non-nullary constructors */
         else
         {
            list = Nil;
            
            /* probably should optimise the tail recursion */
            for (i = node->numChildren - 1; i >= 0; i--)
            {
               child = reifyC_ ( node->children[i] 
                               , AppNode
                               , CharNode
                               , IntNode
                               , IntegerNode
                               , FloatNode
                               , DoubleNode
                               , NullNode
                               , Nil
                               , Cons );

               list = app3 (Cons, child, list);
            }
            return (app6 ( AppNode
                         , rts_mkInt (node->unique)
                         , rts_mkString (node->val.descriptor)
                         , rts_mkInt (node->tag)
                         , rts_mkInt (node->numChildren)
                         , list
                         ));
         } 
         break;
      }

      case Thunk:
      {
         return (app6 ( AppNode
                      , rts_mkInt (-1)
                      , rts_mkString ("")
                      , rts_mkInt (node->tag)
                      , rts_mkInt (0)
                      , Nil
                      )); 
         break;
      }

      case Cycle:
      {
         return (app6 ( AppNode
                      , rts_mkInt (-1)
                      , rts_mkString ("")
                      , rts_mkInt (node->tag)
                      , rts_mkInt (0)
                      , Nil
                      )); 
         break;
      }

      case Ap_Upd:
      {
         return (app6 ( AppNode
                      , rts_mkInt (-1)
                      , rts_mkString ("")
                      , rts_mkInt (node->tag)
                      , rts_mkInt (0)
                      , Nil
                      )); 
         break;
      }

      case Exception:
      {
         HaskellObj child;

         child = reifyC_ ( node->children[0]
                         , AppNode
                         , CharNode
                         , IntNode
                         , IntegerNode
                         , FloatNode
                         , DoubleNode
                         , NullNode
                         , Nil
                         , Cons );

         return (app6 ( AppNode
                      , rts_mkInt (-1)
                      , rts_mkString ("")
                      , rts_mkInt (node->tag)
                      , rts_mkInt (1)
                      , app3 (Cons, child, Nil)
                      )) ;
         break;

      }

      case Fun:
      {
         return (app6 ( AppNode
                      , rts_mkInt (-1)
                      , rts_mkString ("")
                      , rts_mkInt (node->tag)
                      , rts_mkInt (0)
                      , Nil
                      )); 
         break;
      }

      case Int:
      {
         return (app2 (IntNode, rts_mkInt (node->val.machineInt)));
         break;
      }

      case SmallInteger:
      {
         return (app2 (IntNode, rts_mkInt (node->val.machineInt)));
         break;
      }

      case LargeInteger:
      {
         HaskellObj integerValue;
         integerValue = (HaskellObj) deRefStablePtr (node->val.largeIntegerSPtr);
         return (app2 (IntegerNode, integerValue));
         break;
      }

      case Char:
      {
         return (app2 (CharNode, rts_mkChar (node->val.character)));
         break;
      }

      case Float:
      {
         return (app2 (FloatNode, rts_mkFloat (node->val.machineFloat)));
         break;
      }

      case Double:
      {
         return (app2 (DoubleNode, rts_mkDouble (node->val.machineDouble)));
         break;
      }
      
      default:
      {
         return (NullNode);
         break;
      }
   }
}