/* This file is part of cqual.
   Copyright (C) 2002 The Regents of the University of California.

cqual is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

cqual is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with cqual; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */

#define CIL_PARSER
#include "cqual.h"
#include "cil-ast.h"
#include "location.h"
#include <assert.h>
#include <string.h>
#include "user-qual.h"

#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>
#include <caml/callback.h>

#include <stdio.h>

/* force function for lazy implementation :-) */
#define DIE assert(0);


/**********************************************************
 *
 * init_types, make_pointer_type, make_dummy_number_type
 *
 **********************************************************/
extern cil_typ dummy_ptr_type;
extern cil_typ dummy_number_type;


/* Return type 'pointer to t' (unqualified) */
/*xxx allocating on ML heap */

//extern void print_cil_type(type);
//type make_pointer_type(value /*cil_typ*/ t) 
//{ 
//  CAMLparam1(t);
//  CAMLlocal1(pt);
//  caml__dummy_pt = caml__dummy_pt;
//  caml__dummy_t = caml__dummy_t;

//  pt = alloc(2, TPtr);
//  Field(pt, 0) = (value)t; /* ptsto */
//  Field(pt, 1) = (value)NIL; 
//  /*print_cil_type((type)pt);
//    printf(" points to ");
//    print_cil_type((type)t);
//  */
//  CAMLreturn((type)pt);
//}

/* just allocate a 2 cell type (ok for ints, float, ptrs, maybe others) */
//type mk_type2(int tag, value /*int*/ f1)
//{
//  CAMLparam0();
//  CAMLlocal1(t);
//  caml__dummy_t = caml__dummy_t;
//  t = alloc(2, tag);
//  Field(t, 0) = f1;
//  Field(t, 1) = (value)NIL;
//  CAMLreturn((type)t);
//}

/* returned value onlky good until next call
 * only used before a call to convert_type_qtype */
type make_pointer_type(cil_typ t)
{
  dummy_ptr_type->tptr.ptsto = t;
  return dummy_ptr_type;
}

/* create an int or float type - only good until next call
 * (used before calls to convert_type_qtype)
 * important: kind must be a value! (i.e. either come from the tree 
 * or had Val_int used on it */
type make_dummy_number_type(int tag, value kind)
{
  Tag_val(dummy_number_type) = tag;
  if (tag == TInt)
    dummy_number_type->tint.kind = kind;
  else if (tag == TFloat)
    dummy_number_type->tfloat.kind = kind;
  else
    assert(tag == TInt || tag == TFloat);
  return dummy_number_type;
}


/******************************************* 
 *
 * predicates on cil types 
 *
 *******************************************/

/* I think CIL gets rid of these */
bool type_transparent(type t) 
{ 
  return FALSE; 
}

bool type_plain_char(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IChar; 
}
bool type_signed_char(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == ISChar; 
}
bool type_unsigned_char(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IUChar; 
}
bool type_short(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IShort; 
}
bool type_unsigned_short(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IUShort;
}
bool type_int(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IInt; 
}
bool type_unsigned_int(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IUInt; 
}
bool type_long(type t) 
{
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == ILong; 
}
bool type_unsigned_long(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IULong; 
}
bool type_long_long(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == ILongLong; 
}
bool type_unsigned_long_long(type t) 
{ 
  return Tag_val(t) == TInt && Int_val(t->tint.kind) == IULongLong; 
}
bool type_char(type t) 
{ 
  return Tag_val(t) == TInt 
    && (Int_val(t->tint.kind) == IChar 
	|| Int_val(t->tint.kind) == ISChar
	|| Int_val(t->tint.kind) == IUChar);
}

bool type_float(type t) 
{ 
  return Tag_val(t) == TFloat && Int_val(t->tfloat.kind) == FFloat; 
}
bool type_double(type t) 
{ 
  return Tag_val(t) == TFloat && Int_val(t->tfloat.kind) == FDouble; 
}
bool type_long_double(type t) 
{ 
  return Tag_val(t) == TFloat && Int_val(t->tfloat.kind) == FLongDouble; 
}

