Initial check in docu
This commit is contained in:
Binary file not shown.
|
After Width: | Height: | Size: 15 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 11 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 11 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 21 KiB |
@@ -0,0 +1,38 @@
|
||||
program wpTest;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
wpLex in '..\wpLex.pas',
|
||||
wpPar in '..\wpPar.pas',
|
||||
astProgram in '..\..\tools\ast\astProgram.pas',
|
||||
ast in '..\..\tools\ast\ast.pas';
|
||||
|
||||
var
|
||||
stm : TFileStream;
|
||||
lex : TwpLex;
|
||||
par : TwpPar;
|
||||
|
||||
begin
|
||||
try
|
||||
stm := TFileStream.Create('x.pas', fmOpenRead);
|
||||
stm.Seek(0, soFromBeginning);
|
||||
|
||||
lex := TwpLex.Create(stm);
|
||||
par := TwpPar.Create(lex);
|
||||
|
||||
par.prg;
|
||||
|
||||
stm.Free;
|
||||
lex.Free;
|
||||
par.Free;
|
||||
|
||||
|
||||
|
||||
except
|
||||
on E: Exception do
|
||||
Writeln(E.ClassName, ': ', E.Message);
|
||||
end;
|
||||
end.
|
||||
@@ -0,0 +1,107 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{E509B25A-366D-449B-B4C6-013162829AAF}</ProjectGuid>
|
||||
<ProjectVersion>12.0</ProjectVersion>
|
||||
<MainSource>wpTest.dpr</MainSource>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
|
||||
<Cfg_2>true</Cfg_2>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<DCC_DependencyCheckOutputName>wpTest.exe</DCC_DependencyCheckOutputName>
|
||||
<DCC_ImageBase>00400000</DCC_ImageBase>
|
||||
<DCC_UnitAlias>WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias)</DCC_UnitAlias>
|
||||
<DCC_Platform>x86</DCC_Platform>
|
||||
<DCC_E>false</DCC_E>
|
||||
<DCC_N>false</DCC_N>
|
||||
<DCC_S>false</DCC_S>
|
||||
<DCC_F>false</DCC_F>
|
||||
<DCC_K>false</DCC_K>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="wpTest.dpr">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="..\wpLex.pas"/>
|
||||
<DCCReference Include="..\wpPar.pas"/>
|
||||
<DCCReference Include="..\..\tools\ast\astProgram.pas"/>
|
||||
<DCCReference Include="..\..\tools\ast\ast.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Debug">
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Release">
|
||||
<Key>Cfg_1</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<Source>
|
||||
<Source Name="MainSource">wpTest.dpr</Source>
|
||||
</Source>
|
||||
<Parameters>
|
||||
<Parameters Name="UseLauncher">False</Parameters>
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">0</VersionInfo>
|
||||
<VersionInfo Name="Build">0</VersionInfo>
|
||||
<VersionInfo Name="Debug">False</VersionInfo>
|
||||
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||
<VersionInfo Name="Special">False</VersionInfo>
|
||||
<VersionInfo Name="Private">False</VersionInfo>
|
||||
<VersionInfo Name="DLL">False</VersionInfo>
|
||||
<VersionInfo Name="Locale">1031</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"/>
|
||||
<VersionInfoKeys Name="FileDescription"/>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"/>
|
||||
<VersionInfoKeys Name="LegalCopyright"/>
|
||||
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||
<VersionInfoKeys Name="OriginalFilename"/>
|
||||
<VersionInfoKeys Name="ProductName"/>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
</Delphi.Personality>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
</Project>
|
||||
@@ -0,0 +1,13 @@
|
||||
program prg1 (input,output);
|
||||
|
||||
label 1,4,5;
|
||||
|
||||
const
|
||||
a = 3.14;
|
||||
b = 'hello';
|
||||
c = d;
|
||||
asd = 12345;
|
||||
|
||||
begin
|
||||
|
||||
end.
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 16 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 13 KiB |
@@ -0,0 +1,607 @@
|
||||
unit wpLex;
|
||||
|
||||
interface
|
||||
uses
|
||||
Classes,
|
||||
SysUtils,
|
||||
Generics.Collections;
|
||||
|
||||
|
||||
type
|
||||
TTokenType =
|
||||
(
|
||||
TT_EOF,
|
||||
TT_SKIP,
|
||||
TT_COMMENT,
|
||||
|
||||
TT_LPAREN, // (
|
||||
TT_RPAREN, // )
|
||||
TT_LBRACKET, // [
|
||||
TT_RBRACKET, // ]
|
||||
|
||||
TT_STAR, // *
|
||||
TT_SLASH, // /
|
||||
TT_PLUS, // +
|
||||
TT_MINUS, // -
|
||||
|
||||
TT_LT, // <
|
||||
TT_LE, // <=
|
||||
TT_GT, // >
|
||||
TT_GE, // >=
|
||||
|
||||
TT_EQ, // =
|
||||
TT_NE, // <>
|
||||
|
||||
TT_COLON, // :
|
||||
TT_ASSIGN, // :=
|
||||
|
||||
TT_DOT, // .
|
||||
TT_RANGE, // ..
|
||||
TT_PTR, // ^
|
||||
TT_COMMA, // ,
|
||||
TT_SEMI, // ;
|
||||
TT_DOLLAR, // $
|
||||
TT_AT, // @
|
||||
TT_SHARP, // #
|
||||
|
||||
TT_ID,
|
||||
TT_UINT,
|
||||
TT_UREAL,
|
||||
TT_CHAR,
|
||||
TT_STRING,
|
||||
TT_HEX,
|
||||
TT_BIN,
|
||||
|
||||
LT_DO,
|
||||
LT_IF,
|
||||
LT_IN,
|
||||
LT_OF,
|
||||
LT_OR,
|
||||
LT_TO,
|
||||
|
||||
LT_AND,
|
||||
LT_DIV,
|
||||
LT_END,
|
||||
LT_FOR,
|
||||
LT_MOD,
|
||||
LT_NIL,
|
||||
LT_NOT,
|
||||
LT_SET,
|
||||
LT_VAR,
|
||||
LT_XOR,
|
||||
|
||||
LT_CASE,
|
||||
LT_ELSE,
|
||||
LT_FILE,
|
||||
LT_GOTO,
|
||||
LT_THEN,
|
||||
LT_TYPE,
|
||||
LT_USES,
|
||||
LT_WITH,
|
||||
|
||||
LT_ARRAY,
|
||||
LT_BEGIN,
|
||||
LT_CONST,
|
||||
LT_LABEL,
|
||||
LT_UNTIL,
|
||||
LT_WHILE,
|
||||
|
||||
LT_DOWNTO,
|
||||
LT_PACKED,
|
||||
LT_RECORD,
|
||||
LT_REPEAT,
|
||||
|
||||
LT_PROGRAM,
|
||||
LT_FUNCTION,
|
||||
LT_PROCEDURE
|
||||
);
|
||||
|
||||
TTokenTypes = set of TTokenType;
|
||||
TBlah = set of byte;
|
||||
|
||||
TToken = class
|
||||
TokenType : TTokenType;
|
||||
TokenText : AnsiString;
|
||||
TokenLine : integer;
|
||||
TokenColumn : integer;
|
||||
end;
|
||||
|
||||
TTokenMap = TDictionary<AnsiString,TTokenType>;
|
||||
|
||||
|
||||
TwpLex = class
|
||||
private
|
||||
fBuffer : PAnsiChar;
|
||||
fStart : PAnsiChar;
|
||||
fForward : PAnsiChar;
|
||||
|
||||
fLiterals : TTokenMap;
|
||||
|
||||
fTokenLine : integer;
|
||||
fTokenColumn: integer;
|
||||
|
||||
private
|
||||
procedure InitLiterals;
|
||||
|
||||
function CheckLiteral( TokenText : AnsiString;
|
||||
TokenType : TTokenType): TTokenType;
|
||||
|
||||
function MakeToken( TokenText : AnsiString;
|
||||
TokenType : TTokenType): TToken;
|
||||
|
||||
public
|
||||
function NextToken : TToken;
|
||||
|
||||
public
|
||||
constructor Create( Stream: TStream; Length: Int64=-1);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
EwpLex = Exception;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
Windows;
|
||||
|
||||
|
||||
{ TwpLex }
|
||||
|
||||
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
//
|
||||
// Construction/destruction
|
||||
//
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ================================================================================================
|
||||
// Constructor
|
||||
// ================================================================================================
|
||||
constructor TwpLex.Create(Stream: TStream; Length: Int64);
|
||||
var
|
||||
size : Int64;
|
||||
token : TToken;
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
InitLiterals;
|
||||
|
||||
if Assigned(Stream) then
|
||||
begin
|
||||
if Length < 0
|
||||
then size := Stream.Size - Stream.Position
|
||||
else size := Length;
|
||||
|
||||
fBuffer := GetMemory(size+1);
|
||||
|
||||
Stream.Read( fBuffer^, size);
|
||||
|
||||
fStart := fBuffer;
|
||||
fForward := fBuffer;
|
||||
fBuffer[size] := #0;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Destructor
|
||||
// ================================================================================================
|
||||
destructor TwpLex.Destroy;
|
||||
begin
|
||||
FreeAndNil(fLiterals);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
//
|
||||
// Internals
|
||||
//
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ================================================================================================
|
||||
// Make Token
|
||||
// ================================================================================================
|
||||
function TwpLex.MakeToken(TokenText: AnsiString; TokenType: TTokenType): TToken;
|
||||
begin
|
||||
result := TToken.Create;
|
||||
result.TokenLine := 0;
|
||||
result.TokenColumn := 0;
|
||||
result.TokenType := TokenType;
|
||||
result.TokenText := TokenText;
|
||||
|
||||
// if TokenType = TT_COMMENT
|
||||
// then result.TokenText := TokenText
|
||||
// else result.TokenText := UpperCase(TokenText);
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Init Literals
|
||||
// ================================================================================================
|
||||
procedure TwpLex.InitLiterals;
|
||||
begin
|
||||
fLiterals := TTokenMap.Create;
|
||||
|
||||
fLiterals.Add('do', LT_DO);
|
||||
fLiterals.Add('if', LT_IF);
|
||||
fLiterals.Add('in', LT_IN);
|
||||
fLiterals.Add('of', LT_OF);
|
||||
fLiterals.Add('or', LT_OR);
|
||||
fLiterals.Add('to', LT_TO);
|
||||
|
||||
fLiterals.Add('and', LT_AND);
|
||||
fLiterals.Add('div', LT_DIV);
|
||||
fLiterals.Add('end', LT_END);
|
||||
fLiterals.Add('for', LT_FOR);
|
||||
fLiterals.Add('mod', LT_MOD);
|
||||
fLiterals.Add('nil', LT_NIL);
|
||||
fLiterals.Add('not', LT_NOT);
|
||||
fLiterals.Add('set', LT_SET);
|
||||
fLiterals.Add('var', LT_VAR);
|
||||
fLiterals.Add('xor', LT_XOR);
|
||||
|
||||
fLiterals.Add('case', LT_CASE);
|
||||
fLiterals.Add('else', LT_ELSE);
|
||||
fLiterals.Add('file', LT_FILE);
|
||||
fLiterals.Add('goto', LT_GOTO);
|
||||
fLiterals.Add('then', LT_THEN);
|
||||
fLiterals.Add('type', LT_TYPE);
|
||||
fLiterals.Add('uses', LT_USES);
|
||||
fLiterals.Add('with', LT_WITH);
|
||||
|
||||
fLiterals.Add('array', LT_ARRAY);
|
||||
fLiterals.Add('begin', LT_BEGIN);
|
||||
fLiterals.Add('const', LT_CONST);
|
||||
fLiterals.Add('label', LT_LABEL);
|
||||
fLiterals.Add('until', LT_UNTIL);
|
||||
fLiterals.Add('while', LT_WHILE);
|
||||
|
||||
fLiterals.Add('downto', LT_DOWNTO);
|
||||
fLiterals.Add('packed', LT_PACKED);
|
||||
fLiterals.Add('record', LT_RECORD);
|
||||
fLiterals.Add('repeat', LT_REPEAT);
|
||||
|
||||
fLiterals.Add('program', LT_PROGRAM);
|
||||
fLiterals.Add('function', LT_FUNCTION);
|
||||
fLiterals.Add('procedure', LT_PROCEDURE);
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Check Literal
|
||||
// ================================================================================================
|
||||
function TwpLex.CheckLiteral(TokenText: AnsiString; TokenType: TTokenType): TTokenType;
|
||||
var
|
||||
ttype : TTokenType;
|
||||
|
||||
begin
|
||||
if fLiterals.TryGetValue(TokenText, ttype)
|
||||
then result := ttype
|
||||
else result := TokenType
|
||||
end;
|
||||
|
||||
// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
//
|
||||
// Interface
|
||||
//
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ================================================================================================
|
||||
// Next Token
|
||||
// ================================================================================================
|
||||
function TwpLex.NextToken: TToken;
|
||||
|
||||
function GetTokenText: AnsiString;
|
||||
begin
|
||||
SetLength(result, fForward-fStart);
|
||||
MoveMemory( @result[1], fStart, fForward-fStart);
|
||||
end;
|
||||
|
||||
var
|
||||
ttext : AnsiString;
|
||||
ttype : TTokenType;
|
||||
|
||||
begin
|
||||
result := nil;
|
||||
|
||||
while true do
|
||||
begin
|
||||
result := nil;
|
||||
fForward := fStart;
|
||||
|
||||
case fForward^ of
|
||||
|
||||
// id
|
||||
'a'..'z','A'..'Z','_':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_ID;
|
||||
|
||||
while fForward^ in ['a'..'z','A'..'Z','0'..'9','_'] do
|
||||
INC(fForward);
|
||||
|
||||
ttype := CheckLiteral( GetTokenText, ttype);
|
||||
end;
|
||||
|
||||
// uint or ureal
|
||||
'0'..'9':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_UINT;
|
||||
|
||||
while fForward^ in ['0'..'9'] do
|
||||
INC(fForward);
|
||||
|
||||
// fractional part
|
||||
if fForward^ = '.' then
|
||||
begin
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ in ['0'..'9'] then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_UREAL;
|
||||
|
||||
while fForward^ in ['0'..'9'] do
|
||||
INC(fForward);
|
||||
end
|
||||
|
||||
else if fForward^ = '.' then
|
||||
ttype := TT_RANGE
|
||||
|
||||
else
|
||||
raise EwpLex.Create('Expected 0..9 in fractional part');
|
||||
end;
|
||||
|
||||
// exponential part
|
||||
if ttype in [TT_UINT, TT_UREAL] then
|
||||
begin
|
||||
if fForward^ in ['e','E'] then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_UREAL;
|
||||
|
||||
if fForward^ in ['+','-'] then
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ in ['0'..'9'] then
|
||||
begin
|
||||
INC(fForward);
|
||||
|
||||
while fForward^ in ['0'..'9'] do
|
||||
INC(fForward);
|
||||
end
|
||||
else
|
||||
raise EwpLex.Create('Expected +,-,0..9 in exponential part');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// <,<=,<>
|
||||
'<':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_LT;
|
||||
|
||||
if fForward^ in ['=','>'] then
|
||||
begin
|
||||
case fForward^ of
|
||||
'=': ttype := TT_LE;
|
||||
'>': ttype := TT_NE;
|
||||
end;
|
||||
|
||||
INC(fForward);
|
||||
end;
|
||||
end;
|
||||
|
||||
// >,>=
|
||||
'>':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_GT;
|
||||
|
||||
if fForward^ = '=' then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_GE;
|
||||
end;
|
||||
end;
|
||||
|
||||
// :,:=
|
||||
':':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_COLON;
|
||||
|
||||
if fForward^ = '=' then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_ASSIGN
|
||||
end
|
||||
end;
|
||||
|
||||
// .,..
|
||||
'.':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_DOT;
|
||||
|
||||
if fForward^ = '.' then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_RANGE;
|
||||
end
|
||||
end;
|
||||
|
||||
// string
|
||||
'''':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_CHAR;
|
||||
|
||||
while true do
|
||||
begin
|
||||
if fForward^ in [#10,#13,#0] then
|
||||
raise EwpLex.Create('Newline/EOF found in string');
|
||||
|
||||
if fForward^ = '''' then
|
||||
begin
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ = ''''
|
||||
then INC(fForward)
|
||||
else break
|
||||
|
||||
end
|
||||
else
|
||||
INC(fForward)
|
||||
end;
|
||||
end;
|
||||
|
||||
// /,//
|
||||
'/':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_SLASH;
|
||||
|
||||
if fForward^ = '/' then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_COMMENT;
|
||||
|
||||
while not (fForward^ in [#13,#10,#0]) do
|
||||
INC(fForward);
|
||||
end
|
||||
end;
|
||||
|
||||
// comment
|
||||
'{':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_COMMENT;
|
||||
|
||||
while not (fForward^ in ['}',#0]) do
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ = #0
|
||||
then raise EwpLex.Create('EOF reached in comment')
|
||||
else INC( fForward);
|
||||
end;
|
||||
|
||||
'(':
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_LPAREN;
|
||||
|
||||
if fForward^ = '*' then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_COMMENT;
|
||||
|
||||
while true do
|
||||
begin
|
||||
if fForward^ = #0 then
|
||||
raise EwpLex.Create('EOF reached in comment');
|
||||
|
||||
if fForward^ = '*' then
|
||||
begin
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ = ')' then
|
||||
begin
|
||||
INC(fForward);
|
||||
break;
|
||||
end;
|
||||
end
|
||||
end
|
||||
end
|
||||
end;
|
||||
|
||||
// hex number
|
||||
'$':
|
||||
begin
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ in ['0'..'9','a'..'f','A'..'F'] then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_HEX;
|
||||
|
||||
while fForward^ in ['0'..'9','a'..'f','A'..'F'] do
|
||||
INC(fForward);
|
||||
end
|
||||
|
||||
else
|
||||
raise EwpLex.Create('Expected hexadecimal digit');
|
||||
end;
|
||||
|
||||
'%':
|
||||
begin
|
||||
INC(fForward);
|
||||
|
||||
if fForward^ in ['0'..'1'] then
|
||||
begin
|
||||
INC(fForward);
|
||||
ttype := TT_BIN;
|
||||
|
||||
while fForward^ in ['0'..'1'] do
|
||||
INC(fForward);
|
||||
end
|
||||
|
||||
else
|
||||
raise EwpLex.Create('Expected binary digit');
|
||||
end;
|
||||
|
||||
else
|
||||
case fForward^ of
|
||||
')': begin ttype := TT_RPAREN; INC(fForward) end;
|
||||
'[': begin ttype := TT_LBRACKET; INC(fForward) end;
|
||||
']': begin ttype := TT_RBRACKET; INC(fForward) end;
|
||||
|
||||
'*': begin ttype := TT_STAR; INC(fForward) end;
|
||||
'+': begin ttype := TT_PLUS; INC(fForward) end;
|
||||
'-': begin ttype := TT_MINUS; INC(fForward) end;
|
||||
|
||||
'=': begin ttype := TT_EQ; INC(fForward) end;
|
||||
|
||||
'^': begin ttype := TT_PTR; INC(fForward) end;
|
||||
';': begin ttype := TT_SEMI; INC(fForward) end;
|
||||
',': begin ttype := TT_COMMA; INC(fForward) end;
|
||||
'$': begin ttype := TT_DOLLAR; INC(fForward) end;
|
||||
|
||||
'@': begin ttype := TT_AT; INC(fForward) end;
|
||||
'#': begin ttype := TT_SHARP; INC(fForward) end;
|
||||
|
||||
#9 : begin ttype := TT_SKIP; INC(fForward) end;
|
||||
#10: begin ttype := TT_SKIP; INC(fForward) end;
|
||||
#13: begin ttype := TT_SKIP; INC(fForward) end;
|
||||
#32: begin ttype := TT_SKIP; INC(fForward) end;
|
||||
|
||||
// EOF
|
||||
#0 : ttype := TT_EOF;
|
||||
|
||||
else
|
||||
raise EwpLex.Create('Invalid character '+fForward^);
|
||||
end
|
||||
end;
|
||||
|
||||
if ttype <> TT_SKIP then
|
||||
begin
|
||||
ttext := GetTokenText;
|
||||
result := MakeToken( ttext, ttype);
|
||||
fStart := fForward;
|
||||
|
||||
break;
|
||||
end;
|
||||
|
||||
fStart := fForward;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,418 @@
|
||||
unit wpPar;
|
||||
|
||||
interface
|
||||
uses
|
||||
SysUtils,
|
||||
Generics.Collections,
|
||||
wpLex;
|
||||
|
||||
type
|
||||
TStringMap = TDictionary<AnsiString,AnsiString>;
|
||||
|
||||
|
||||
TwpPar = class
|
||||
private
|
||||
fLex : TwpLex;
|
||||
|
||||
fConstants : TStringMap;
|
||||
fTypes : TStringMap;
|
||||
|
||||
protected
|
||||
function Match( ttype : TTokenType; dispose: boolean=true):TToken; overload;
|
||||
function Match( ttypes : TTokenTypes; dispose: boolean=true):TToken; overload;
|
||||
|
||||
protected
|
||||
procedure block;
|
||||
procedure constant;
|
||||
procedure uconstant;
|
||||
procedure typedef;
|
||||
|
||||
public
|
||||
procedure prg;
|
||||
|
||||
public
|
||||
constructor Create( Lexer: TwpLex);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
EwpPar = Exception;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TwpPar }
|
||||
|
||||
|
||||
|
||||
// @@@: Construction / destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
//
|
||||
// Construction / destruction
|
||||
//
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ================================================================================================
|
||||
// Constructor
|
||||
// ================================================================================================
|
||||
constructor TwpPar.Create(Lexer: TwpLex);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
fLex := Lexer;
|
||||
fConstants := TStringMap.Create;
|
||||
fTypes := TStringMap.Create;
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Destructor
|
||||
// ================================================================================================
|
||||
destructor TwpPar.Destroy;
|
||||
begin
|
||||
fConstants .Free;
|
||||
fTypes .Free;
|
||||
|
||||
inherited
|
||||
end;
|
||||
|
||||
|
||||
|
||||
// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
//
|
||||
// Internals
|
||||
//
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ================================================================================================
|
||||
//
|
||||
// ================================================================================================
|
||||
function TwpPar.Match(ttype: TTokenType; dispose: boolean): TToken;
|
||||
var
|
||||
t: TToken;
|
||||
|
||||
begin
|
||||
result := nil;
|
||||
t := fLex.NextToken;
|
||||
|
||||
if t.TokenType = ttype then
|
||||
if dispose
|
||||
then t.Free
|
||||
else result := t
|
||||
|
||||
else
|
||||
raise EwpPar.Create('Unexpected token')
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
//
|
||||
// ================================================================================================
|
||||
function TwpPar.Match(ttypes: TTokenTypes; dispose: boolean): TToken;
|
||||
var
|
||||
t: TToken;
|
||||
|
||||
begin
|
||||
result := nil;
|
||||
t := fLex.NextToken;
|
||||
|
||||
if t.TokenType in ttypes then
|
||||
if dispose
|
||||
then t.Free
|
||||
else result := t
|
||||
else
|
||||
raise EwpPar.Create('Unexpected token')
|
||||
end;
|
||||
|
||||
// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
//
|
||||
// Interface
|
||||
//
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
||||
// ================================================================================================
|
||||
// Program
|
||||
// ================================================================================================
|
||||
procedure TwpPar.prg;
|
||||
var
|
||||
t : TToken;
|
||||
|
||||
begin
|
||||
if Assigned( fLex) then
|
||||
begin
|
||||
Match(LT_PROGRAM);
|
||||
Match(TT_ID);
|
||||
Match(TT_LPAREN);
|
||||
|
||||
t := fLex.NextToken;
|
||||
|
||||
// id [, id]*
|
||||
if t.TokenType = TT_ID then
|
||||
begin
|
||||
t.Free;
|
||||
t := fLex.NextToken;
|
||||
|
||||
while t.TokenType = TT_COMMA do
|
||||
begin
|
||||
t.Free;
|
||||
Match(TT_ID);
|
||||
t := fLex.NextToken;
|
||||
end;
|
||||
end;
|
||||
|
||||
if t.TokenType <> TT_RPAREN then
|
||||
raise EwpPar.Create('")" expected');
|
||||
|
||||
Match(TT_SEMI);
|
||||
block;
|
||||
Match(TT_DOT)
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
// ================================================================================================
|
||||
// block
|
||||
// ================================================================================================
|
||||
procedure TwpPar.block;
|
||||
var
|
||||
token : TToken;
|
||||
ttype : TTokenType;
|
||||
start : TTokenTypes;
|
||||
start2: TTokenTypes;
|
||||
|
||||
begin
|
||||
start := [LT_LABEL,LT_CONST,LT_TYPE,LT_VAR,LT_PROCEDURE,LT_FUNCTION,LT_BEGIN];
|
||||
start2:= [LT_LABEL,LT_CONST,LT_TYPE,LT_VAR,LT_PROCEDURE,LT_FUNCTION];
|
||||
token := fLex.NextToken;
|
||||
|
||||
if token.TokenType in start then
|
||||
begin
|
||||
while token.TokenType in start2 do
|
||||
begin
|
||||
case token.TokenType of
|
||||
// ------------------------------------------------------
|
||||
// Label
|
||||
// ------------------------------------------------------
|
||||
LT_LABEL:
|
||||
while true do
|
||||
begin
|
||||
Match( TT_UINT);
|
||||
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
|
||||
token.Free;
|
||||
|
||||
case ttype of
|
||||
TT_COMMA : ;
|
||||
TT_SEMI : begin token := fLex.NextToken; break end;
|
||||
else raise EwpPar.Create('Expected: ,;');
|
||||
end;
|
||||
end;
|
||||
|
||||
// ------------------------------------------------------
|
||||
// Const
|
||||
// ------------------------------------------------------
|
||||
LT_CONST:
|
||||
begin
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
|
||||
while ttype = TT_ID do
|
||||
begin
|
||||
token.Free;
|
||||
Match(TT_EQ);
|
||||
constant;
|
||||
Match(TT_SEMI);
|
||||
|
||||
token := flex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ------------------------------------------------------
|
||||
// Type
|
||||
// ------------------------------------------------------
|
||||
LT_TYPE:
|
||||
begin
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
|
||||
while ttype = TT_ID do
|
||||
begin
|
||||
token.Free;
|
||||
Match(TT_EQ);
|
||||
typedef;
|
||||
Match(TT_SEMI);
|
||||
|
||||
token := flex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
end;
|
||||
end;
|
||||
|
||||
LT_VAR:
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
LT_PROCEDURE:
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
LT_FUNCTION:
|
||||
begin
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
// token := fLex.NextToken
|
||||
end;
|
||||
|
||||
if token.TokenType = LT_BEGIN then
|
||||
begin
|
||||
|
||||
Match(LT_END)
|
||||
end
|
||||
|
||||
else
|
||||
raise EwpPar.Create('Expected: Begin');
|
||||
end
|
||||
|
||||
else
|
||||
raise EwpPar.Create('Expected: label, const, type, var, procedure, function, begin');
|
||||
end;
|
||||
|
||||
|
||||
// ================================================================================================
|
||||
// Constant
|
||||
// ================================================================================================
|
||||
procedure TwpPar.constant;
|
||||
var
|
||||
token: TToken;
|
||||
ttype: TTokenType;
|
||||
|
||||
begin
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
|
||||
if ttype in [TT_PLUS,TT_MINUS,TT_ID,TT_UINT,TT_UREAL] then
|
||||
begin
|
||||
if ttype in [TT_PLUS,TT_MINUS] then
|
||||
begin
|
||||
token.Free;
|
||||
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
end;
|
||||
|
||||
token.Free;
|
||||
|
||||
case ttype of
|
||||
TT_ID : ;
|
||||
TT_UINT : ;
|
||||
TT_UREAL : ;
|
||||
else raise EwpPar.Create('Expected: id,int,real')
|
||||
end
|
||||
end
|
||||
|
||||
else if ttype in [TT_CHAR, TT_STRING] then
|
||||
begin
|
||||
token.Free;
|
||||
end
|
||||
|
||||
else
|
||||
raise EwpPar.Create('Expected: +,-,id,int,real,string');
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Unsigned constant
|
||||
// ================================================================================================
|
||||
procedure TwpPar.uconstant;
|
||||
var
|
||||
token: TToken;
|
||||
ttype: TTokenType;
|
||||
|
||||
begin
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
|
||||
token.Free;
|
||||
|
||||
case token.TokenType of
|
||||
TT_ID : ;
|
||||
TT_UINT : ;
|
||||
TT_UREAL : ;
|
||||
LT_NIL : ;
|
||||
TT_STRING: ;
|
||||
else raise EwpPar.Create('Expected: id,int,real,nil,string')
|
||||
end;
|
||||
end;
|
||||
|
||||
// ================================================================================================
|
||||
// Type
|
||||
// ================================================================================================
|
||||
procedure TwpPar.typedef;
|
||||
var
|
||||
token: TToken;
|
||||
ttype: TTokenType;
|
||||
ttext: AnsiString;
|
||||
|
||||
f_const : TTokenTypes;
|
||||
|
||||
begin
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
ttext := token.TokenText;
|
||||
|
||||
token.Free;
|
||||
|
||||
// ---------------------------------------------------------------
|
||||
// TT_ID
|
||||
//
|
||||
// Identifier can be an existing type identifier, or an existing
|
||||
// constant identifier. If it is contant identifier, then it must
|
||||
// be a range specification.
|
||||
// ---------------------------------------------------------------
|
||||
if ttype = TT_ID then
|
||||
begin
|
||||
// --------------------------------------------------
|
||||
// constant .. constant
|
||||
// --------------------------------------------------
|
||||
if fConstants.ContainsKey(ttext) then
|
||||
begin
|
||||
Match(TT_RANGE);
|
||||
|
||||
token := fLex.NextToken;
|
||||
ttype := token.TokenType;
|
||||
ttext := token.TokenText;
|
||||
|
||||
token.Free;
|
||||
end
|
||||
|
||||
// --------------------------------------------------
|
||||
// type identifier
|
||||
// --------------------------------------------------
|
||||
else if fTypes.ContainsKey(ttext) then
|
||||
begin
|
||||
|
||||
end
|
||||
|
||||
// --------------------------------------------------
|
||||
// Not an constant or type identifier
|
||||
// --------------------------------------------------
|
||||
else
|
||||
EwpPar.Create('Expected a type or constant identifier' );
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user