Browse Source

webidl: wasmjob: dictionary

mattias 3 years ago
parent
commit
8abe70e25a
2 changed files with 62 additions and 20 deletions
  1. 28 11
      packages/webidl/src/webidltopas.pp
  2. 34 9
      packages/webidl/src/webidltowasmjob.pp

+ 28 - 11
packages/webidl/src/webidltopas.pp

@@ -105,6 +105,7 @@ type
     function GetTypeName(Const aTypeName: String; ForTypeDef: Boolean=False): 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 GetTypeName(aTypeDef: TIDLTypeDefDefinition; ForTypeDef: Boolean=False): String; overload; virtual;
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String; virtual;
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String; virtual;
+    function GetDictionaryDefHead(const CurClassName: string; Dict: TIDLDictionaryDefinition): String; virtual;
     function CheckUnionTypeDefinition(D: TIDLDefinition): TIDLUnionTypeDefDefinition; virtual;
     function CheckUnionTypeDefinition(D: TIDLDefinition): TIDLUnionTypeDefDefinition; virtual;
     procedure AddArgumentToOverloads(aList: TFPObjectlist; AName, ATypeName: String; PosEl: TIDLBaseObject); overload; virtual;
     procedure AddArgumentToOverloads(aList: TFPObjectlist; AName, ATypeName: String; PosEl: TIDLBaseObject); overload; virtual;
     procedure AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition); overload; virtual;
     procedure AddArgumentToOverloads(aList: TFPObjectlist; aDef: TIDLArgumentDefinition); overload; virtual;
@@ -118,7 +119,7 @@ type
     function WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function WriteAttributeImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function WriteAttributeImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
     function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer; virtual;
     function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer; virtual;
-    function WriteDictionaryMemberImplicitTypes(aList: TIDLDefinitionList): Integer; virtual;
+    function WriteDictionaryMemberImplicitTypes(aDict: TIDLDictionaryDefinition; aList: TIDLDefinitionList): Integer; virtual;
     function WriteCallBackDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteCallBackDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteDictionaryDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteDictionaryDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteForwardClassDefs(aList: TIDLDefinitionList): Integer; virtual;
     function WriteForwardClassDefs(aList: TIDLDefinitionList): Integer; virtual;
@@ -335,7 +336,7 @@ begin
 end;
 end;
 
 
 function TBaseWebIDLToPas.WriteDictionaryMemberImplicitTypes(
 function TBaseWebIDLToPas.WriteDictionaryMemberImplicitTypes(
-  aList: TIDLDefinitionList): Integer;
+  aDict: TIDLDictionaryDefinition; aList: TIDLDefinitionList): Integer;
 
 
 Var
 Var
   D: TIDLDefinition;
   D: TIDLDefinition;
@@ -343,6 +344,7 @@ Var
 
 
 begin
 begin
   Result:=0;
   Result:=0;
+  if aDict=nil then ;
   for D in aList do
   for D in aList do
     if D is TIDLDictionaryMemberDefinition then
     if D is TIDLDictionaryMemberDefinition then
       if (FD.MemberType is TIDLSequenceTypeDefDefinition) then
       if (FD.MemberType is TIDLSequenceTypeDefDefinition) then
@@ -618,7 +620,7 @@ function TBaseWebIDLToPas.WriteDictionaryDef(aDict: TIDLDictionaryDefinition
   ): Boolean;
   ): Boolean;
 
 
 Var
 Var
-  CurClassName,CurParent: String;
+  CurClassName, Decl: String;
   DefList: TIDLDefinitionList;
   DefList: TIDLDefinitionList;
   CurDefs: TIDLDictionaryDefinition;
   CurDefs: TIDLDictionaryDefinition;
 
 
@@ -633,15 +635,11 @@ begin
       CurDefs:=CurDefs.ParentDictionary;
       CurDefs:=CurDefs.ParentDictionary;
       end;
       end;
     CurClassName:=GetName(aDict);
     CurClassName:=GetName(aDict);
-    CurParent:=DictionaryClassParent;
-    if CurParent='' then
-      CurParent:='TJSObject';
     ClassComment(CurClassName);
     ClassComment(CurClassName);
