/* Copyright Per Bothner 1987. Read the file Q-INFO */
#include <stdio.h>
#include <types.h>
//#include <hash.h>
#include <exceptions.h>
#include <procs.h>
#include <parsefile.h>
#include <newtype.h>
#include <methods.h>
#include <stdlib.h>
#include "builtin-syms.h"
extern struct Declaration *Symbol2Declaration();
extern struct Identifier *NewIdentifier();
extern Expr *ParseOne(), *ParseLook();
extern CompilePatchCall();
/*extern struct Type ProcExpr, PostfixProc, PrefixProc,
	Identifier, Variable, UnifyExpr, Macro, Block; */
extern int ExplicitUnify;
extern char * ConcatStrs(char *str0, ...);

struct ParamExpr *
AddParam(struct ParseFile *ff, struct ProcExpr *fnc, int side, Expr *arg)
{
    struct ParamExpr *param; int keyword = 0;
    param = GC_NEW ParamExpr;
    param->next = fnc->argList;
//    param->param_kind = 0;
    param->flags = 0;
    param->name = 0;
    if (arg->code() == MapPair_code) {
	MapPairExpr *bind = (MapPairExpr*)arg;
        param->name = bind->label();
	arg = bind->value().E;
	fnc->flags |= ProcHasNamedParams;
	param->flags |= FormalKeyword;
	side = 2;
	/* free(bind); */
    }
    else {
	if (fnc->flags & ProcHasNamedParams)
	    ParseError(ff, "Positional parameter follows keywords");
	if (ExprCodeOf(arg) == MakeTuple_code) {
	    arg = ((struct ExprStdOp*)arg)->arg[0].E;
	    param->flags |= FormalMultipleVector;
	    if (fnc->pn[side].tuple)
		ParseError(ff, "Only one REST@ parameter allowed");
	    else fnc->pn[side].tuple = 1;
	    param->default_expr = NULL;
	    goto finish;
	}
    }
    if (arg->code() == UnifyExpr_code) {
	struct UnifyExpr *unify = (struct UnifyExpr*)arg;
	switch (unify->set) {
	  case 0:
	    param->default_expr = unify->right.E;
	    arg = unify->left.E;
	    break;
	  case 2: /* := */
	    param->default_expr = unify->right.E;
	    arg = unify->left.E;
/*	    keyword = 1; */
	    break;
	  default:
	    ParseError(ff, "Bad parameter expr");
	}
	fnc->pn[side].optional++;
    }
    else {
	param->default_expr = NULL;
	fnc->pn[side].required++;
    }
  finish:
    if (arg->code() == Unquote_code) {
	arg = ((UnquoteExpr*)arg)->arg.E;
	param->flags |= FormalDontEvaluate;
	fnc->flags |= ProcDontEvaluateArgs;
    }
    param->arg_type = NULL;
    param->arg_expr.E = arg;
    fnc->argList = param;
    fnc->nParams++;
    ff->identifiers = NULL;
    if ((param->flags & FormalMultiple) && param->default_expr)
	ParseError(ff, "A multiple argument cannot have a default value");
    return param;
}

void InitClause(struct Clause *clause, struct ProcExpr *proc)
{   int i;
    proc->clause = clause;
    clause->paramDesc = NULL;
    clause->result = NULL;
    clause->self = NULL;
    clause->resultType = NULL;
    clause->nParams = proc->nParams;
    clause->flags = ClauseHasNotBeenTraversed;
    if (proc->flags & ProcDontEvaluateArgs)
	clause->flags |= ClauseDontEvaluateArgs;
    clause->procexpr(proc);
    clause->minParams = 0;
    for (ParamExpr *arg = proc->argList; arg; arg = arg->next)
      {
	if (arg->default_expr == NULL) clause->minParams++;
      }
    for (i = 3; --i >= 0; )
	clause->pn[i] = proc->pn[i];
    clause->code = NULL;
    clause->expr = proc;
    clause->keywords = NULL;
}

#if 0
struct ExprStdOp * CoerceBlockResult(struct Block *block, Expr *coercion)
{
    extern struct ExprStdOp *AllocStdOp();
    struct Statement *st;
    struct ExprStdOp *coerce = AllocStdOp(Coerce_code, 2);
    /* this stuff is rather gross ... */
    for (st = block->first; st->next != NULL; st = st->next) { }
    coerce->arg[0].E = st->src.E;
    coerce->arg[1].E = coercion;
    st->src = coerce;
    return coerce;
}
#endif

