webidl: wasmjob: resolve function return types, use IJSArray for arrays

packages/webidl/src/webidltopas.pp

@@ -106,12 +106,13 @@ type
     function GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean = false): string; virtual;
     function GetPasDataPos(D: TPasData; WithoutFile: boolean = false): string; virtual;
     procedure EnsureUniqueNames(ML: TIDLDefinitionList); virtual;
+    procedure EnsureUniqueArgNames(Intf: TIDLInterfaceDefinition); virtual;
     function AddSequenceDef(ST: TIDLSequenceTypeDefDefinition): Boolean; virtual;
     function GetName(ADef: TIDLDefinition): String; virtual;
     function GetPasClassName(const aName: string): string; overload; virtual;
     function GetTypeName(Const aTypeName: String; ForTypeDef: Boolean=False): String; overload; virtual;
     function GetTypeName(aTypeDef: TIDLTypeDefDefinition; ForTypeDef: Boolean=False): String; overload; virtual;
-    function GetResolvedTypeName(Const aTypeName: String): String; overload; virtual;
+    function GetResolvedType(aDef: TIDLTypeDefDefinition; out aTypeName, aResolvedTypename: string): TIDLDefinition; overload; virtual;
     function GetSequenceTypeName(Seq: TIDLSequenceTypeDefDefinition; ForTypeDef: Boolean=False): string; virtual;
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String; virtual;
     function GetDictionaryDefHead(const CurClassName: string; Dict: TIDLDictionaryDefinition): String; virtual;
@@ -563,6 +564,26 @@ Var
       L.Add(NewName,Def);
   end;
 
+var
+  D: TIDLDefinition;
+begin
+  L:=TFPObjectHashTable.Create(False);
+  try
+    For D in ML Do
+      if not (D is TIDLConstDefinition) then
+        CheckRename(D);
+    For D in ML Do
+      if (D is TIDLConstDefinition) then
+        CheckRename(D);
+  finally
+    L.Free;
+  end;
+end;
+
+procedure TBaseWebIDLToPas.EnsureUniqueArgNames(Intf: TIDLInterfaceDefinition);
+var
+  Names: TFPObjectHashTable;
+
   procedure CheckRenameArgs(Func: TIDLFunctionDefinition);
   var
     i: Integer;
@@ -574,35 +595,51 @@ Var
       begin
       Arg:=Func.Argument[i];
       ArgName:=GetName(Arg);
+      if ArgName[1]<>'a' then
+        begin
+        ArgName:='a'+ArgName;
+        (Arg.Data as TPasData).PasName:=ArgName;
+        end;
       repeat
-        ConflictDef:=TIDLDefinition(L.Items[ArgName]);
+        ConflictDef:=TIDLDefinition(Names.Items[ArgName]);
         if (ConflictDef=Nil) then break;
         // name conflict -> rename
-        if ArgName[1]<>'a' then
-          ArgName:='a'+ArgName
-        else
-          ArgName:='_'+ArgName;
+        ArgName:='_'+ArgName;
         (Arg.Data as TPasData).PasName:=ArgName;
       until false;
       end;
   end;
 
 var
+  Members, MembersWithParents: TIDLDefinitionList;
+  CurIntf: TIDLInterfaceDefinition;
   D: TIDLDefinition;
+  CurName: String;
 begin
-  L:=TFPObjectHashTable.Create(False);
+  Names:=TFPObjectHashTable.Create(False);
+  Members:=TIDLDefinitionList.Create(Nil,False);
+  MembersWithParents:=TIDLDefinitionList.Create(Nil,False);
   try
-    For D in ML Do
-      if not (D is TIDLConstDefinition) then
-        CheckRename(D);
-    For D in ML Do
-      if (D is TIDLConstDefinition) then
-        CheckRename(D);
-    For D in ML Do
+    Intf.GetFullMemberList(Members);
+    CurIntf:=Intf;
+    while CurIntf<>nil do
+      begin
+      CurIntf.GetFullMemberList(MembersWithParents);
+      CurIntf:=CurIntf.ParentInterface;
+      end;
+    For D in MembersWithParents Do
+      begin
+      CurName:=GetName(D);
+      if Names.Items[CurName]=nil then
+        Names.Add(CurName,D);
+      end;
+    For D in Members Do
       if D is TIDLFunctionDefinition then
         CheckRenameArgs(TIDLFunctionDefinition(D));
   finally
