瀏覽代碼

webidl: wasmjob: array name

mattias 3 年之前
父節點
當前提交
1aae90b294
共有 2 個文件被更改,包括 80 次插入57 次删除
  1. 30 16
      packages/webidl/src/webidltopas.pp
  2. 50 41
      packages/webidl/src/webidltowasmjob.pp

+ 30 - 16
packages/webidl/src/webidltopas.pp

@@ -57,6 +57,8 @@ const
 type
   TBaseWebIDLToPas = Class(TPascalCodeGenerator)
   private
+    FArrayPrefix: String;
+    FArraySuffix: String;
     FAutoTypes: TStrings;
     FBaseOptions: TBaseConversionOptions;
     FClassPrefix: String;
@@ -102,8 +104,10 @@ type
     procedure EnsureUniqueNames(ML: TIDLDefinitionList); 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 GetSequenceTypeName(Seq: TIDLSequenceTypeDefDefinition; ForTypeDef: Boolean=False): string; virtual;
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String; virtual;
     function GetDictionaryDefHead(const CurClassName: string; Dict: TIDLDictionaryDefinition): String; virtual;
     function CheckUnionTypeDefinition(D: TIDLDefinition): TIDLUnionTypeDefDefinition; virtual;
@@ -168,6 +172,8 @@ type
     Property FieldPrefix: String Read FFieldPrefix Write FFieldPrefix;
     Property ClassPrefix: String Read FClassPrefix Write FClassPrefix;
     Property ClassSuffix: String Read FClassSuffix Write FClassSuffix;
+    Property ArrayPrefix: String Read FArrayPrefix Write FArrayPrefix;
+    Property ArraySuffix: String Read FArraySuffix Write FArraySuffix;
     Property GetterPrefix: String read FGetterPrefix write FGetterPrefix;
     Property SetterPrefix: String read FSetterPrefix write FSetterPrefix;
     Property FuncTypePrefix: String read FFuncTypePrefix write FFuncTypePrefix;
@@ -263,6 +269,11 @@ begin
     Result:=ADef.Name;
 end;
 
+function TBaseWebIDLToPas.GetPasClassName(const aName: string): string;
+begin
+  Result:=ClassPrefix+aName+ClassSuffix;
+end;
+
 function TBaseWebIDLToPas.HaveConsts(aList: TIDLDefinitionList): Boolean;
 
 Var
@@ -654,6 +665,8 @@ begin
   FieldPrefix:='F';
   ClassPrefix:='T';
   ClassSuffix:='';
+  ArrayPrefix:='T';
+  ArraySuffix:='DynArray';
   GetterPrefix:='Get';
   SetterPrefix:='Set';
   FuncTypePrefix:='T';
@@ -698,17 +711,24 @@ begin
     if Assigned(aTypeDef.Data) then
       Result:=GetName(aTypeDef)
     else
-      begin
-      Result:=GetTypeName(TIDLSequenceTypeDefDefinition(aTypeDef).ElementType,ForTypeDef);
-      if Result[1]<>'T' then
-        Result:='T'+Result;
-      Result:=Result+'DynArray';
-      end
+      Result:=GetSequenceTypeName(TIDLSequenceTypeDefDefinition(aTypeDef),ForTypeDef);
     end
   else
     Result:=GetTypeName(aTypeDef.TypeName,ForTypeDef);
 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));
+  if LeftStr(Result,length(ArrayPrefix))<>ArrayPrefix then
+    Result:=ArrayPrefix+Result;
+  Result:=Result+ArraySuffix;
+end;
+
 function TBaseWebIDLToPas.GetInterfaceDefHead(Intf: TIDLInterfaceDefinition
   ): String;
 begin
@@ -736,16 +756,9 @@ end;
 
 function TBaseWebIDLToPas.GetTypeName(const aTypeName: String; ForTypeDef: Boolean
   ): String;
