/*
 * Definition of built-in procedures.  These are coded in C according to the
 * protocol described in 451 Week 4 Lecture Notes.  By convention, names of
 * built-ins are same as names known to user, with a '_' suffix added to
 * avoid name conflicts.
 */

#include "std-macros.h"
#include "tokens.h"
#include "parse-tree.h"
#include "sym.h"
#include "type-preds.h"
#include "type.h"
#include "interp.h"
#ifdef DEMO
#include "idraw-interface.h"
#endif
#include "built-ins.h"
#include "token-mapping.h"
#include <stdio.h>
#include <stdlib.h>


ValueStruct abs_(nodep t) {
    ValueStruct v;
    double a;

    /*
     * Eval the argument.
     */
    v = interpExpr(t);

    /*
     * Bail if it's nil or non-numeric.
     */
    if (isNilValue(v) or ((v->tag != RealTag) and (v->tag != IntTag))) {
	return null;
    }

    /*
     * If arg is int, cast int val to double, and make the return type real.
     */
    if (v->tag == IntTag) {
	v->tag = RealTag;
	v->val.RealVal = (double) v->val.IntVal;
    }

    v->val.RealVal = abs(v->val.RealVal);
    return v;
}

ValueStruct cap_(t)
    nodep t;
{  }

ValueStruct chr_(t)
    nodep t;
{  }

ValueStruct dec_(t)
    nodep t;
{  }

ValueStruct excl_(t)
    nodep t;
{  }

ValueStruct float_(t)
    nodep t;
{  }

ValueStruct halt_(t)
    nodep t;
{
    printf("Exiting.\n");
    exit(0);
}

ValueStruct high_(t)
    nodep t;
{
    ValueStruct v;

    v = MakeVal(RVAL, CardType);
    v->val.IntVal = Lookup(t->components.exprlist.expr->
	components.atom.val.text)->
	    Type->components.type.kind.arraytype.normalizedubval;
    return v;
}

ValueStruct inc_(t)
    nodep t;
{  }

ValueStruct incl_(t)
    nodep t;
{  }

ValueStruct max_(t)
    nodep t;
{  }

ValueStruct min_(t)
    nodep t;
{  }

ValueStruct new_(t)
    nodep t;
{
    ValueStruct v;
    char *memp, *vaddr;

    v = designator(t->components.exprlist.expr);
    memp = (char *) calloc(
	TypeSize(v->type->components.type.kind.ref.basetype),
	    sizeof(char));
    bcopy((char *) &memp, v->val.LVal, sizeof(char *));
}

ValueStruct odd_(t)
    nodep t;
{  }

ValueStruct ord_(t)
    nodep t;
{
    ValueStruct v;

    v = interpExpr(t->components.exprlist.expr);
    v->val.IntVal = (int) v->val.CharVal;
    v->tag = IntTag;
    v->type = IntType;
    v->size = TypeSize(IntType);
    return v;
}

/*
 * Evaluate the given tree node as an expr, and send the result to ppValue.
 */
ValueStruct print_(nodep t) {
    ValueStruct v;

    DoPrint = false;
    v = interpExpr(t);
    PpValue(v, false);
    return null;
}

/*
 * Print, with an appended newline.
 */
ValueStruct println_(nodep t) {
    print_(t);
    printf("\n");
}

ValueStruct size_(t)
    nodep t;
{  }

ValueStruct sqrt_(t)
    nodep t;
{  }

ValueStruct trunc_(t)
    nodep t;
{  }

ValueStruct val_(t)
    nodep t;
{  }


/*
 * The GetStackXXX functions extract actual parm values from the interp stack.
 */
static Value** gtos;

void GetStackInt(/*var*/i)
    int *i;
{
    int s;

    bcopy(gtos, i, s = TypeSize(IntType));
    gtos += s;
}

void GetStackCard(/*var*/i)
    int *i;
{
    int s;

    bcopy(gtos, i, s = TypeSize(CardType));
    gtos += s;
}

void GetStackReal(/*var*/x)
    double *x;
{
    int s;

    bcopy(gtos, x, s = TypeSize(RealType));
    gtos += s;
}

void GetStackLongReal(/*var*/x)
    double *x;
{
    int s;

    bcopy(gtos, x, s = TypeSize(LongRealType));
    gtos += s;
}

void GetStackChar(/*var*/c)
    char *c;
{
    int s;

    bcopy(gtos, c, s = TypeSize(CharType));
    gtos += s;
}

void GetStackBool(/*var*/b)
    bool *b;
{
    int s;

    bcopy(gtos, b, s = TypeSize(BoolType));
    gtos += s;
}

/*
 * This doesnt get called right now; it's around for genuine strings later,
 * maybe.  (Maybe, since GetStackPointer may do fine for genuine strings.)
 */
void GetStackString(/*var*/ st)
    char **st;
{
    int s;

    bcopy(gtos, st, s = sizeof(char *));
    gtos += s;
}

/*
 * Get a stack pointer, whatever it is.  This works for actual pointers, var
 * parms, open array parms, and (in future) genuine strings.
 */