-    L.Free;
+    MembersWithParents.Free;
+    Members.Free;
+    Names.Free;
   end;
 end;
 
@@ -619,6 +656,7 @@ begin
   try
     Intf.GetFullMemberList(ML);
     EnsureUniqueNames(ML);
+    EnsureUniqueArgNames(Intf);
     aClassName:=GetName(Intf);
     // class comment
     ClassComment(aClassName);
@@ -749,21 +787,36 @@ begin
     Result:=GetTypeName(aTypeDef.TypeName,ForTypeDef);
 end;
 
-function TBaseWebIDLToPas.GetResolvedTypeName(const aTypeName: String): String;
-var
-  aDef: TIDLDefinition;
+function TBaseWebIDLToPas.GetResolvedType(aDef: TIDLTypeDefDefinition; out
+  aTypeName, aResolvedTypename: string): TIDLDefinition;
 begin
-  aDef:=FindGlobalDef(aTypeName);
-  if aDef is TIDLTypeDefDefinition then
-    Result:=GetResolvedTypeName(TIDLTypeDefDefinition(aDef).TypeName)
+  Result:=nil;
+  if aDef=nil then
+    begin
+    aTypeName:='';
+    aResolvedTypename:='';
+    exit;
+    end;
+  aTypeName:=GetTypeName(aDef.TypeName);
+  //writeln('TBaseWebIDLToPas.GetResolvedType START aDef=',aDef.Name,':',aDef.ClassName,' ',aDef.TypeName,' ',GetDefPos(aDef));
+  Result:=aDef;
+  while (aDef.Data is TPasData) and (TPasData(aDef.Data).Resolved<>nil) do
+    begin
+    Result:=TPasData(aDef.Data).Resolved;
+    //writeln('TBaseWebIDLToPas.GetResolvedType RESOLVED Result=',Result.Name,' ',GetDefPos(Result));
+    if not (Result is TIDLTypeDefDefinition) then
+      break;
+    aDef:=TIDLTypeDefDefinition(Result);
+    end;
+  if Result is TIDLTypeDefDefinition then
+    aResolvedTypename:=GetTypeName(TIDLTypeDefDefinition(Result))
   else
-    Result:=GetTypeName(aTypeName);
+    aResolvedTypename:=GetName(Result);
 end;
 
 function TBaseWebIDLToPas.GetSequenceTypeName(
   Seq: TIDLSequenceTypeDefDefinition; ForTypeDef: Boolean): string;
 begin
-  //writeln('TBaseWebIDLToPas.GetSequenceTypeName ',Seq.ElementType.Name,' ',Seq.ElementType.TypeName);
   Result:=GetTypeName(Seq.ElementType,ForTypeDef);
   if Result='' then
     raise EConvertError.Create('sequence without name at '+GetDefPos(Seq));
@@ -1500,7 +1553,7 @@ begin
     FGlobalDefs.Add(D.Name,D);
     end
   else
-    writeln('TBaseWebIDLToPas.AddJSIdentifier SubIdentifier: '+D.Name+' at '+GetDefPos(D)+' Parent=',D.Parent.Name,':',D.Parent.ClassName,' at ',GetDefPos(D.Parent));
+    ; //writeln('TBaseWebIDLToPas.AddJSIdentifier SubIdentifier: '+D.Name+' at '+GetDefPos(D)+' Parent=',D.Parent.Name,':',D.Parent.ClassName,' at ',GetDefPos(D.Parent));
 end;
 
 procedure TBaseWebIDLToPas.ResolveParentInterfaces(aList: TIDLDefinitionList);
@@ -1540,17 +1593,22 @@ procedure TBaseWebIDLToPas.ResolveTypeDef(D: TIDLDefinition);
     Data: TPasData;
   begin
     Def:=FindGlobalDef(aTypeName);
+    //writeln('ResolveTypeName ',Def<>nil);
     if Def=nil then
       begin
       if NameToWebIDLBaseType(aTypeName)=wibtNone then