-
-  function GetClassName(const aClassName: string): string;
-  begin
-    Result:=ClassPrefix+aClassName+ClassSuffix;
-  end;
-
 Var
   A: UTF8String;
   D: TIDLDefinition;
-
 begin
   Case aTypeName of
     'boolean': Result:='Boolean';
@@ -772,9 +785,9 @@ begin
     'ByteString': Result:='UnicodeString';
 
     'record',
-    'object': Result:=GetClassName('Object');
+    'object': Result:=GetPasClassName('Object');
     'Error',
-    'DOMException': Result:=GetClassName('Error');
+    'DOMException': Result:=GetPasClassName('Error');
 
     'ArrayBuffer',
     'DataView',
@@ -786,13 +799,14 @@ begin
     'Uint32Array',
     'Uint8ClampedArray',
     'Float32Array',
-    'Float64Array': Result:=GetClassName(aTypeName);
+    'Float64Array': Result:=GetPasClassName(aTypeName);
 
     'void': Result:=aTypeName;
   else
     if ForTypeDef then ;
 
     Result:=aTypeName;
+    writeln('BBB1 TBaseWebIDLToPas.GetTypeName ',Result);
     D:=FContext.FindDefinition(Result);
     if D<>Nil then
       Result:=GetName(D)

+ 50 - 41
packages/webidl/src/webidltowasmjob.pp

@@ -29,7 +29,8 @@ type
     jjvkString,
     jjvkObject,
     jivkMethod,
-    jjvkDictionary
+    jjvkDictionary,
+    jjvkArray
     );
   TJOB_JSValueKinds = set of TJOB_JSValueKind;
 
@@ -41,7 +42,8 @@ const
     'String',
     'Object',
     'Method',
-    'Dictionary'
+    'Dictionary',
+    'Array'
     );
   JOB_JSValueTypeNames: array[TJOB_JSValueKind] of string = (
     'TJOB_JSValue',
@@ -50,7 +52,8 @@ const
     'TJOB_String',
     'TJOB_Object',
     'TJOB_Method',
-    'TJOB_Dictionary'
+    'TJOB_Dictionary',
+    'TJOB_Array'
     );
 type
   TPasDataWasmJob = class(TPasData)
@@ -65,10 +68,13 @@ type
   TWebIDLToPasWasmJob = class(TBaseWebIDLToPas)
   private
     FPasInterfacePrefix: String;
+    FPasInterfaceSuffix: String;
   Protected
     function BaseUnits: String; override;
     // Auxiliary routines
