pastojs: filer: restore procedure body

git-svn-id: trunk@38390 -

packages/pastojs/src/fppas2js.pp

@@ -829,7 +829,10 @@ type
   public
     ResultVarName: string; // valid in implementation ProcScope, empty means use ResolverResultVar
     // Option coStoreProcJS
-    BodyJS: string;// stored in ImplScope
+    BodyJS: string; // stored in ImplScope
+    GlobalJS: TStringList; // stored in ImplScope
+    procedure AddGlobalJS(const JS: string);
+    destructor Destroy; override;
   end;
 
   { TPas2JSWithExprScope }
@@ -1360,6 +1363,7 @@ type
     Function CreatePropertyGet(Prop: TPasProperty; Ref: TResolvedReference;
       AContext: TConvertContext; PosEl: TPasElement): TJSElement; virtual;
     Procedure StorePrecompiledProcedure(ImplProc: TPasProcedure; JS: TJSElement); virtual;
+    Function StorePrecompiledJS(El: TJSElement): string; virtual;
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
@@ -1545,6 +1549,21 @@ begin
   while (Result>0) and (s[Result]<>c) do dec(Result);
 end;
 
+{ TPas2JSProcedureScope }
+
+procedure TPas2JSProcedureScope.AddGlobalJS(const JS: string);
+begin
+  if GlobalJS=nil then
+    GlobalJS:=TStringList.Create;
+  GlobalJS.Add(Js);
+end;
+
+destructor TPas2JSProcedureScope.Destroy;
+begin
+  FreeAndNil(GlobalJS);
+  inherited Destroy;
+end;
+
 { TFCLocalVar }
 
 constructor TFCLocalVar.Create(const aName: string; TheEl: TPasElement);
@@ -9490,9 +9509,9 @@ var
 Var
   FS : TJSFunctionDeclarationStatement;
   FD : TJSFuncDef;
-  n, i:Integer;
+  n, i, Line, Col:Integer;
   AssignSt: TJSSimpleAssignStatement;
-  FuncContext: TFunctionContext;
+  FuncContext, ConstContext: TFunctionContext;
   ProcScope, ImplProcScope: TPas2JSProcedureScope;
   Arg: TPasArgument;
   SelfSt: TJSVariableStatement;
@@ -9503,6 +9522,8 @@ Var
   ClassPath: String;
   ArgResolved: TPasResolverResult;
   MinVal, MaxVal: MaxPrecInt;
+  Lit: TJSLiteral;
+  ConstSrcElems: TJSSourceElements;
 begin
   Result:=nil;
 
@@ -9522,6 +9543,36 @@ begin
     ImplProc:=ProcScope.ImplProc;
   ImplProcScope:=TPas2JSProcedureScope(ImplProc.CustomData);
 
+  if ImplProcScope.BodyJS<>'' then
+    begin
+    // using precompiled code
+    TPasResolver.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
+    if ImplProcScope.GlobalJS<>nil then
+      begin
+      ConstContext:=AContext.GetGlobalFunc;
+      if not (ConstContext.JSElement is TJSSourceElements) then
+        begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TPasToJSConverter.ConvertProcedure ConstContext=',GetObjName(ConstContext),' JSElement=',GetObjName(ConstContext.JSElement));
+        {$ENDIF}
+        RaiseNotSupported(El,AContext,20180228231008);
+        end;
+      ConstSrcElems:=TJSSourceElements(ConstContext.JSElement);
+      for i:=0 to ImplProcScope.GlobalJS.Count-1 do
+        begin
+        // precompiled global var or type
+        Lit:=TJSLiteral.Create(Line,Col,El.SourceFilename);
+        Lit.Value.CustomValue:=UTF8Decode(ImplProcScope.GlobalJS[i]);
+        AddToSourceElements(ConstSrcElems,Lit);
+        end;
+      end;
+    // precompiled body
+    Lit:=TJSLiteral.Create(Line,Col,El.SourceFilename);
+    Lit.Value.CustomValue:=UTF8Decode(ImplProcScope.BodyJS);
+    Result:=Lit;
+    exit;
+    end;
+
   AssignSt:=nil;
   if AContext.IsGlobal then
     begin