-        writeln('Type ',aTypeName,' not found at ',GetDefPos(D));
+        raise EConvertError.Create('type "'+aTypeName+'" of "'+D.Name+'" not found at '+GetDefPos(D));
       end
     else
       begin
       Data:=TPasData(D.Data);
       if Data=nil then
+        begin
         Data:=CreatePasName('',D,false);
+        D.Data:=Data;
+        end;
       Data.Resolved:=Def;
+      //writeln('ResolveTypeName D=',D.Name,':',D.ClassName,' at ',GetDefPos(D),' Data.Resolved=',Def.Name,':',Def.ClassName,' at ',GetDefPos(Def));
       end;
   end;
 
@@ -1558,20 +1616,27 @@ var
   DMD: TIDLDictionaryMemberDefinition;
   IT: TIDLIterableDefinition;
   SerializerD: TIDLSerializerDefinition;
+  FD: TIDLFunctionDefinition;
 begin
   if D=nil then exit;
   //writeln('TBaseWebIDLToPas.ResolveTypeDef START ',D.Name,':',D.ClassName,' at ',GetDefPos(D));
   if D Is TIDLInterfaceDefinition then
-    ResolveTypeDefs((D as TIDLInterfaceDefinition).Members)
+    ResolveTypeDefs(TIDLInterfaceDefinition(D).Members)
   else if D Is TIDLDictionaryDefinition then
-    ResolveTypeDefs((D as TIDLDictionaryDefinition).Members)
+    ResolveTypeDefs(TIDLDictionaryDefinition(D).Members)
   else if D is TIDLIncludesDefinition then
   else if D Is TIDLFunctionDefinition then
-    ResolveTypeDefs((D as TIDLFunctionDefinition).Arguments)
+    begin
+    FD:=TIDLFunctionDefinition(D);
+    ResolveTypeDefs(FD.Arguments);
+    ResolveTypeDef(FD.ReturnType);
+    end
   else if D is TIDLAttributeDefinition then
     ResolveTypeDef(TIDLAttributeDefinition(D).AttributeType)
   else if D is TIDLArgumentDefinition then
     ResolveTypeDef(TIDLArgumentDefinition(D).ArgumentType)
+  else if D is TIDLSequenceTypeDefDefinition then
+    ResolveTypeDef(TIDLSequenceTypeDefDefinition(D).ElementType)
   else if D is TIDLTypeDefDefinition then
     ResolveTypeName(TIDLTypeDefDefinition(D).TypeName)
   else if D is TIDLConstDefinition then
@@ -1598,7 +1663,7 @@ begin
     ResolveTypeDef(IT.KeyType);
     end
   else {if Verbose then}
-    writeln('TBaseWebIDLToPas.ResolveTypeDef unknown ',D.Name,':',D.ClassName,' at ',GetDefPos(D));
+    raise EConvertError.Create('TBaseWebIDLToPas.ResolveTypeDef unknown '+D.Name+':'+D.ClassName+' at '+GetDefPos(D));
 end;
 
 procedure TBaseWebIDLToPas.RemoveInterfaceForwards(aList: TIDLDefinitionList);
@@ -1608,7 +1673,8 @@ Var
 
   Procedure DeleteIntf(Def: TIDLInterfaceDefinition);
   begin
-    writeln('DeleteIntf ',Def.Name);
+    if Verbose then
+      writeln('Hint: removing interface ',Def.Name,' at '+GetDefPos(Def));
     aList.Delete(Def);
   end;
 

packages/webidl/src/webidltowasmjob.pp

@@ -105,6 +105,7 @@ type
     function WritePrivateSetter(Attr: TIDLAttributeDefinition): boolean; virtual;
     function WriteProperty(Attr: TIDLAttributeDefinition): boolean; virtual;
     function WriteRecordDef(aDef: TIDLRecordDefinition): Boolean; override;
+    procedure WriteSequenceDef(aDef: TIDLSequenceTypeDefDefinition); override;
   Public
     constructor Create(ThOwner: TComponent); override;
   Published
@@ -231,27 +232,19 @@ end;
 
 function TWebIDLToPasWasmJob.GetTypeName(const aTypeName: String;
   ForTypeDef: Boolean): String;
-var
-  Def: TIDLDefinition;
 begin
   Case aTypeName of
     'union',
     'any': Result:=JOB_JSValueTypeNames[jjvkUndefined];
     'void': Result:=aTypeName;
   else