-    WriteDictionaryMemberImplicitTypes(DefList);
-    if (coDictionaryAsClass in BaseOptions) then
-      Addln('%s = class(%s)',[CurClassName,CurParent])
-    else
-      Addln('%s = record',[CurClassName]);
+    WriteDictionaryMemberImplicitTypes(aDict, DefList);
+    // class and ancestor
+    Decl:=GetDictionaryDefHead(CurClassName,aDict);
+    AddLn(Decl);
     WriteDictionaryFields(DefList);
     WriteDictionaryFields(DefList);
     AddLn('end;');
     AddLn('end;');
   finally
   finally
@@ -718,6 +716,24 @@ begin
   if Intf=nil then ;
   if Intf=nil then ;
 end;
 end;
 
 
+function TBaseWebIDLToPas.GetDictionaryDefHead(const CurClassName: string;
+  Dict: TIDLDictionaryDefinition): String;
+var
+  CurParent: String;
+begin
+  if Dict=nil then ;
+  if (coDictionaryAsClass in BaseOptions) then
+    begin
+    CurParent:=DictionaryClassParent;
+    if CurParent='' then
+      CurParent:='TJSObject';
+    Result:='class('+CurParent+')'
+    end
+  else
+    Result:='record';
+  Result:=CurClassName+' = '+Result;
+end;
+
 function TBaseWebIDLToPas.GetTypeName(const aTypeName: String; ForTypeDef: Boolean
 function TBaseWebIDLToPas.GetTypeName(const aTypeName: String; ForTypeDef: Boolean
   ): String;
   ): String;
 
 
@@ -955,6 +971,7 @@ begin
     Arg:=Arg+': '+aTypeName;
     Arg:=Arg+': '+aTypeName;
     Def:=FindGlobalDef(A.ArgumentType.TypeName);
     Def:=FindGlobalDef(A.ArgumentType.TypeName);
     if (Def is TIDLFunctionDefinition)
     if (Def is TIDLFunctionDefinition)
+        or (Def is TIDLDictionaryDefinition)
         or SameText(aTypeName,'UnicodeString') then
         or SameText(aTypeName,'UnicodeString') then
       Arg:='const '+Arg;
       Arg:='const '+Arg;
     if Result<>'' then
     if Result<>'' then

+ 34 - 9
packages/webidl/src/webidltowasmjob.pp

@@ -28,7 +28,8 @@ type
     jjvkDouble,
     jjvkDouble,
     jjvkString,
     jjvkString,
     jjvkObject,
     jjvkObject,
-    jivkMethod
+    jivkMethod,
+    jjvkDictionary
     );
     );
   TJOB_JSValueKinds = set of TJOB_JSValueKind;
   TJOB_JSValueKinds = set of TJOB_JSValueKind;
 
 
@@ -39,15 +40,17 @@ const
     'Double',
     'Double',
     'String',
     'String',
     'Object',
     'Object',
-    'Method'
+    'Method',
+    'Dictionary'
     );
     );
   JOB_JSValueTypeNames: array[TJOB_JSValueKind] of string = (
   JOB_JSValueTypeNames: array[TJOB_JSValueKind] of string = (
     'TJOB_JSValue',
     'TJOB_JSValue',
-    'TJOB_JSValueBoolean',
-    'TJOB_JSValueDouble',
-    'TJOB_JSValueString',
-    'TJOB_JSValueObject',
-    'TJOB_JSValueMethod'
+    'TJOB_Boolean',
+    'TJOB_Double',
+    'TJOB_String',
+    'TJOB_Object',
+    'TJOB_Method',
+    'TJOB_Dictionary'
     );
     );
 type
 type
   TPasDataWasmJob = class(TPasData)
   TPasDataWasmJob = class(TPasData)
@@ -73,9 +76,13 @@ type
     function GetPasIntfName(Intf: TIDLDefinition): string;
     function GetPasIntfName(Intf: TIDLDefinition): string;
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String;
     function GetInterfaceDefHead(Intf: TIDLInterfaceDefinition): String;
       override;
       override;