@@ -9632,8 +9683,11 @@ begin
     end;
     end;
 
-  if coStoreProcJS in Options then
-    StorePrecompiledProcedure(ImplProc,Result);
+  if (coStoreProcJS in Options) and (AContext.Resolver<>nil) then
+    begin
+    if AContext.Resolver.GetTopLvlProc(El)=El then
+      StorePrecompiledProcedure(ImplProc,Result);
+    end;
 end;
 
 function TPasToJSConverter.ConvertBeginEndStatement(El: TPasImplBeginBlock;
@@ -11029,19 +11083,25 @@ procedure TPasToJSConverter.StorePrecompiledProcedure(ImplProc: TPasProcedure;
   JS: TJSElement);
 var
   ImplScope: TPas2JSProcedureScope;
-  aWriter: TBufferWriter;
-  aJSWriter: TJSWriter;
 begin
   ImplScope:=TPas2JSProcedureScope(ImplProc.CustomData);
   if ImplScope.ImplProc<>nil then
     RaiseInconsistency(20180228124545,ImplProc);
+  ImplScope.BodyJS:=StorePrecompiledJS(JS);
+end;
+
+function TPasToJSConverter.StorePrecompiledJS(El: TJSElement): string;
+var
+  aWriter: TBufferWriter;
+  aJSWriter: TJSWriter;
+begin
   aJSWriter:=nil;
   aWriter:=TBufferWriter.Create(1000);
   try
     aJSWriter:=TJSWriter.Create(aWriter);
     aJSWriter.IndentSize:=2;
-    aJSWriter.WriteJS(JS);
-    ImplScope.BodyJS:=aWriter.AsAnsistring;
+    aJSWriter.WriteJS(El);
+    Result:=aWriter.AsAnsistring;
   finally
     aJSWriter.Free;
     aWriter.Free;
@@ -13685,6 +13745,8 @@ Var
   C: TJSElement;
   V: TJSVariableStatement;
   Src: TJSSourceElements;
+  Proc: TPasProcedure;
+  ProcScope: TPas2JSProcedureScope;
 begin
   Result:=nil;
   if El.AbsoluteExpr<>nil then
@@ -13705,6 +13767,16 @@ begin
     V:=TJSVariableStatement(CreateElement(TJSVariableStatement,El));
     V.A:=C;
     AddToSourceElements(Src,V);
+
+    if (coStoreProcJS in Options) and (AContext.Resolver<>nil) then
+      begin
+      Proc:=AContext.Resolver.GetTopLvlProc(AContext.PasElement);
+      if Proc<>nil then
+        begin
+        ProcScope:=TPas2JSProcedureScope(Proc.CustomData);
+        ProcScope.AddGlobalJS(StorePrecompiledJS(V));
+        end;
+      end;
     end
   else if AContext is TObjectContext then
     begin

packages/pastojs/src/pas2jsfiler.pp

@@ -28,14 +28,11 @@ Works:
 - restore resolved references and access flags
 - useanalyzer: use restored proc references
 - write+read compiled proc body
+- converter: use precompiled body
+- store/restore/use precompiled JS of proc bodies
+- store/restore/use precompiled JS of proc local const
 
 ToDo:
-- store converted proc implementation
-  - store references
-  - code
-  - local const
-- store only used elements, not unneeded privates
-- use stored converted proc implementation
 - WPO uses Proc.References
 - store converted initialization/finalization
 - use stored converted initialization/finalization
@@ -2936,8 +2933,14 @@ begin
     // precompiled body
     if Scope.BodyJS<>'' then
       begin
+      if Scope.GlobalJS<>nil then
+        begin
+        Arr:=TJSONArray.Create;
+        Obj.Add('Globals',Arr);
+        for i:=0 to Scope.GlobalJS.Count-1 do
+          Arr.Add(Scope.GlobalJS[i]);
+        end;
       Obj.Add('Body',Scope.BodyJS);
-      // ToDo: globals
       end;
     end;
   if (Scope.BodyJS<>'') and (Scope.ImplProc<>nil) then
@@ -5795,11 +5798,28 @@ procedure TPJUReader.ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure;
 var
   ImplScope: TPas2JSProcedureScope;
   s: string;
+  Arr: TJSONArray;
+  i: Integer;
+  Data: TJSONData;
 begin
   ImplScope:=TPas2JSProcedureScope(El.CustomData);
+  if ImplScope.BodyJS<>'' then
+    RaiseMsg(20180228231510,El);
+  if ImplScope.GlobalJS<>nil then
+    RaiseMsg(20180228231511,El);
   if not ReadString(Obj,'Body',s,El) then
     RaiseMsg(20180228131232,El);
   ImplScope.BodyJS:=s;
+  if ReadArray(Obj,'Globals',Arr,El) then
+    begin
+    for i:=0 to Arr.Count-1 do
+      begin
+      Data:=Arr[i];
+      if not (Data is TJSONString) then
+        RaiseMsg(20180228231555,El,IntToStr(i)+':'+GetObjName(Data));
+      ImplScope.AddGlobalJS(Data.AsString);
+      end;
+    end;
   if aContext=nil then ;
 end;
 

packages/pastojs/tests/tcfiler.pas

@@ -26,7 +26,7 @@ uses
   Classes, SysUtils, fpcunit, testregistry,
   PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
   FPPas2Js, Pas2JsFiler,
-  tcmodules;
+  tcmodules, jstree;
 
 type
 
@@ -43,6 +43,8 @@ type
       out Count: integer);
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
+    function OnRestConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
+    function OnRestConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -51,6 +53,7 @@ type
     procedure WriteReadUnit; virtual;
     procedure StartParsing; override;
     function CheckRestoredObject(const Path: string; Orig, Rest: TObject): boolean; virtual;