-    Def:=FindGlobalDef(aTypeName);
     //writeln('TWebIDLToPasWasmJob.GetTypeName ',aTypeName,' ',Def<>nil);
-    if Def is TIDLSequenceTypeDefDefinition then
-      Result:=GetSequenceTypeName(TIDLSequenceTypeDefDefinition(Def))
-    else
-      begin
-      Result:=inherited GetTypeName(aTypeName,ForTypeDef);
-      if (Result=aTypeName)
-      and (LeftStr(Result,length(PasInterfacePrefix))<>PasInterfacePrefix)
-      and (RightStr(Result,length(PasInterfaceSuffix))<>PasInterfaceSuffix)
-      then
-        Result:=PasInterfacePrefix+Result+PasInterfaceSuffix;
-      end;
+    Result:=inherited GetTypeName(aTypeName,ForTypeDef);
+    if (Result=aTypeName)
+    and (LeftStr(Result,length(PasInterfacePrefix))<>PasInterfacePrefix)
+    and (RightStr(Result,length(PasInterfaceSuffix))<>PasInterfaceSuffix)
+    then
+      Result:=PasInterfacePrefix+Result+PasInterfaceSuffix;
   end;
 end;
 
@@ -419,14 +412,15 @@ var
 
 Var
   Data: TPasDataWasmJob;
-  FN, RT, Suff, Args, ProcKind, Sig, aClassName, Code, InvokeName,
+  FuncName, Suff, Args, ProcKind, Sig, aClassName, Code, InvokeName,
     InvokeCode, ArgName, TryCode, VarSection, FinallyCode, LocalName,
-    WrapperFn, ArgTypeName: String;
+    WrapperFn, ArgTypeName, ReturnTypeName, ResolvedReturnTypeName,
+    InvokeClassName: String;
   Overloads: TFPObjectList;
   I: Integer;
   AddFuncBody: Boolean;
   ArgDefList: TIDLDefinitionList;
-  CurDef, ArgType: TIDLDefinition;
+  CurDef, ArgType, ReturnDef: TIDLDefinition;
   ArgDef: TIDLArgumentDefinition absolute CurDef;
 begin
   Result:=True;
@@ -438,18 +432,19 @@ begin
     end;
 
   Suff:='';
-  RT:='';
+  ReturnDef:=GetResolvedType(aDef.ReturnType,ReturnTypeName,ResolvedReturnTypeName);
+  InvokeName:='';
+  InvokeClassName:='';
   if (foConstructor in aDef.Options) then
     begin
-    FN:='New';
+    FuncName:='New';
     writeln('Note: skipping constructor of '+aDef.Parent.Name+' at '+GetDefPos(aDef));
     exit(false);
     end
   else
     begin
-    FN:=GetName(aDef);
-    RT:=GetTypeName(aDef.ReturnType,False);
-    case RT of
+    FuncName:=GetName(aDef);
+    case ResolvedReturnTypeName of
     'Boolean': InvokeName:='InvokeJSBooleanResult';
     'ShortInt',
     'Byte',
@@ -465,11 +460,21 @@ begin
     'TJOB_JSValue': InvokeName:='InvokeJSValueResult';
     'void','undefined':
       begin
-      RT:='';
+      ReturnTypeName:='';
+      ResolvedReturnTypeName:='';
       InvokeName:='InvokeJSNoResult';
       end;
     else
       InvokeName:='InvokeJSObjectResult';
+      if ReturnDef is TIDLSequenceTypeDefDefinition then
+        InvokeClassName:=ClassPrefix+'Array'+ClassSuffix
+      else if ReturnDef is TIDLInterfaceDefinition then
+        begin
+        InvokeClassName:=ReturnTypeName;
+        ReturnTypeName:=GetPasIntfName(ReturnDef);
+        end
+      else
+        raise EConvertError.Create('not yet supported: function return type '+ResolvedReturnTypeName+' '+ReturnDef.ClassName+' at '+GetDefPos(aDef));
     end;
 
     end;
@@ -487,18 +492,18 @@ begin
       begin
       ArgDefList:=TIDLDefinitionList(Overloads[i]);
       Args:=GetArguments(ArgDefList,False);