bool type_integral(type t) 	/* Does not include enum's */
{ 
  return Tag_val(t) == TInt; 
}
bool type_floating(type t) 
{ 
  return Tag_val(t) == TFloat; 
}
bool type_complex(type t) { return FALSE; } /*xxx*/
bool type_void(type t) 
{ 
  return Tag_val(t) == TVoid; 
}
bool type_function(type t) 
{ 
  return Tag_val(t) == TFun; 
}
bool type_array(type t) 
{ 
  return Tag_val(t) == TArray; 
}
bool type_pointer(type t) 
{ 
  return Tag_val(t) == TPtr; 
}
bool type_enum(type t) 
{ 
  return Tag_val(t) == TEnum; 
}
bool type_struct(type t) 
{ 
  return Tag_val(t) == TComp 
    && t->tcomp.ci->cstruct == Val_true;
}
bool type_union(type t) 
{ 
  return Tag_val(t) == TComp 
    && t->tcomp.ci->cstruct == Val_false;
}

bool type_aggregate(type t)
{
  return Tag_val(t) == TComp;
  /*  return type_struct(t) || type_union(t); */
}
bool type_tagged(type t) 
{ 
  return type_enum(t) || type_struct(t) || type_union(t); 
}

bool type_integer(type t)
{
  return type_integral(t) || type_enum(t);
}

bool type_real(type t)
{
  return type_integer(t) || type_floating(t);
}

bool type_arithmetic(type t)
{
  return type_real(t) || type_complex(t);
}

bool type_scalar(type t)
{
  return type_arithmetic(t) || type_pointer(t);
}

bool type_unsigned(type t) 
{ 
  return Tag_val(t) == TInt 
    && ( Int_val(t->tint.kind) == IUChar
#ifdef __CHAR_UNSIGNED__
	 || Int_val(t->tint.kind) == IChar
#endif
	 || Int_val(t->tint.kind) == IUShort
	 || Int_val(t->tint.kind) == IUInt
	 || Int_val(t->tint.kind) == IULong
	 || Int_val(t->tint.kind) == IULongLong );
}

bool type_atomic(type t)        /* Primitive types */
{ 
  return type_integral(t) 
    || type_floating(t)
    || type_void(t)
    || type_complex(t); 
}

type type_points_to(type t) 
{ 
  assert(Tag_val(t) == TPtr);
  return t->tptr.ptsto; 
}

/* return the attributes of a type */
cil_attributes type_attr(cil_typ t)
{
  cil_attributes as;
  switch (Tag_val(t))
    {
    case TVoid:   as = t->tvoid.attr; break;
    case TInt:    as = t->tint.attr; break;
    case TFloat:  as = t->tfloat.attr; break;
    case TPtr:    as = t->tptr.attr; break;
    case TArray:  as = t->tarray.attr; break;
    case TFun:    as = t->tfun.attr; break;
    case TNamed:  as = t->tnamed.attr; break;
    case TComp:   as = t->tcomp.attr; break;
    case TEnum:   as = t->tenum.attr; break;
    case TBuiltin_va_list: as = t->tbuiltin_va_list.attr; break;
    default: DIE;
    }
  return as;
}


/* check the attributes of type t for character string attr */
static bool has_string_attribute(cil_typ t, const char *str)
{
  cil_attributes iter;
  cil_attribute a;
  cil_attributes as;
  
  as = type_attr(t);

  cil_scanlist(a, iter, as)
    {
      /* printf("<%s>", String_val(a->name)); */
      if (strcmp(String_val(a->name), str) == 0)
	return TRUE;
    }
  return FALSE;
}

bool type_const(type t) 
{ 
  return has_string_attribute(t, "const"); 
} 
bool type_volatile(type t) 
{ 
  return has_string_attribute(t, "volatile"); 
}
//???
bool type_readonly(type t) { DIE return type_const(t); }



type type_function_return_type(type t) 
{ 
  assert(Tag_val(t) == TFun);
  return t->tfun.rettype; 
}