void BindClause(struct ProcExpr *proc)
/* this is done at parse time for lambda expressions.
   For possibly-overloaded methods, BlockScan does the equivalent */
{
    struct Function *func = AllocFunction(&LAMBDA_sym);
    struct Clause *clause =
	(struct Clause*)GC_malloc(func->nClauses * sizeof(struct Clause));
    proc->type = MakeExType(ExMethodPtr, func);
    func->clauses = clause;
    func->nParams = proc->nParams;
    InitClause(clause, proc);
    if (clause->flags & ClauseDontEvaluateArgs)
	func->flags |= FuncDontEvaluateArgs;
    func->nKeywords = 0; func->keywords = NULL; func->keywordHash = NULL;
    proc->function() = func;
}

struct ProcExpr *
ParseFunctionPattern(struct ParseFile *ff, Symbol **pname, int isClassDef)
{
    int i; Expr *ex;
    Symbol * fname = NULL;
    register struct ProcExpr *fnc;
    int have_left_arg = 0;
    struct Block *block;
    struct BlockSave save[1];
    unsigned char saveTerminators = ff->terminators;
    ff->terminators = ParseInParamList;
    DeclListMark savedDecls = ff->unclaimed_decls.mark();
    struct Declaration *firstArg = NULL;
    struct ParamExpr *cur_arg, *prev_arg;
    struct ProcExpr *save_cur_proc = ff->cur_proc;
    struct Location loc;
    int side = 0; /* start out with left parameters */
    int ch;
    DeclList dlist;

    TestPushBlock(save, ff);
    ff->block = block = GC_NEW Block(ff->saveBlock);
    block->flags |= BlockIsReturnable;

    loc = SourceLocation(ff);
    fnc = GC_NEW ProcExpr(block);
    ff->cur_proc = fnc;
    fnc->fname = NULL;

    for (;;) { /* for each formal parameter */
	int paramNum;
	Expr *prm = ParseLook(ff, WRDprio);
	if (IsNullExpr(prm)) break;
	if (ExprCodeOf(prm) == Identifier_code &&
	   !(prm->flags & IdentExplicit)) {
	    Identifier *id = (Identifier*)prm;
	    if (fname != NULL) {
		ParseError(ff,
	       "Multi-part function name ':(... %s ... %s ...)' not supported",
			   fname->string(),
			   id->name->string());
		if (strcmp(fname->string(), "macro") == 0)
		    ParseError(ff,
			      "You probably want to say ':(macro ... %s ...)'",
			       id->name->string());
	    }
	    else if (id->symbol()->length() == 5
		&& strcmp(id->symbol()->string(), "macro") == 0
		&& !(fnc->flags & ProcIsMacro)
		&& fnc->nParams == 0) {
		fnc->flags |= ProcIsMacro;
	    }
	    else {
		fname = id->name;
		fnc->fname = fname;
		block->globalName =
		    ConcatStrs(block->enclosing->globalName,
			       "_",
			       fname->string(),
			       NULL);
		*pname = fname;
		ff->identifiers = NULL;
		side = 1;
	    }
	}
	else { // A real formal parameter.
	    paramNum = fnc->nParams;
	    if (!fname)
		have_left_arg = 1;
	    else if (!have_left_arg) {
		fnc->flags |= ProcPrefix;
		paramNum++;
	    }
	    ParamExpr *pexp = AddParam(ff, fnc, side, prm);
	    ch = ff->get();
	    if (ch == '=') {
		Expr *default_expr = ParseLook(ff, WRDprio);
		if (!IsNullExpr(default_expr)) {
		    pexp->default_expr = default_expr;
		    fnc->pn[side].optional++;
		    fnc->pn[side].required--;
		}
	    }
	    else if (ch != EOF)
		ff->putback(ch);
	}
    }

  /* reverse order of argList */
    for (prev_arg = NULL, cur_arg = fnc->argList; cur_arg != NULL; ) {
	struct ParamExpr *next_arg = cur_arg->next;
	cur_arg->next = prev_arg;
	prev_arg = cur_arg;
	cur_arg = next_arg;
    }
    fnc->argList = prev_arg;

    ch = ff->get();
    if (ch != ')') {
	ParseError(ff, "Bad procedure header");
	fnc = (struct ProcExpr*)FailedParse;
	ff->terminators = saveTerminators;
	goto fail;
    }
    ch = ScanBlanks(ff);
    if (ch != '~')
        fnc->resultType.E = NULL;
    else {
	fnc->resultType.E = ParseLook(ff, ONEprio); //ParseOne(ff, 8<<4);
	ch = ScanBlanks(ff);
    }
    ff->terminators = saveTerminators;

    dlist.grab_from(ff->unclaimed_decls, savedDecls);
    fnc->paramDecls = dlist.first;

    // Look for external keyword.
    if (ch == 'e') {
	ff->putback(ch);
	Symbol *id = GetName(ff);
	if (id == &external_sym) {
	    extern Root *ParseExternName(struct ParseFile *ff);
	    fnc->code_label = ParseExternName(ff);
	    ch = ScanBlanks(ff);
	}
    }
    if (ch != '=') {
	ParseError(ff, "Bad procedure header - missing '='");
	fnc = (struct ProcExpr*)FailedParse;
	goto fail;
    }  
    ex = ParseOne(ff, EOLprio);
    if ((Block*)ex != block)
	ParseError(ff, "ParseRule confusion: ex=#%X != block=#%X", ex, block);
    if (isClassDef)
	block->flags |= BlockReturnSelf;
    if (fnc->resultType.E != NULL)
#if 1
	block->coercion = fnc->resultType.E;
#else
	CoerceBlockResult(block, fnc->resultType.E);
#endif
/*  if (fname != NULL) CheckSpecialProc(fnc, ff, fname); */
    if ((fnc->flags & ProcIsExternal) && ff->saveBlock->enclosing != NULL)
	AllocContext(fnc);
    TestPopBlock(save);
/*    AppendStatement(block, ex); */
/*    fnc->procDesc = NULL; */
    fnc->set_location(loc);

    block->decls.grab_from(ff->unclaimed_decls, savedDecls);
  fail:
    if (fname == NULL) BindClause(fnc);
    ff->cur_proc = save_cur_proc;
    return fnc;
}

