unit Structs01;

//==============================================================================
//  INTERFACE
//==============================================================================
interface

procedure Step01;

//==============================================================================
//  IMPLEMENTATION
//==============================================================================
implementation
uses StructVariables, Translate, TextOnly, Constants, JStruct, JASSERException,
    Member, SysUtils, JassHelperConfigFile;

//==============================================================================
procedure DoStructTopSort;
var
    n,t,i:integer;
    q:array of integer;
    p:array of integer;
    added:array of boolean;
    reduced:boolean;
    info:string;
begin
    n:=StructN;
    if(n=0) then exit;
    SetLength(TopSortedStructList, n+2);
    SetLength(q, n+2);
    SetLength(p, n+2);
    SetLength(added, n+2);

    for i := 1 to n do begin
        q[i]:=i;
        p[i]:=StructList[i].parentstruct;
        if(p[i]=-1) then p[i]:=StructList[i].parent;
        added[i]:=false;
    end;

    t:=0;
    while (n>0) do begin
        i:=1;
        reduced:=false;

        while (i<=n) do begin
            if ((p[i]=-1) or  added[p[i]]) then begin
                t:=t+1;
                TopSortedStructList[t]:=q[i];
                added[q[i]]:=true;
                q[i]:=q[n];
                p[i]:=p[n];
                n:=n-1;
                reduced:=true;
           end else begin
                i:=i+1;
           end;
        end;
        if(not reduced) then begin
            info:='';
            if(n>5) then  n:=5;
            info:=StructList[q[1]].name;
            for i := 2 to n do info:=info+', '+StructList[q[i]].name;

            raise JasserLineDoubleException(structList[q[1]].decl,'Found an "extends" cycle',structList[q[1]].decl, '\--- Involved structs: '+info);
        end;
    end;
end;

//==============================================================================
procedure DoDelegateCycleVerification;
var
    visited:array of boolean;
    finished:array of boolean;
    i:integer;

    procedure dfs(p:integer);
     var j,h:integer;
    begin
        if(visited[p]) then begin
            if(not finished[p]) then
               raise JasserLineException(StructList[p].decl,'Found delegate cycle related with: '+StructList[p].name);
            exit;
        end;
        visited[p]:=true;
        for j := 0 to StructList[p].delegateN-1 do begin
            h:=StructHash.ValueOf(StructList[p].delegates[j].returntype);
            if(h<>-1) then dfs(h);
        end;
        h:=StructList[p].parent;
        if(h<>-1) then dfs(h);
        h:=StructList[p].parentstruct;
        if(h<>-1) then dfs(h);
        finished[p]:=true;

    end;

begin
    SetLength(visited,StructN+1);
    SetLength(finished,StructN+1);
    for i := 1 to StructN do begin
        visited[i]:=false;
        finished[i]:=false;
    end;
    for i := 1 to StructN do if(not visited[i]) then begin
        dfs(i);
    end;              

end;

//==============================================================================
function compareArrays(var A:Tdynamicstringarray; const an:integer; var B:Tdynamicstringarray; const bn:integer):boolean;
var i:integer;
begin
    Result:=true;
    if(an<>bn) then Result:=false
    else begin
        i:=0;
        while(i<an) do begin
            if(A[i]<>B[i]) then begin
                Result:=false;
                exit;
            end;
            i:=i+1;
        end;

    end;

end;