-      if (RT='') then
+      if (ReturnTypeName='') then
         begin
         if not (foConstructor in aDef.Options) then
           ProcKind:='procedure'
         else
           ProcKind:='constructor';
-        Sig:=FN+Args+Suff+';';
+        Sig:=FuncName+Args+Suff+';';
         end
       else
         begin
         ProcKind:='function';
-        Sig:=FN+Args+': '+RT+Suff+';';
+        Sig:=FuncName+Args+': '+ReturnTypeName+Suff+';';
         end;
       AddLn(ProcKind+' '+Sig);
 
@@ -510,7 +515,7 @@ begin
           ArgNames.Add(GetName(ArgDef));
 
         InvokeCode:='';
-        if RT<>'' then
+        if ReturnTypeName<>'' then
           InvokeCode:='Result:=';
         VarSection:='';
         TryCode:='';
@@ -525,7 +530,8 @@ begin
             begin
             ArgTypeName:=TIDLSequenceTypeDefDefinition(ArgDef.ArgumentType).ElementType.TypeName;
             ArgType:=FindGlobalDef(ArgTypeName);
-            writeln('TWebIDLToPasWasmJob.WriteFunctionDefinition sequence of ',ArgTypeName,' Element=',ArgType<>nil);
+            if Verbose then
+              writeln('Hint: TWebIDLToPasWasmJob.WriteFunctionDefinition sequence of ',ArgTypeName,' Element=',ArgType<>nil);
             raise EConvertError.Create('not yet supported: passing an array of '+ArgTypeName+' as argument at '+GetDefPos(ArgDef));
             end
           else
@@ -545,7 +551,11 @@ begin
           end;
         Args:=',['+Args+']';
 