#if 0
ProcDesc *
AllocSimpleProcDesc(Object param, int bits)
  { register ProcDesc *pd = (ProcDesc*)Alloc(&TProcDesc, sizeof(ProcDesc));
    pd->type = 0;
    pd->bits = bits;
    pd->nParams = 1;
    pd->trailParams = 0;
    pd->parm[0].name = NULL;
    pd->parm[0].type = (Object)PlainValue;
    pd->parm[0].pattern_expr = param;
    return pd;
  }
#endif

#if 0
struct ProcExpr *
MakePostfixLambda(arg, body, ff)
    struct Declaration *arg; Expr *body;
    struct ParseFile *ff;
  {
    struct Block *block = GC_NEW Block(ff->block ? ff->block : ff->saveBlock);
    struct ProcExpr *proc = GC_NEW ProcExpr(block);
/*  proc->procDesc = NULL; */
    AppendStatement(block, LinkParam(proc, 0, Decl2Ident(arg)));
    AppendStatement(block, body);
    return proc;
  }
#endif

#if 0
struct M68kProcStub {
    u_short go;
    Func code;
    u_short ret;
};

struct ProcExpr *
Proc2ProcExpr(code)
    struct M68kProcStub *code;
{
    if ((code->go == _JMP && code->ret == 0)
     || (code->go == _JSR && (AnyPtr)code->code == (AnyPtr)CompilePatchCall))
	return (struct ProcExpr*)(code+1) - 1;
    return 0;
}
#endif

#if 0
CompilePatchCall(dummy)
{
#if 1
    abort();
#else
#ifdef MC68000
  /* point to the return link of this call */
    register char **ReturnLinkPtr = (char**)((char*)&dummy - 4);
#else
    ???
#endif
    register struct ProcExpr *expr = (struct ProcExpr*)
	(*ReturnLinkPtr - (char*)&((struct ProcExpr*)0)->ret);
    extern Func BadCompileForEval;
    register Func proc = CompileProcForEval(expr);
    if (proc == BadCompileForEval) {
	fprintf(stderr, "Failed to compile procedure #%x\n", expr);
	return NoValue;
    }
    expr->go = _JMP;
    expr->code = proc;
    expr->ret = 0;
    /* patch our return address, so that we immediately execute proc */
    *ReturnLinkPtr = (char*)proc;
#endif
}
#endif