/* cil transforms old style declarations */
bool type_function_oldstyle(type t) 
{ 
  return FALSE; 
}


typelist type_function_arguments(type t) 
{ 
  assert(Tag_val(t) == TFun);
  return t->tfun.args == NONE ? NULL : *(t->tfun.args); 
}

void typelist_scan(typelist tl, typelist_scanner *scanner) 
{
  assert(scanner);
  *scanner = tl;
}

type typelist_next(typelist_scanner *scanner) 
{ 
  assert (scanner);
  if ( *scanner == NIL )
    return NULL;
  else
    {
      type result;
      result = (*scanner)->head->type;
      *scanner = (*scanner)->tail;
      return result;
    }
}

//implement me
type_quals type_qualifiers(type t) 
{ 
  return 0; 
} 

bool type_restrict(type t) 
{ 
  return FALSE; 
} 


bool type_function_varargs(type t) 
{ 
  assert(Tag_val(t) == TFun);
  return Bool_val(t->tfun.var_arg);
}

//implement me
type_quals type_function_varargs_quals(type t) 
{ 
  return 0; 
} //acc

user_qual_list type_function_varargs_user_quals(type t) 
{ 
  return 0; 
}


/* Type variable */
type make_type_var(cstring cs) { DIE return 0; }
bool type_var(type t) { return FALSE; } //could this ever be true?
const char *type_name(type t) { DIE return NULL; };

type type_array_of(type t) 
{ 
  assert(Tag_val(t) == TArray);
  return t->tarray.arrayof;
}
type type_array_of_base(type t) 
{
  while (Tag_val(t) == TArray)
    t = t->tarray.arrayof;
  return t;
}
expression type_array_size(type t)
{
  cil_exp *e;
  assert(Tag_val(t) == TArray);
  e = t->tarray.sz;
  return e==NONE ? NULL : *e;
}

/* sfg: I don't know why this alias for type_array_of_base exists */
type type_base(type t) 
{
  return type_array_of_base(t);
}



/******* stuff below here still not implemented *********/

type make_unsigned_type(type t) { DIE return 0; }

/* Return FALSE if function type FNTYPE specifies a fixed number of parameters
   and none of their types is affected by default promotions.  */
bool self_promoting_args(type fntype) { DIE return FALSE; }


/* Build AST nodes such that "MODIFIERS D" represents the declaration of
   "T INSIDE", at location loc, allocating in region r */
void type2ast(region r, location loc, type t, declarator inside,
	      declarator *d, type_element *modifiers) { DIE return; }

bool type_contains_pointers(type t) { DIE return FALSE; }
bool type_contains_union_with_pointers(type t) { DIE return FALSE; }
bool type_contains_quals(type t) { DIE return FALSE; }
bool type_contains_user_quals(type t) { DIE return FALSE; }

type type_default_conversion(type from) { DIE return 0; }
type function_call_type(function_call fcall) { DIE return 0; }

void name_tag(tag_declaration tag) {DIE return; }

/* DIE Return the integral type of size 'size', unsigned if 'isunsigned' is FALSE */
type type_for_size(int size, bool isunsigned) { DIE return 0; }

type type_for_cval(cval c, bool isunsigned) { DIE return 0; }


/**********************************************/


/* more stuff to make it link - lifted directly from type.c */

#define Q(name, kind, tq, val) \
bool qual_ ## name(type_quals q) \
{ \
  return (q & tq) != 0; \
}
#include "qualifiers.h"
#undef Q

#define Q(name, kind, tq, val) \
bool force_qual_ ## name(type_quals q) \
{ \
  return q | tq; \
}
#include "qualifiers.h"
#undef Q



/* type_quals force_qual_const(type t) { DIE return 0; } //not expl dec */



/* bool qual_const(type_quals quals) { DIE return FALSE; } //not expl def */
/* bool qual_volatile(type_quals quals) { DIE return FALSE; } //apparently never used, not expl def */
/* bool qual_restrict(type_quals quals) { DIE return FALSE; } //" */