//==============================================================================
procedure CompareStructInterfaceMembers(var st:Tstruct; var stmemb:Tmember; var inter:Tstruct; var itmemb:Tmember);
var tem:string;
begin
    if(stmemb.destruct) or (itmemb.destruct) or (stmemb.construct) or (itmemb.construct)  then exit;

    if(itmemb.ismethod) then begin
       //sure a member with that name 'exists' but is that enough?
       if(not stmemb.ismethod) then begin
           raise JASSerLineDoubleException(st.decl,stmemb.name+' should be a method.',itmemb.decl,'`--- interface declaration here');
       end;

       if(stmemb.returntype<>itmemb.returntype)
           or not(  ((stmemb.name='_lessthan') and ( stmemb.argnumber=1) and (stmemb.argtypes[0]=st.name))
                     or compareArrays(Tdynamicstringarray(stmemb.argtypes),stmemb.argnumber, Tdynamicstringarray(itmemb.argtypes), itmemb.argnumber )
                  )
          or (stmemb.isstatic) then begin
             raise JASSerLineDoubleException(stmemb.decl,stmemb.name+' signatures don''t match.',itmemb.decl,'`--- interface declaration here');
       end;
       stmemb.fromparent:=true;
       stmemb.abuse:=true;

    end else begin
        if(stmemb.ismethod) then raise JASSerLineDoubleException(stmemb.decl,stmemb.name+' already used as member of parent interface.',itmemb.decl,'\--- interface declaration here');
        if(stmemb.returntype <> itmemb.returntype) then  raise JASSerLineDoubleException(stmemb.decl,stmemb.name+' type mismatch with parent interface.',itmemb.decl,'`--- interface declaration here');
        tem:=stmemb.oninit_value;
        st.DropMember(stmemb.name);
        stmemb.oninit_struct:=inter.name;
        stmemb.oninit_value:=tem;
    end;
end;

//==============================================================================
procedure ChildStructMemberCheck(var st:Tstruct);
var
   pids: array of integer;
   pn,pni,k,i:integer;
   memb,mb:Tmember;
   inter:Tstruct;
begin

    SetLength(pids,10);

    if(st.parentstruct=-1) then raise Exception.Create('Error: wrong argument sent to ChildStructMemberCheck');

    k:=st.typeid;
    pn:=0;
    while (StructList[k].parentstruct<>-1) do begin
        if(pn+1>Length(pids)) then SetLength(pids,pn+20);
        k:=StructList[k].parentstruct;

        if(StructList[k].getmember('create',memb) and (memb.access=ACCESS_PRIVATE) ) then begin
            raise JasserLineDoubleException(st.decl,'Unable to extend '+StructList[k].name,memb.decl,'\--- ('+StructList[k].name+' was declared to have a private "create" method)');
        end;

        pids[pn]:=k;
        pn:=pn+1;

    end;
    pni:=pn;
    if(StructList[k].parent<>-1) then begin
        if(pn+1>Length(pids)) then SetLength(pids,pn+20);
        pids[pn]:=StructList[k].parent;
        pni:=pn+1;
    end;

    //check for interface methods...
    if(pni<>pn) then begin
        inter:=StructList[pids[pni-1]];
        for i := 0 to st.membern - 1 do begin
            mb:=st.members[i];

            if (inter.getmember(mb.name,memb)) then begin
                CompareStructInterfaceMembers(st,mb,inter,memb);
            end;

            if (inter.noargumentcreate) and (mb.name='create') and (mb.argnumber<>0) then begin
                raise JasserLineException(mb.decl,'Since '+st.name+' is a child of '+inter.name+' create must be an static method that takes nothing.');
            end;
        end;
    end;

    //check variable redeclaration
    for i := 0 to st.membern - 1 do begin
        mb:=st.members[i];
        if (not mb.ismethod) or ( (not mb.fromparent) and (mb.name<>'onDestroy') and(not mb.construct) and(not mb.destruct) and (mb.name<>'create') and (mb.name<>'destroy')  ) then begin
            for k := 0 to pn - 1 do begin
                if (StructList[pids[k]].getmember(mb.name,memb)) then begin
                    if( memb.stub) then begin
                        mb.fromparent:=true;
                        mb.abuse := true;
                        break;
                    end else if(memb.access=ACCESS_PRIVATE) then break
                    else begin
                        raise JasserLineDoubleException(st.members[i].decl,'Member name already in use by a parent type',memb.decl,'\--- First time used here.');
                    end;
                end;
            end;
        end;
    end;

end;

//==============================================================================
// Lots of verification
//==============================================================================
procedure Step01;
var
    i,j,k:integer;
    memb:Tmember;
    tmstruct,tmstruct2:TStruct;
    tem:string;
