//==============================================================================
// function interfaces, .evaluate(), .execute()
//==============================================================================
unit Prototypes;

//==============================================================================
//  INTERFACE
//==============================================================================
interface
uses JType, JStruct, JFunction, StringHash;

function TryGetTypeOf(const s:string):Tvtype;

procedure InitFunctionPrototypes;
procedure CleanFunctionPrototypes;
function GetFunctionPrototype( args:array of string; argn:integer; returntype:string):integer;

function AddFunctionData(const name:string; const protid:integer; const decl:integer):Tfunction;

function translateMethodOfFunction(const f:string; const fid:integer; const memb:string; const args:string; var res:string; var typ:Tvtype):boolean;
function translateMemberOfFunction(const f:string; const fid:integer; const memb:string; var res:string; var typ:Tvtype):boolean;
function translateMethodOfFunctionPointer(const f:string; const st:tstruct; const memb:string; const args:string; var res:string; var typ:Tvtype):boolean;
function translateMemberOfFunctionInterface(const f:string; const st:tstruct; const memb:string; var res:string; var typ:Tvtype):boolean;

procedure MakeFunctionCallers(var output:string);
procedure NormalizeFunctionArguments;
procedure buildFunctionActions(var output:string);
procedure buildIniFunctionActions(var output:string);

// TODO: make variables private
var
   badHandleHash:TstringHash;

   Prototype: Array of Tfunctionprototype;
   ProtoHash: Tstringhash;
   PrototypeN: integer=0;

   FunctionData: Array of Tfunction;
   FunctionDataN: integer=0;
   FunctionHash: Tstringhash;
   FunctionDataUsed: boolean = false;

   RecCurrentLine : integer =0;

//==============================================================================
//  IMPLEMENTATION
//==============================================================================
implementation
uses JHInput, TextOnly, TextCommon, JASSerException, SysUtils;

//==============================================================================
function TryGetTypeOf(const s:string):Tvtype;
begin
    Result:=MakeType(LocalIdentifierTypes.ValueOf(s) );
    if(Result.id=-1) then Result:=MakeType(IdentifierTypes.ValueOf(s) );
    if(Result.id=-2) then Result:=MakeType(-1 );
end;

//==============================================================================
procedure InitFunctionPrototypes;
begin
    FunctionDataUsed:=false;
    FunctionHash:=TStringHash.Create;
    ProtoHash:=Tstringhash.Create;
    PrototypeN:=0;
    FunctionDataN:=0;
end;

//==============================================================================
procedure CleanFunctionPrototypes;
var i:integer;
begin
    FunctionDataUsed:=false;
    FunctionHash.Free;
    ProtoHash.Free;

    for i := 1 to prototypeN do Prototype[i].Free;
    for i := 1 to FunctionDataN do FunctionData[i].Free;

    PrototypeN:=0;
    FunctionDataN:=0;    
end;

//==============================================================================
function GetFunctionPrototype( args:array of string; argn:integer; returntype:string):integer;
var protk:string;
    k,i:integer;
    nargs: array of string;
begin

    //normalize:
    SetLength(nargs, Length(args) );
    for i := 0 to argn - 1 do
        if (StructHash.ValueOf(args[i])<>-1) then
            nargs[i]:='integer'
        else
            nargs[i]:=args[i];
    if(StructHash.ValueOf(returntype) <> -1) then
        returntype:='integer';

    ConcatenateManySep(protk,nargs,argn,',');
    protk:=protk+'#'+returntype;

    k:=ProtoHash.ValueOf(protk);
    if (k<>-1) then begin result:=k; exit; end;

    PrototypeN:=PrototypeN+1;
    if (Length(Prototype)<=PrototypeN) then
        SetLength(Prototype,PrototypeN+1+ (PrototypeN div 5) );

    k:=PrototypeN;

    Prototype[k]:= Tfunctionprototype.Create(args,argn,returntype);
    ProtoHash.Add(protk,k);

    Result:=k;
end;

//==============================================================================
function AddFunctionData(const name:string; const protid:integer; const decl:integer):Tfunction;
begin
    FunctionDataN:=FunctionDataN+1;
    if (Length(FunctionData)<=FunctionDataN) then SetLength(FunctionData,FunctionDataN+1+FunctionDataN div 5);
    Result:=Tfunction.Create;
    Result.PrototypeId:=protid;
    Result.decl:=decl;
    Result.name:=name;
    FunctionData[FunctionDataN]:=Result;

    Functionhash.Add(name,FunctionDataN);