-        InvokeCode:=InvokeCode+InvokeName+'('''+aDef.Name+''''+Args+')';
+        InvokeCode:=InvokeCode+InvokeName+'('''+aDef.Name+''''+Args;
+        if InvokeClassName<>'' then
+          InvokeCode:=InvokeCode+','+InvokeClassName+') as '+ReturnTypeName
+        else
+          InvokeCode:=InvokeCode+')';
 
         Code:=ProcKind+' '+aClassName+'.'+Sig+sLineBreak;
         if VarSection<>'' then
@@ -581,28 +591,37 @@ end;
 function TWebIDLToPasWasmJob.WriteFunctionTypeDefinition(
   aDef: TIDLFunctionDefinition): Boolean;
 var
-  FN, RT, ArgName, VarSection, FetchArgs, Params, Call, Code,
-    ArgTypeName, GetFunc: String;
+  FuncName, ReturnTypeName, ResolvedReturnTypeName: String;
+  ArgName, ArgTypeName, ArgResolvedTypename: String;
+  VarSection, FetchArgs, Params, Call, Code, GetFunc: String;
   Data: TPasDataWasmJob;
   Args: TIDLDefinitionList;
   ArgDef: TIDLArgumentDefinition;
   ArgNames: TStringList;
   j, i: Integer;
-  CurDef, ReturnDef: TIDLDefinition;
+  ReturnDef, ArgType: TIDLDefinition;
 begin
   Result:=True;
-  FN:=GetName(aDef);
-  RT:=GetResolvedTypeName(aDef.ReturnType.TypeName);
-  if (RT='void') then
-    RT:='';
-  ReturnDef:=FindGlobalDef(aDef.ReturnType.TypeName);
+  FuncName:=GetName(aDef);
+
+  ReturnDef:=GetResolvedType(aDef.ReturnType,ReturnTypeName,ResolvedReturnTypeName);
+  case ResolvedReturnTypeName of
+  'void','undefined':
+    begin
+    ReturnTypeName:='';
+    ResolvedReturnTypeName:='';
+    end;
+  end;
+  if ReturnDef is TIDLSequenceTypeDefDefinition then
+    ReturnTypeName:='IJSArray';
+
   Args:=aDef.Arguments;
 
   Params:=GetArguments(aDef.Arguments,False);
-  if (RT='') then
-    AddLn(FN+' = procedure '+Params+';')
+  if (ResolvedReturnTypeName='') then
+    AddLn(FuncName+' = procedure '+Params+';')
   else
-    AddLn(FN+' = function '+Params+': '+RT+';');
+    AddLn(FuncName+' = function '+Params+': '+ReturnTypeName+';');
 
   Data:=TPasDataWasmJob(aDef.Data);
   if Data.HasFuncBody then exit;
@@ -611,7 +630,7 @@ begin
   ArgNames:=TStringList.Create;
   try
     // create wrapper callback
-    Code:='function JOBCall'+Fn+'(const aMethod: TMethod; const H: TJOBCallbackHelper): PByte;'+sLineBreak;
+    Code:='function JOBCall'+FuncName+'(const aMethod: TMethod; const H: TJOBCallbackHelper): PByte;'+sLineBreak;
     ArgNames.Add('aMethod');
     ArgNames.Add('h');
     VarSection:='';
@@ -627,9 +646,9 @@ begin
         while ArgNames.IndexOf(ArgName+IntToStr(j))>=0 do inc(j);
         ArgName:=ArgName+IntToStr(j);
         end;
-      ArgTypeName:=GetResolvedTypeName(ArgDef.ArgumentType.TypeName);
+      ArgType:=GetResolvedType(ArgDef.ArgumentType,ArgTypeName,ArgResolvedTypename);
 
-      case ArgTypeName of
+      case ArgResolvedTypename of
       '': raise EWebIDLParser.Create('not yet supported: function type arg['+IntToStr(I)+'] type void at '+GetDefPos(ArgDef));
       'Boolean': GetFunc:='GetBoolean';
       'ShortInt',
@@ -645,13 +664,12 @@ begin
       'UnicodeString': GetFunc:='GetString';
       'TJOB_JSValue': GetFunc:='GetValue';
       else
-        CurDef:=FindGlobalDef(ArgDef.ArgumentType.TypeName);
-        if CurDef is TIDLInterfaceDefinition then
+        if ArgType is TIDLInterfaceDefinition then
           GetFunc:='GetObject('+IntfToPasClassName(ArgTypeName)+') as '+ArgTypeName
         else
           begin
-          if CurDef<>nil then
-            writeln('TWebIDLToPasWasmJob.WriteFunctionTypeDefinition CurDef=',CurDef.ClassName);
+          if ArgType<>nil then
+            writeln('TWebIDLToPasWasmJob.WriteFunctionTypeDefinition ArgType=',ArgType.ClassName);
           raise EWebIDLParser.Create('not yet supported: function type arg['+IntToStr(I)+'] type '+ArgDef.ArgumentType.TypeName+' at '+GetDefPos(ArgDef));
           end;
       end;
@@ -674,8 +692,8 @@ begin
     Code:=Code+'begin'+sLineBreak;
     Code:=Code+FetchArgs+sLineBreak;
 
-    Call:=FN+'(aMethod)('+Params+')';
-    case RT of
+    Call:=FuncName+'(aMethod)('+Params+')';
+    case ResolvedReturnTypeName of
     '': GetFunc:='Result:=H.AllocUndefined('+Call+');';
     'Boolean': GetFunc:='Result:=H.AllocBool('+Call+');';
     'ShortInt',
@@ -697,7 +715,7 @@ begin
         begin
         if ReturnDef<>nil then
           writeln('TWebIDLToPasWasmJob.WriteFunctionTypeDefinition ReturnDef=',ReturnDef.ClassName);
-        raise EWebIDLParser.Create('not yet supported: function type result type "'+RT+'" at '+GetDefPos(aDef));
+        raise EWebIDLParser.Create('not yet supported: function type result type "'+ResolvedReturnTypeName+'" at '+GetDefPos(aDef));
         end;
     end;
     Code:=Code+'  '+GetFunc+sLineBreak;
@@ -837,6 +855,12 @@ begin
   AddLn(GetName(aDef)+' = '+ClassPrefix+'Object'+ClassSuffix+';');
 end;
 
+procedure TWebIDLToPasWasmJob.WriteSequenceDef(
+  aDef: TIDLSequenceTypeDefDefinition);
+begin
+  Addln(GetName(aDef)+' = '+PasInterfacePrefix+'Array'+PasInterfaceSuffix+'; // array of '+GetTypeName(aDef.ElementType));
+end;
+
 constructor TWebIDLToPasWasmJob.Create(ThOwner: TComponent);
 begin
   inherited Create(ThOwner);