void GetStackPointer(p)
    char **p;
{
    int s;

    bcopy(gtos, p, s = sizeof(char *));
    gtos += s;
}

void InitGetTos()
{
    gtos = StackAddr(0);
}


/*
 * The following type check functions perform the special-purpose type checking
 * for each of the built-ins above that's a special proc.  Doing it this way,
 * we can preload each of these functions in the symtab entry for each special
 * proc, which will make life easier for the type checker.  See, in particular,
 * chkSpecialProc in typechk.c
 */


/*
 * Type check the built-in high function, with signature:
 *
 *	special procedure high(ident i: array of any);
 * 
 * In words, high can only be called with a single ident of type open array.
 */
TypeStruct Chk_high_(p, actuals)
    SymtabEntry *p;
    nodep actuals;
{
    TypeStruct t;
    nodep a;
    SymtabEntry *sym;

    /*
     * Require exactly one actual.
     */
    if ((not actuals) or (actuals->components.exprlist.next)){
	lerror(actuals, "Built-in procedure high requires exactly one parameter.\n");
	return null;
    }

    /*
     * Require type of actual to be open array.
     */
    a = actuals->components.exprlist.expr;
    if ((a->header.kind == ATOM_NODE) and (a->header.name == Yident) and
	    (a->components.atom.next == null)) {
	sym = Lookup(a->components.atom.val.text);
    }
    else {
	lerror(a, "Built-in procedure high requires parameter of type open arry.\n");
	return null;
    }

    if (sym and (sym->Class == C_Parm) and ChkSymFlag(sym, arrayParm)) {
	return CardType;
    }
    else {
	lerror(a, "Built-in procedure high requires parameter of type open array.\n");
	return null;
    }
}

TypeStruct Chk_incl_() {}
TypeStruct Chk_inc_() {}
TypeStruct Chk_float_() {}
TypeStruct Chk_min_() {}

TypeStruct Chk_ord_(p, actuals)
    SymtabEntry *p;
    nodep actuals;
{
    TypeStruct t;

    t = chkExpr(actuals->components.exprlist.expr, true, null);
    if (isSubrangeable(t))
	return CardType;
    else {
	lerror(t, "Pararmeter to ord must be enum, char, int, or card.\n");
	return null;
    }
}


TypeStruct Chk_val_() {}
TypeStruct Chk_odd_() {}
TypeStruct Chk_size_() {}

/*
 * Ensure that there is only one actual, and it is an lvalue of type pointer to
 * something.
 */
TypeStruct Chk_new_(p, actuals)
    SymtabEntry *p;
    nodep actuals;
{
    nodep a;
    TypeStruct t;

    if (not isLVal(a = actuals->components.exprlist.expr, false)) {
	t = null;
	/* As noted elsewhere, isLVal outputs its own messsage, q.v. */
    }
    else {
        t = chkExpr(a, true, null);
    }
    if (actuals->components.exprlist.next) {
	lerror(t, "Procedure new requires exactly one argument.\n");
	t = null;
    }
    return t;
}

TypeStruct Chk_abs_(SymtabEntry* sym, nodep actuals) {
    TypeStruct t = ResolveIdentType(chkExpr(actuals, true, null),
	actuals, true);
    if (compat(RealType, t)) {
	return RealType;
    }
    else {
	lerror(actuals, "Type of argument to abs function must be real.\n");
	return null;
    }
}
TypeStruct Chk_excl_() {return BoolType;}
TypeStruct Chk_dec_() {return IntType;}
TypeStruct Chk_cap_() {return IntType;}
TypeStruct Chk_chr_() {return StringType;}
TypeStruct Chk_max_() {return RealType;}
TypeStruct Chk_sqrt_() {return RealType;}
TypeStruct Chk_trunc_() {return IntType;}
TypeStruct Chk_halt_() {return NilType;}
TypeStruct ChkSymFroc() {return NilType;}

TypeStruct Chk_print_(SymtabEntry* sym, nodep actuals) {
    TypeStruct t = ResolveIdentType(chkExpr(actuals, true, null),
	actuals, true);

    if (actuals->components.exprlist.next != null) {
	lerror(actuals, "Print function is only allowed one argument.\n");
	return null;
    }

    return t;
}

/*
 * Non-standard built-ins (i.e., not per Klaus).
 */
ValueStruct quit_(t)
    nodep t;
{
    printf("Exiting.\n");
    exit(0);
}

TypeStruct Chk_quit_() {}


#ifdef DEMO
/*
 * A la GetStackXXX in built-ins.c.
 */
void GetStackSelection(s) 
    char** s;
{
    int size;

    bcopy(gtos, s, size = sizeof(Selection));
    gtos += size;
}

/*
 * What the "safe" GetStackSelection should look like:
 *
 *
GetStackSelection(Selection* s) {
    GetStackGraphic(s->picture);
    GetStackString(s->stype);
    GetStackGestureMapPtr(s->map);
    GetStackInteger(s->x);
    GetStackInteger(s->y);
    GetStackSet(s->flags);
}
 *
 */
#endif