+    function GetDictionaryDefHead(const CurClassName: string;
+      Dict: TIDLDictionaryDefinition): String; override;
     function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
     function WriteOtherImplicitTypes(Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
       override;
       override;
     // Code generation routines. Return the number of actually written defs.
     // Code generation routines. Return the number of actually written defs.
+    function WriteDictionaryMemberImplicitTypes(aDict: TIDLDictionaryDefinition;
+      aList: TIDLDefinitionList): Integer; override;
     function WritePrivateGetters(aList: TIDLDefinitionList): Integer; override;
     function WritePrivateGetters(aList: TIDLDefinitionList): Integer; override;
     function WritePrivateSetters(aList: TIDLDefinitionList): Integer; override;
     function WritePrivateSetters(aList: TIDLDefinitionList): Integer; override;
     function WriteProperties(aList: TIDLDefinitionList): Integer; override;
     function WriteProperties(aList: TIDLDefinitionList): Integer; override;
@@ -235,6 +242,13 @@ begin
   Result:=Result+','+aPasIntfName+')';
   Result:=Result+','+aPasIntfName+')';
 end;
 end;
 
 
+function TWebIDLToPasWasmJob.GetDictionaryDefHead(const CurClassName: string;
+  Dict: TIDLDictionaryDefinition): String;
+begin
+  Result:=CurClassName+'Rec = record';
+  if Dict=nil then ;
+end;
+
 function TWebIDLToPasWasmJob.WriteOtherImplicitTypes(
 function TWebIDLToPasWasmJob.WriteOtherImplicitTypes(
   Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
   Intf: TIDLInterfaceDefinition; aMemberList: TIDLDefinitionList): Integer;
 var
 var
@@ -277,6 +291,16 @@ begin
   AddLn('');
   AddLn('');
 end;
 end;
 
 
+function TWebIDLToPasWasmJob.WriteDictionaryMemberImplicitTypes(
+  aDict: TIDLDictionaryDefinition; aList: TIDLDefinitionList): Integer;
+var
+  aName: String;
+begin
+  Result:=inherited WriteDictionaryMemberImplicitTypes(aDict, aList);
+  aName:=GetName(aDict);
+  AddLn(aName+' = TJOB_Dictionary;');
+end;
+
 function TWebIDLToPasWasmJob.WritePrivateGetters(aList: TIDLDefinitionList
 function TWebIDLToPasWasmJob.WritePrivateGetters(aList: TIDLDefinitionList
   ): Integer;
   ): Integer;
 var
 var
@@ -447,9 +471,9 @@ begin
           if (ArgType is TIDLFunctionDefinition) and (foCallBack in TIDLFunctionDefinition(ArgType).Options) then
           if (ArgType is TIDLFunctionDefinition) and (foCallBack in TIDLFunctionDefinition(ArgType).Options) then
             begin
             begin
             LocalName:=CreateLocal('m');
             LocalName:=CreateLocal('m');
-            VarSection:=VarSection+'  '+LocalName+': TJOB_JSValueMethod;'+sLineBreak;
+            VarSection:=VarSection+'  '+LocalName+': '+JOB_JSValueTypeNames[jivkMethod]+';'+sLineBreak;
             WrapperFn:='JOBCall'+GetName(TIDLFunctionDefinition(ArgType));
             WrapperFn:='JOBCall'+GetName(TIDLFunctionDefinition(ArgType));
-            TryCode:=TryCode+'  '+LocalName+':=TJOB_JSValueMethod.Create(TMethod('+ArgName+'),@'+WrapperFn+');'+sLineBreak;
+            TryCode:=TryCode+'  '+LocalName+':='+JOB_JSValueTypeNames[jivkMethod]+'.Create(TMethod('+ArgName+'),@'+WrapperFn+');'+sLineBreak;
             FinallyCode:=FinallyCode+'    '+LocalName+'.free;'+sLineBreak;
             FinallyCode:=FinallyCode+'    '+LocalName+'.free;'+sLineBreak;
             ArgName:=LocalName;
             ArgName:=LocalName;
             end;
             end;
@@ -757,6 +781,7 @@ begin
   inherited Create(ThOwner);
   inherited Create(ThOwner);
   PasDataClass:=TPasDataWasmJob;
   PasDataClass:=TPasDataWasmJob;
   FPasInterfacePrefix:='IJS';
   FPasInterfacePrefix:='IJS';
+  BaseOptions:=BaseOptions+[coDictionaryAsClass];
 end;
 end;
 
 
 end.
 end.