-    function ClassToPasIntfName(const CN: string): string; virtual;
+    function GetPasClassName(const aName: string): string; overload;
+      override;
+    function IntfToPasClassName(const aName: string): string; virtual;
     function ComputeGUID(const Prefix: string; aList: TIDLDefinitionList): string; virtual;
     procedure GetOptions(L: TStrings; Full: boolean); override;
     function GetTypeName(const aTypeName: String; ForTypeDef: Boolean=False
@@ -103,6 +109,7 @@ type
     Property ClassPrefix;
     Property ClassSuffix;
     Property PasInterfacePrefix: String read FPasInterfacePrefix write FPasInterfacePrefix;
+    Property PasInterfaceSuffix: String read FPasInterfaceSuffix write FPasInterfaceSuffix;
     Property DictionaryClassParent;
     Property FieldPrefix;
     Property GetterPrefix;
@@ -125,12 +132,24 @@ begin
   Result:='SysUtils, JOB_WAsm';
 end;
 
-function TWebIDLToPasWasmJob.ClassToPasIntfName(const CN: string): string;
+function TWebIDLToPasWasmJob.GetPasClassName(const aName: string): string;
+begin
+  Result:=aName;
+  if (LeftStr(Result,length(ClassPrefix))=ClassPrefix)
+  and (RightStr(Result,length(ClassSuffix))=ClassSuffix)
+  then
+    Result:=copy(Result,length(ClassPrefix)+1,length(Result)-length(ClassPrefix)-length(ClassSuffix));
+  Result:=PasInterfacePrefix+Result+PasInterfaceSuffix;
+end;
+
+function TWebIDLToPasWasmJob.IntfToPasClassName(const aName: string): string;
 begin
-  Result:=CN;
-  if LeftStr(Result,length(ClassPrefix))=ClassPrefix then
-    System.Delete(Result,1,length(ClassPrefix));
-  Result:=PasInterfacePrefix+Result;
+  Result:=aName;
+  if (LeftStr(Result,length(PasInterfacePrefix))=PasInterfacePrefix)
+  and (RightStr(Result,length(PasInterfaceSuffix))=PasInterfaceSuffix)
+  then
+    Result:=copy(Result,length(PasInterfacePrefix)+1,length(Result)-length(PasInterfacePrefix)-length(PasInterfaceSuffix));
+  Result:=ClassPrefix+Result+ClassSuffix;
 end;
 
 function TWebIDLToPasWasmJob.ComputeGUID(const Prefix: string;
@@ -209,21 +228,35 @@ 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
-    Result:=inherited GetTypeName(aTypeName,ForTypeDef);
-    if (Result=aTypeName) and (LeftStr(Result,length(ClassPrefix))<>ClassPrefix) then
-      Result:=ClassPrefix+Result+ClassSuffix;
+    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);
+      writeln('AAA1 TWebIDLToPasWasmJob.GetTypeName Result=',Result);
+      if (Result=aTypeName)
+      and (LeftStr(Result,length(PasInterfacePrefix))<>PasInterfacePrefix)
+      and (RightStr(Result,length(PasInterfaceSuffix))<>PasInterfaceSuffix)
+      then
+        Result:=PasInterfacePrefix+Result+PasInterfaceSuffix;
+      end;
+    writeln('AAA2 TWebIDLToPasWasmJob.GetTypeName Result=',Result);
   end;
 end;
 
 function TWebIDLToPasWasmJob.GetPasIntfName(Intf: TIDLDefinition): string;
 begin
-  Result:=ClassToPasIntfName(GetName(Intf));
+  Result:=GetPasClassName(GetName(Intf));
 end;
 
 function TWebIDLToPasWasmJob.GetInterfaceDefHead(Intf: TIDLInterfaceDefinition
@@ -261,14 +294,11 @@ begin
 
   Decl:=aPasIntfName+' = interface';
   if Assigned(Intf.ParentInterface) then
-    ParentName:=GetName(Intf.ParentInterface)
+    ParentName:=GetPasIntfName(Intf.ParentInterface as TIDLInterfaceDefinition)
   else
     ParentName:=GetTypeName(Intf.ParentName);
   if ParentName<>'' then
-    begin
-    ParentName:=ClassToPasIntfName(ParentName);
     Decl:=Decl+'('+ParentName+')';
-    end;
   AddLn(Decl);
 
   Indent;
@@ -381,7 +411,7 @@ Var
   I: Integer;
   AddFuncBody: Boolean;
   ArgDefList: TIDLDefinitionList;
-  CurDef, ArgType, ReturnDef: TIDLDefinition;
+  CurDef, ArgType: TIDLDefinition;
   ArgDef: TIDLArgumentDefinition absolute CurDef;
 begin
   Result:=True;
@@ -415,9 +445,6 @@ begin
       end;
     else
       InvokeName:='InvokeJSObjectResult';
-      ReturnDef:=FindGlobalDef(aDef.ReturnType.TypeName);
-      if ReturnDef is TIDLInterfaceDefinition then
-        RT:=ClassToPasIntfName(RT);
     end;
 
     end;
@@ -520,7 +547,7 @@ function TWebIDLToPasWasmJob.WriteFunctionTypeDefinition(
   aDef: TIDLFunctionDefinition): Boolean;
 var
   FN, RT, ArgName, VarSection, FetchArgs, Params, Call, Code,
-    ArgTypeName, GetFunc, aClassName: String;
+    ArgTypeName, GetFunc: String;
   Data: TPasDataWasmJob;
   Args: TIDLDefinitionList;
   ArgDef: TIDLArgumentDefinition;
@@ -534,8 +561,6 @@ begin
   if (RT='void') then
     RT:='';
   ReturnDef:=FindGlobalDef(aDef.ReturnType.TypeName);
-  if ReturnDef is TIDLInterfaceDefinition then
-    RT:=ClassToPasIntfName(RT);
   Args:=aDef.Arguments;
 
   Params:=GetArguments(aDef.Arguments,False);
@@ -587,11 +612,7 @@ begin
       else
         CurDef:=FindGlobalDef(ArgDef.ArgumentType.TypeName);
         if CurDef is TIDLInterfaceDefinition then
-          begin
-          aClassName:=ArgTypeName;
-          ArgTypeName:=ClassToPasIntfName(aClassName);
-          GetFunc:='GetObject('+aClassName+') as '+ArgTypeName;
-          end
+          GetFunc:='GetObject('+IntfToPasClassName(ArgTypeName)+') as '+ArgTypeName
         else
           raise EWebIDLParser.Create('not yet supported: function type arg['+IntToStr(I)+'] type '+ArgDef.ArgumentType.TypeName+' at '+GetDefPos(ArgDef));
       end;
@@ -649,7 +670,6 @@ function TWebIDLToPasWasmJob.WritePrivateGetter(Attr: TIDLAttributeDefinition
 var
   FuncName, TypeName, aClassName, Code, ReadFuncName, Call: String;
   Data: TPasDataWasmJob;
-  TypeDef: TIDLDefinition;
 begin
   Result:=true;
   if Attr.AttributeType=nil then
@@ -658,9 +678,6 @@ begin
 
   FuncName:=GetterPrefix+GetName(Attr);
   TypeName:=GetTypeName(Attr.AttributeType);
-  TypeDef:=FindGlobalDef(Attr.AttributeType.TypeName);
-  if TypeDef is TIDLInterfaceDefinition then
-    TypeName:=ClassToPasIntfName(TypeName);
 
   AddLn('function '+FuncName+': '+TypeName+';');
 
@@ -704,7 +721,6 @@ function TWebIDLToPasWasmJob.WritePrivateSetter(Attr: TIDLAttributeDefinition
 var
   FuncName, TypeName, aClassName, WriteFuncName, Code, Call: String;
   Data: TPasDataWasmJob;
-  TypeDef: TIDLDefinition;
 begin
   if aoReadOnly in Attr.Options then
     exit(false);
@@ -715,9 +731,6 @@ begin
   Result:=true;
   FuncName:=SetterPrefix+GetName(Attr);
   TypeName:=GetTypeName(Attr.AttributeType);
-  TypeDef:=FindGlobalDef(Attr.AttributeType.TypeName);
-  if TypeDef is TIDLInterfaceDefinition then
-    TypeName:=ClassToPasIntfName(TypeName);
   AddLn('Procedure '+FuncName+'(const aValue: '+TypeName+');');
 
   if Data.SetterBody<>'' then exit;
@@ -759,7 +772,6 @@ function TWebIDLToPasWasmJob.WriteProperty(Attr: TIDLAttributeDefinition
   ): boolean;
 var
   PropName, TypeName, Code: String;
-  TypeDef: TIDLDefinition;
 begin
   if Attr.AttributeType=nil then
     begin
@@ -768,9 +780,6 @@ begin
     end;
   PropName:=GetName(Attr);
   TypeName:=GetTypeName(Attr.AttributeType);
-  TypeDef:=FindGlobalDef(Attr.AttributeType.TypeName);
-  if TypeDef is TIDLInterfaceDefinition then
-    TypeName:=ClassToPasIntfName(TypeName);
   Code:='Property '+PropName+': '+TypeName+' read '+GetterPrefix+PropName;
   if not (aoReadOnly in Attr.Options) then
     Code:=Code+' write '+SetterPrefix+PropName;