end;



//==============================================================================
//  call f.method(args) -> call sc___prototypeNum_method(args)
//==============================================================================
function translateMethodOfFunction(const f:string; const fid:integer; const memb:string; const args:string; var res:string; var typ:Tvtype):boolean;
var
   fun:Tfunction;
   h,k:integer;
begin
    if ((memb<>'execute') and (memb<>'evaluate')  and (memb<>'name') ) then begin
         res:=memb+' is not a valid method for function objects. (Expected .execute or .evaluate)';
         Result:=false;
         exit;
    end;
    fun:=FunctionData[fid];
    k:=fun.PrototypeId;
    h:= Prototype[k].GetId(f);

    if(memb='name') then begin
        if(args<>'') then begin
            result:=false;
            res:='name() takes no arguments.';
            exit;
        end;
        result:=true;
        res:='"'+fun.name+'"';
        typ:=MakeType(-1);
        exit;
    end else if(args<>'') then
        res:='sc___prototype'+IntToStr(k)+'_'+memb+'('+IntToStr(h)+','+args+')'
    else
        res:='sc___prototype'+IntToStr(k)+'_'+memb+'('+IntToStr(h)+')';
    typ:=TryGetTypeOf(f);
    fun.abuse:=true;
    prototype[k].abuse:=true;
    result:=true;    FunctionDataUsed:=true;
end;

//==============================================================================
function translateMemberOfFunction(const f:string; const fid:integer; const memb:string; var res:string; var typ:Tvtype):boolean;
var
   fun:Tfunction;
   k,h:integer;
begin
    if (memb<>'_pointer') and (memb<>'name') then begin
         res:=memb+' is not a valid member for function objects. (Expected: .code or .name)';
         Result:=false;
         exit;
    end;
    fun:=FunctionData[fid];
    if(memb='name') then begin
         result:=true;
         res:='"'+fun.name+'"';
         typ:=MakeType(-1);
         exit;
    end;
    k:=fun.PrototypeId;
    h:= Prototype[k].GetId(f);

    typ:=MakeType(-1);
    fun.abuse:=true;
    prototype[k].abuse:=true;
    res:='('+IntToStr(h)+')';
    result:=true;
    FunctionDataUsed:=true;
end;

//==============================================================================
function translateMethodOfFunctionPointer(const f:string; const st:Tstruct; const memb:string; const args:string; var res:string; var typ:Tvtype):boolean;
var
   k:integer;
begin
    if ((memb<>'execute') and (memb<>'evaluate')) then begin
         res:=memb+' is not a valid method for function objects. (Expected .execute or .evaluate)';
         Result:=false;
         exit;
    end;
    if (f=st.name) then begin
         res:='Function interface validation of methods is not supported.';
         Result:=false;
         exit;
    end;


    k:=st.FunctionInterfacePrototype;


    if(args<>'') then
        res:='sc___prototype'+IntToStr(k)+'_'+memb+'('+f+','+args+')'
    else
        res:='sc___prototype'+IntToStr(k)+'_'+memb+'('+f+')';
    typ:=TryGetTypeOf(f);

    prototype[k].abuse:=true;
    result:=true;    FunctionDataUsed:=true;
end;

//==============================================================================
function translateMemberOfFunctionInterface(const f:string; const st:tstruct; const memb:string; var res:string; var typ:Tvtype):boolean;
var
   k,h:integer;
begin
    if (f<>st.name) then begin
         res:='Function interface "'+st.name+'" does not have instance variables.';
         Result:=false;
         exit;
    end;

    k:=FunctionHash.ValueOf(memb);
    if(k=-1) then  begin
         res:='Unable to find function '+memb+' in the map''s script.';
         Result:=false;
         exit;
    end;

    h:=FunctionData[k].PrototypeId;
    if(h<>st.FunctionInterfacePrototype) then begin
         res:='Signature (arguments/return types) of function "'+memb+'" does not match the one defined for: "'+f+'"';
         Result:=false;
         exit;
    end;
    FunctionData[k].abuse:=true;
    Prototype[h].abuse:=true;

    typ:=TryGetTypeOf(f);
    res:='('+IntToStr(Prototype[h].GetId(memb))+')';
    Result:=true;    FunctionDataUsed:=true;




