1{
2    This file is part of the Free Component Library (FCL)
3    Copyright (c) 2018  Mattias Gaertner  mattias@freepascal.org
4
5    Pascal to Javascript converter class.
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************
15
16  Abstract:
17    Extends the FCL Pascal parser for the language subset of pas2js.
18}
19unit Pas2jsPParser;
20
21{$mode objfpc}{$H+}
22
23{$i pas2js_defines.inc}
24
25interface
26
27uses
28  Classes, SysUtils, PParser, PScanner, PasTree, PasResolver, fppas2js,
29  Pas2jsLogger;
30
31const // Messages
32  nFinalizationNotSupported = 3001;
33  sFinalizationNotSupported = 'Finalization section is not supported.';
34
35type
36
37  { TPas2jsPasParser }
38
39  TPas2jsPasParser = class(TPasParser)
40  private
41    FLog: TPas2jsLogger;
42  public
43    constructor Create(AScanner: TPascalScanner;
44      AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer); reintroduce;
45    procedure RaiseParserError(MsgNumber: integer;
46      Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
47    procedure ParseSubModule(var Module: TPasModule);
48    property Log: TPas2jsLogger read FLog write FLog;
49  end;
50
51  TOnFindModule = function(const AUnitName, InFilename: String; NameExpr,
52      InFileExpr: TPasExpr): TPasModule of object;
53  TOnCheckSrcName = procedure(const aElement: TPasElement) of object;
54
55  { TPas2jsCompilerResolver }
56
57  TPas2jsCompilerResolver = class(TPas2JSResolver)
58  private
59    FLog: TPas2jsLogger;
60    FOnCheckSrcName: TOnCheckSrcName;
61    FOnFindModule: TOnFindModule;
62    FP2JParser: TPas2jsPasParser;
63  public
64    function CreateElement(AClass: TPTreeElement; const AName: String;
65      AParent: TPasElement; AVisibility: TPasMemberVisibility;
66      const ASrcPos: TPasSourcePos; TypeParams: TFPList = nil): TPasElement;
67      overload; override;
68    function FindModule(const aUnitname: String): TPasModule; override;
69    function FindUnit(const AName, InFilename: String; NameExpr,
70      InFileExpr: TPasExpr): TPasModule; override;
71    procedure UsedInterfacesFinished(Section: TPasSection); override;
72  public
73    Owner: TObject;
74    property OnFindModule: TOnFindModule read FOnFindModule write FOnFindModule;
75    property OnCheckSrcName: TOnCheckSrcName read FOnCheckSrcName write FOnCheckSrcName;
76    property Log: TPas2jsLogger read FLog write FLog;
77    property P2JParser: TPas2jsPasParser read FP2JParser write FP2JParser;
78  end;
79
80procedure RegisterMessages(Log: TPas2jsLogger);
81
82implementation
83
84procedure RegisterMessages(Log: TPas2jsLogger);
85var
86  LastMsgNumber: integer;
87
88  procedure r(MsgType: TMessageType; MsgNumber: integer; const MsgPattern: string);
89  var
90    s: String;
91  begin
92    if (LastMsgNumber>=0) and (MsgNumber<>LastMsgNumber+1) then
93      begin
94      s:='gap in registered message numbers: '+IntToStr(LastMsgNumber)+' '+IntToStr(MsgNumber);
95      {AllowWriteln}
96      writeln('Pas2jsPParser.RegisterMessages ',s);
97      {AllowWriteln-}
98      raise Exception.Create(s);
99      end;
100    Log.RegisterMsg(MsgType,MsgNumber,MsgPattern);
101    LastMsgNumber:=MsgNumber;
102  end;
103
104begin
105  LastMsgNumber:=-1;
106  r(mtError,nFinalizationNotSupported,sFinalizationNotSupported);
107end;
108
109{ TPas2jsPasParser }
110
111constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;
112  AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
113begin
114  inherited Create(AScanner,AFileResolver,AEngine);
115  Options:=Options+po_pas2js;
116end;
117
118procedure TPas2jsPasParser.RaiseParserError(MsgNumber: integer;
119  Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
120var
121  Msg: TPas2jsMessage;
122begin
123  Msg:=Log.FindMsg(MsgNumber,true);
124  SetLastMsg(Msg.Typ,MsgNumber,Msg.Pattern,Args);
125  raise EParserError.Create(LastMsg,Scanner.CurFilename,
126                            Scanner.CurRow,Scanner.CurColumn);
127end;
128
129procedure TPas2jsPasParser.ParseSubModule(var Module: TPasModule);
130begin
131  Module:=nil;
132  NextToken;
133  SaveComments;
134  case CurToken of
135  tkUnit:
136    ParseUnit(Module);
137  tkLibrary:
138    ParseLibrary(Module);
139  else
140    CheckToken(tkUnit);
141  end;
142end;
143
144{ TPas2jsCompilerResolver }
145
146function TPas2jsCompilerResolver.CreateElement(AClass: TPTreeElement;
147  const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility;
148  const ASrcPos: TPasSourcePos; TypeParams: TFPList): TPasElement;
149begin
150  if AClass=TFinalizationSection then
151    (CurrentParser as TPas2jsPasParser).RaiseParserError(nFinalizationNotSupported,[]);
152  Result:=inherited CreateElement(AClass,AName,AParent,AVisibility,ASrcPos,TypeParams);
153  if (Result is TPasModule) then
154    OnCheckSrcName(Result);
155end;
156
157function TPas2jsCompilerResolver.FindModule(const aUnitname: String): TPasModule;
158begin
159  raise EPasResolve.Create('Call TPas2jsCompilerResolver.FindModule(name,expr,...) instead');
160  Result:=nil;
161  if aUnitname='' then ;
162end;
163
164function TPas2jsCompilerResolver.FindUnit(const AName, InFilename: String;
165  NameExpr, InFileExpr: TPasExpr): TPasModule;
166begin
167  Result:=OnFindModule(AName,InFilename,NameExpr,InFileExpr);
168end;
169
170procedure TPas2jsCompilerResolver.UsedInterfacesFinished(Section: TPasSection);
171begin
172  if Section=nil then ;
173end;
174
175end.
176
177