+    procedure CheckRestoredJS(const Path, Orig, Rest: string); virtual;
     // check restored parser+resolver
     procedure CheckRestoredResolver(Original, Restored: TPas2JSResolver); virtual;
     procedure CheckRestoredDeclarations(const Path: string; Orig, Rest: TPasDeclarations); virtual;
@@ -135,6 +138,9 @@ type
     procedure TestPC_Record;
     procedure TestPC_JSValue;
     procedure TestPC_Proc;
+    procedure TestPC_Proc_Nested;
+    procedure TestPC_Proc_LocalConst;
+    procedure TestPC_Proc_UTF8;
     procedure TestPC_Class;
   end;
 
@@ -183,6 +189,18 @@ begin
   Result:=Analyzer.IsTypeInfoUsed(El);
 end;
 
+function TCustomTestPrecompile.OnRestConverterIsElementUsed(Sender: TObject;
+  El: TPasElement): boolean;
+begin
+  Result:=RestAnalyzer.IsUsed(El);
+end;
+
+function TCustomTestPrecompile.OnRestConverterIsTypeInfoUsed(Sender: TObject;
+  El: TPasElement): boolean;
+begin
+  Result:=RestAnalyzer.IsTypeInfoUsed(El);
+end;
+
 procedure TCustomTestPrecompile.SetUp;
 begin
   inherited SetUp;
@@ -218,12 +236,14 @@ end;
 procedure TCustomTestPrecompile.WriteReadUnit;
 var
   ms: TMemoryStream;
-  PJU: string;
+  PJU, RestJSSrc, OrigJSSrc: string;
   // restored classes:
   RestResolver: TTestEnginePasResolver;
   RestFileResolver: TFileResolver;
   RestScanner: TPascalScanner;
   RestParser: TPasParser;
+  RestConverter: TPasToJSConverter;
+  RestJSModule: TJSSourceElements;
 begin
   ConvertUnit;
 