end;

//==============================================================================
procedure MakeFunctionCallers(var output:string);
var i,j,k,c:integer;
    prot:Tfunctionprototype;
    tem,tem2,tem3:string;
    assigns:string;
    return:string;
begin



    //Make prototype callers...
    for i := 1 to PrototypeN do if(prototype[i].abuse) then begin

        prot:=prototype[i];
        assigns:='';
        for j := 0 to prot.argn-1 do begin
            c:=1;
            for k := 0 to j-1 do begin
                if(prot.args[k]=prot.args[j]) then c:=c+1;
            end;

            Concatenate5(tem,'    set f__arg_',prot.args[j],IntToStr(c),'=a',IntToStr(j+1));
            SWriteLn(assigns,tem);

        end;

        return:='';
        if(prot.res<>'nothing') then begin
            return:=' return f__result_'+prot.res;
        end;

       //execute:
        prot:=prototype[i];
        Concatenate3(tem2,'function sc___prototype',IntToStr(i),'_execute takes ');

        tem3:='integer i';
        for j := 0 to prot.argn-1 do begin
            Concatenate4(tem,',',prot.args[j],' a',IntToStr(j+1));
            Swrite(tem3,tem);
        end;
        Concatenate3(tem,tem2,tem3,' returns nothing');

        SWriteLn(output,tem);
        SWriteLn(output,assigns);

        Concatenate3(tem,'    call TriggerExecute(st___prototype',IntToStr(i),'[i])');
        SWriteLn(output,tem);

        //Execute doesn't have a return value.. SWriteLn(output,return);

        SWriteLn(output,'endfunction');

       //evaluate:
        prot:=prototype[i];
        Concatenate3(tem2,'function sc___prototype',IntToStr(i),'_evaluate takes ');

        tem3:='integer i';
        for j := 0 to prot.argn-1 do begin
            Concatenate4(tem,',',prot.args[j],' a',IntToStr(j+1));
            Swrite(tem3,tem);
        end;
        Concatenate4(tem,tem2,tem3,' returns ',prot.res);

        SWriteLn(output,tem);
        SWriteLn(output,assigns);

        Concatenate3(tem,'    call TriggerEvaluate(st___prototype',IntToStr(i),'[i])');
        SWriteLn(output,tem);

        SWriteLn(output,return);


        SWriteLn(output,'endfunction');


    end;

end;

//==============================================================================
procedure NormalizeFunctionArguments;
var i,j:integer;
begin


    for i := 1 to PrototypeN do if(prototype[i].abuse) then begin

       for j := 0 to prototype[i].argn-1 do begin
           if(Structhash.ValueOf(prototype[i].args[j])<>-1 ) then prototype[i].args[j]:='integer';
       end;

       if(Structhash.ValueOf(prototype[i].res)<>-1) then prototype[i].res:='integer';
    end;
end;


//==============================================================================
procedure generateFakeFunctionLocals(const fun:Tfunction; var output:string; var funcall:string; var usecall:boolean);
var word:string;
    name,typ,tem:string;

    k,c,i:integer;
    a:integer;
    s:string;

    prot:Tfunctionprototype;

begin
    usecall:=false;
    funcall:=fun.name+'(';
    s:=JHInput.Get(fun.decl);

    //¿constant? function
    //yes I think we should support constant functions here huh?

    GetLineWord(s,word,k);
    if (word='constant') then GetLineWord(s,word,k,k);

    if(word<>'function') then raise JasserLineException(fun.decl,'internal error (not a function???');

    GetLineWord(s,name,k,k);


    if (not compareLineWord('takes',s,k,k)) then raise JasserLineException(fun.decl,'Expected: "takes"');

    GetLineWord(s,typ,k,k);
    a:=0;
    prot:=Prototype[fun.PrototypeId];

    if (typ<>'nothing') then begin
         //word holds first type

         repeat
            typ:=prot.args[a];
            GetLineToken(s,name,k,k);
            //typ and name.

            c:=1;
            if(a>prot.argn) then raise Exception.Create('Very strange internal error');
            for i := 0 to a-1 do begin
                if(prot.args[i]=typ) then c:=c+1;
            end;
            a:=a+1;
            Concatenate7(tem,' local ',typ,' ',name,'=f__arg_',typ,IntToStr(c));
            SWriteLn(output,tem);

            if(a=1) then begin
                concatenate4(tem,funcall,'f__arg_',typ,IntToStr(c));
                funcall:=tem;
            end else begin
                concatenate4(tem,funcall,',f__arg_',typ,IntToStr(c));
                funcall:=tem;
            end;

            if(badHandleHash.ValueOf(typ)=1) then usecall:=true;

            GetLineToken(s,typ,k,k);
            if(typ='returns') then break;
            if(typ='') then raise JasserLineException(fun.decl,'Expected: "returns"');
         until (typ='returns');

    end else if (not compareLineWord('returns',s,k,k)) then raise JasserLineException(fun.decl,'Expected: "returns"');
    funcall:=funcall+')';