begin
    //add arrays corresponding to BigArrays:
    for i := 0 to BigArrayN-1 do begin
        Concatenate3(tem,BigArrayTypes[i],' array s__',BigArrayNames[i]);
        addGlobal(tem,BigArrayDeclLines[i]);

        if(BigArraySizes[i]>JASS_ARRAY_SIZE) then begin
            GenerateExtraArrays(BigArrayTypes[i],'s__',BigArrayNames[i],BigArraySizes[i],BigArrayDeclLines[i] );
        end;

    end;

    //verify extends
    for i := 1 to StructN do begin
        tmstruct:=    StructList[i];
        if (tmstruct.parentname<>'') then begin
            k:=StructHash.ValueOf(tmstruct.parentname);
            if (k=-1) then raise JASSerLineException(tmstruct.decl,'Unable to find the struct/interface '+tmstruct.parentname);

            tmstruct2:=StructList[k];
            if(tmstruct2.isarraystruct) then raise JasserLineException(tmstruct.decl,'Unable to extend an array struct: '+tmstruct2.name);
            if(not tmstruct2.isinterface) then begin
                tmstruct2.addchild(i);
                tmstruct2.gotstructchildren:=true;
                tmstruct.parentstruct:=k;
                tmstruct.parent:=-1;

                if (tmstruct2.getmember('create',memb)) then begin
                     if memb.construct then begin
                         //just allocate...
                     end else begin
                         memb.abuse:=true; //must abuse...
                     end;


                end else raise JASSerLineException(tmstruct.decl,'[internal error] no create method in '+tmstruct.parentname+'?');

            end else begin
                tmstruct2.addchild(i);
                tmstruct.parent:=k;
            end;
        end;
    end;

    //Verify stub methods on final structs
    for i := 1 to StructN do begin
        tmstruct:=    StructList[i];
        if( not(tmstruct.isinterface) and not(tmstruct.gotstructchildren) and (tmstruct.gotStubMethods) ) then begin
            //tmstruct.gotstructchildren:=true;
            tmstruct.gotStubMethods:= false;
            for j := 0 to tmstruct.membern-1 do
                tmstruct.members[j].stub:=false;
        end else if(tmstruct.gotStubMethods) then begin
            for j := 0 to tmstruct.membern-1 do
                if(tmstruct.members[j].stub) then begin
                    Concatenate4(tem,'trigger array st__',tmstruct.name,'_',tmstruct.members[j].name);
                     addglobal(tem,i, tmstruct.typeid);
                end;
        end;

    end;

    //Do a topsort, useful for a later stage and also to detect cycles
    DoStructTopSort;

    //Verify delegate cycles:
    DoDelegateCycleVerification;

    //verify new parents...
    for i := 1 to StructN do begin
        tmstruct:=StructList[i];
        if ( tmstruct.parentname='') and (tmstruct.gotstructchildren) then begin
            Concatenate3(tem,'integer array si__',tmstruct.name,'_type')  ; addglobal(tem,tmstruct.decl, tmstruct.typeid);
            generateExtraArrays('integer',RConcatenate3('si__',tmstruct.name,'_'),'type',tmstruct.requiredspace,tmstruct.decl);
            Concatenate3(tem,'trigger array st__',tmstruct.name,'_onDestroy')  ; addglobal(tem,tmstruct.decl, tmstruct.typeid);
        end;
        if (tmstruct.parentstruct<>-1) then ChildStructMemberCheck(tmstruct);

    end;

    //verify if interfaces are accomplished
    for i := 1 to StructN do begin
        tmstruct:=StructList[i];
        if(tmstruct.isinterface) then begin
            j:=0;
            while(j<tmstruct.nchildren) do begin

                tmstruct2:=StructList[tmstruct.children[j]];
                //is the member present?
                k:=0;
                while(k<tmstruct.membern) do begin

                  if( tmstruct2.getmember(tmstruct.members[k].name,memb) ) then begin
                      compareStructInterfaceMembers(tmstruct2,memb,tmstruct,tmstruct.members[k]);
                  end else if((tmstruct.members[k].ismethod) and (tmstruct.members[k].interdefault='')) then begin
                        raise JASSerLineDoubleException(tmstruct2.decl,'Missing method : '+tmstruct.members[k].name,tmstruct.members[k].decl,'`--- interface declaration here');
                  end;
                  k:=k+1;
                end;

                if (tmstruct.noargumentcreate) and (tmstruct2.getmember('create',memb)) then begin

                    if(memb.argnumber<>0) then raise JasserLineException(memb.decl,'Since '+tmstruct2.name+' is a child of '+tmstruct.name+' create must be an static method that takes nothing.');
                end;


                j:=j+1;
            end;
        end;

    end;
end;

end.