@@ -234,6 +254,8 @@ begin
   RestScanner:=nil;
   RestResolver:=nil;
   RestFileResolver:=nil;
+  RestConverter:=nil;
+  RestJSModule:=nil;
   try
     try
       PJUWriter.OnGetSrc:=@OnFilerGetSrc;
@@ -278,13 +300,56 @@ begin
       end;
     end;
 
+    // analyze
     FRestAnalyzer:=TPasAnalyzer.Create;
     FRestAnalyzer.Resolver:=RestResolver;
-    RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
+    try
+      RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
+    except
+      on E: Exception do
+      begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TCustomTestPrecompile.WriteReadUnit ANALYZEMODULE failed');
+        {$ENDIF}
+        Fail('AnalyzeModule precompiled failed('+E.ClassName+'): '+E.Message);
+      end;
+    end;
+    // check parser+resolver+analyzer
     CheckRestoredResolver(Engine,RestResolver);
 
-    // ToDo: compare converter
+    // convert using the precompiled procs
+    RestConverter:=CreateConverter;
+    RestConverter.OnIsElementUsed:=@OnRestConverterIsElementUsed;
+    RestConverter.OnIsTypeInfoUsed:=@OnRestConverterIsTypeInfoUsed;
+    try
+      RestJSModule:=RestConverter.ConvertPasElement(RestResolver.RootElement,RestResolver) as TJSSourceElements;
+    except
+      on E: Exception do
+      begin
+        {$IFDEF VerbosePas2JS}
+        writeln('TCustomTestPrecompile.WriteReadUnit CONVERTER failed');
+        {$ENDIF}
+        Fail('Convert precompiled failed('+E.ClassName+'): '+E.Message);
+      end;
+    end;
+
+    OrigJSSrc:=JSToStr(JSModule);
+    RestJSSrc:=JSToStr(RestJSModule);
+
+    if OrigJSSrc<>RestJSSrc then
+      begin
+      writeln('TCustomTestPrecompile.WriteReadUnit OrigJSSrc:---------START');
+      writeln(OrigJSSrc);
+      writeln('TCustomTestPrecompile.WriteReadUnit OrigJSSrc:---------END');
+      writeln('TCustomTestPrecompile.WriteReadUnit RestJSSrc:---------START');
+      writeln(RestJSSrc);
+      writeln('TCustomTestPrecompile.WriteReadUnit RestJSSrc:---------END');
+      CheckDiff('WriteReadUnit JS diff',OrigJSSrc,RestJSSrc);
+      end;
+
   finally
+    RestJSModule.Free;
+    RestConverter.Free;
     FreeAndNil(FRestAnalyzer);
     RestParser.Free;
     RestScanner.Free;
@@ -322,6 +387,37 @@ begin
   Result:=true;
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredJS(const Path, Orig, Rest: string);
+var
+  OrigList, RestList: TStringList;
+  i: Integer;
+begin
+  if Orig=Rest then exit;
+  writeln('TCustomTestPrecompile.CheckRestoredJS ORIG START--------------');
+  writeln(Orig);
+  writeln('TCustomTestPrecompile.CheckRestoredJS ORIG END----------------');
+  writeln('TCustomTestPrecompile.CheckRestoredJS REST START--------------');
+  writeln(Rest);
+  writeln('TCustomTestPrecompile.CheckRestoredJS REST END----------------');
+  OrigList:=TStringList.Create;
+  RestList:=TStringList.Create;
+  try
+    OrigList.Text:=Orig;
+    RestList.Text:=Rest;
+    for i:=0 to OrigList.Count-1 do
+      begin
+      if i>=RestList.Count then
+        Fail(Path+' missing: '+OrigList[i]);
+      writeln('  ',i,': '+OrigList[i]);
+      end;
+    if OrigList.Count<RestList.Count then
+      Fail(Path+' too much: '+RestList[OrigList.Count]);
+ finally
+    OrigList.Free;
+    RestList.Free;
+  end;
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
   Restored: TPas2JSResolver);
 begin