//done!
end;


//==============================================================================
//  writes out function prototypes based on function definitions
//==============================================================================
procedure buildFunctionActions(var output:string);
var i,j,e:integer;
    tem,t2,locals,funcall:string;
    doret,docall:boolean;

    fun:Tfunction;

begin
    //SWDebug(true);
    for i := 1 to FunctionDataN do if(FunctionData[i].abuse) then begin
        fun:=FunctionData[i];
        j:=fun.decl;
        Concatenate5(tem,'function sa___prototype',IntToStr(fun.PrototypeId),'_',fun.name,' takes nothing returns boolean');
        SWriteLn(output,tem);
        locals:='';
        funcall:='';
        generateFakeFunctionLocals(fun,locals,funcall,docall);
        doret:=false;

      if(docall) then begin
        tem:=prototype[fun.PrototypeId].res;
        if(tem='nothing') then begin
            SWriteLn(output,'    call '+funcall);
        end else begin
            SWriteLn(output,'    set f__result_'+tem+'='+funcall);
        end;

      end else begin
        SWriteLn(output,locals);
        j:=j+1;
        while(j<=inputN) do
        begin
            if( CompareLineWord('endfunction',JHInput.Get(j),e)) then break;

            if(doret) then begin
                SWriteLn(output,'    return true');
                doret:=false;
            end;
            if IsWhitespace(JHInput.Get(j)) then
               // do nothing
            else if(CompareLineToken('return',JHInput.Get(j),e)) then begin
                if(Prototype[fun.PrototypeId].res<>'nothing') then begin
                    t2:=Copy(JHInput.Get(j),e,Length(JHInput.Get(j)));
                    if(IsWhitespace(t2)) then raise JasserLineException(j,'Expected: return value');
                    Concatenate4(tem,'    set f__result_',Prototype[fun.PrototypeId].res,'=', t2 );
                    SWriteLn(output,tem);
                    doret:=true;

                end else begin
                    t2:=Copy(JHInput.Get(j),e,Length(JHInput.Get(j)));
                    if(not IsWhitespace(t2)) then raise JasserLineException(j,'Unexpected: return value');
                    doret:=true;

                end;
            end else begin
               SWriteLn(output,JHInput.Get(j));
            end;
            j:=j+1;

        end;
      end;
        SWriteLn(output,'    return true');  // TODO: change to return false
        SWriteLn(output,'endfunction');
    end;
    //SWDebug(false);
end;

//==============================================================================
//  populate trigger arrays with function prototypes.
//  this is done inside jasshelper__init.
//==============================================================================
procedure buildIniFunctionActions(var output:string);
var i:integer;
    tem,ids,xids,trig:string;

    fun:Tfunction;
begin


    for i := 1 to FunctionDataN do if(FunctionData[i].abuse) then begin
        fun:=FunctionData[i];

        ids:=IntToStr(fun.PrototypeId);
        xids:=IntToStr( Prototype[fun.PrototypeId].GetId(fun.name));
        Concatenate5(trig,'st___prototype',ids,'[',xids,']');


        Concatenate3(tem,'    set ',trig,'=CreateTrigger()');
        SWriteLn(output,tem);

        Concatenate7(tem,'    call TriggerAddAction(',trig,',function sa___prototype',ids,'_',fun.name,')');
        SWriteLn(output,tem);

        Concatenate7(tem,'    call TriggerAddCondition(',trig,',Condition(function sa___prototype',ids,'_',fun.name,'))');
        SWriteLn(output,tem);
    end;
end;

end.