@@ -520,32 +616,25 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string;
   Orig, Rest: TPas2JSProcedureScope);
 var
-  OrigList, RestList: TStringList;
   i: Integer;
 begin
   CheckRestoredReference(Path+'.DeclarationProc',Orig.DeclarationProc,Rest.DeclarationProc);
   CheckRestoredReference(Path+'.ImplProc',Orig.ImplProc,Rest.ImplProc);
   CheckRestoredProcScopeRefs(Path+'.References',Orig,Rest);
   if Orig.BodyJS<>Rest.BodyJS then
+    CheckRestoredJS(Path+'.BodyJS',Orig.BodyJS,Rest.BodyJS);
+
+  CheckRestoredObject(Path+'.GlobalJS',Orig.GlobalJS,Rest.GlobalJS);
+  if Orig.GlobalJS<>nil then
     begin
-    writeln('TCustomTestPrecompile.CheckRestoredProcScope ',Path,'.BodyJS diff:');
-    OrigList:=TStringList.Create;
-    RestList:=TStringList.Create;
-    try
-      OrigList.Text:=Orig.BodyJS;
-      RestList.Text:=Rest.BodyJS;
-      for i:=0 to OrigList.Count-1 do
-        begin
-        if i>=RestList.Count then
-          Fail(Path+'.BodyJS RestLine missing: '+OrigList[i]);
-        writeln('  ',i,': '+OrigList[i]);
-        end;
-      if OrigList.Count<RestList.Count then
-        Fail(Path+'.BodyJS RestLine too much: '+RestList[OrigList.Count]);
-   finally
-      OrigList.Free;
-      RestList.Free;
-    end;
+    for i:=0 to Orig.GlobalJS.Count-1 do
+      begin
+      if i>=Rest.GlobalJS.Count then
+        Fail(Path+'.GlobalJS['+IntToStr(i)+'] missing: '+Orig.GlobalJS[i]);
+      CheckRestoredJS(Path+'.GlobalJS['+IntToStr(i)+']',Orig.GlobalJS[i],Rest.GlobalJS[i]);
+      end;
+    if Orig.GlobalJS.Count<Rest.GlobalJS.Count then
+      Fail(Path+'.GlobalJS['+IntToStr(i)+'] too much: '+Rest.GlobalJS[Orig.GlobalJS.Count]);
     end;
 
   if Rest.DeclarationProc=nil then
@@ -567,7 +656,6 @@ begin
     begin
     // ImplProc
     end;
-
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredProcScopeRefs(const Path: string;
@@ -1438,6 +1526,73 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Proc_Nested;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  '  function GetIt(d: longint): longint;',
+  'implementation',
+  'var k: double;',
+  'function GetIt(d: longint): longint;',
+  'var j: double;',
+  '  function GetSum(a,b: longint): longint; forward;',
+  '  function GetMul(a,b: longint): longint; ',
+  '  begin',
+  '    Result:=a*b;',
+  '  end;',
+  '  function GetSum(a,b: longint): longint;',
+  '  begin',
+  '    Result:=a+b;',
+  '  end;',
+  '  procedure NotUsed;',
+  '  begin',
+  '  end;',
+  'begin',
+  '  Result:=GetMul(GetSum(d,2),3);',
+  'end;',
+  'procedure NotUsed;',
+  'begin',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_Proc_LocalConst;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  '  function GetIt(d: double): double;',
+  'implementation',
+  'function GetIt(d: double): double;',
+  'const',
+  '  c: double = 3.3;',
+  '  e: double = 2.7;', // e is not used
+  'begin',
+  '  Result:=d+c;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_Proc_UTF8;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  '  function DoIt: string;',
+  'implementation',
+  'function DoIt: string;',
+  'const',
+  '  c = ''äöü😊'';',
+  'begin',
+  '  Result:=''ÄÖÜ😊''+c;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Class;
 begin
   StartUnit(false);