├── demos └── Delphi │ ├── Calc │ ├── Calc.bat │ ├── CalcDemo.res │ ├── Calc │ │ ├── CalcLexer.RES │ │ ├── CalcParser.RES │ │ ├── CalcParser.pas │ │ └── CalcLexer.pas │ ├── CalcDemo.dpr │ ├── Calc.g │ ├── uMain.dfm │ └── uMain.pas │ ├── JSON │ ├── JSON.bat │ ├── JSONDemo.res │ ├── Examples │ │ ├── Example5.json │ │ ├── Example2.json │ │ ├── Example1.json │ │ ├── Example3.json │ │ └── Example4.json │ ├── JSON │ │ ├── JSONLexer.RES │ │ ├── JSONParser.RES │ │ ├── JSONParser.pas │ │ └── JSONLexer.pas │ ├── JSONDemo.dpr │ ├── uMain.dfm │ ├── JSON.g │ └── uMain.pas │ └── Expression │ ├── Expression.bat │ ├── ExpressionDemo.res │ ├── Expression │ ├── ExpressionLexer.RES │ ├── ExpressionParser.RES │ ├── ExpressionLexer.pas │ └── ExpressionParser.pas │ ├── ExpressionDemo.dpr │ ├── ExpressionDemo.dfm │ ├── uMain.pas │ ├── uMain.dfm │ └── Expression.g ├── scripts ├── insns2pascal.bat ├── update_perl_header.pl └── insns2pascal.pl ├── lib └── Parse │ ├── Easy │ ├── Parse │ │ ├── compile.bat │ │ ├── RecursiveDescentParser.pm │ │ ├── RecursiveDescentLexer.pm │ │ ├── RangeLexer.pm │ │ ├── RangeParser.pm │ │ ├── Parser.eyp │ │ └── Lexer.pl │ ├── Version.pm │ ├── Epsilon.pm │ ├── NoTerm.pm │ ├── Control.pm │ ├── Wildcard.pm │ ├── Target │ │ └── Pascal │ │ │ ├── Config.pm │ │ │ ├── Utils.pm │ │ │ ├── Header.pm │ │ │ ├── Parser.pm │ │ │ └── Lexer.pm │ ├── Parser │ │ ├── Action.pm │ │ ├── Kernel.pm │ │ ├── Closure.pm │ │ ├── State.pm │ │ └── Exporter.pm │ ├── Literal.pm │ ├── Endian.pm │ ├── Lexer │ │ ├── Compiler │ │ │ └── Utils.pm │ │ ├── opcodes.txt │ │ ├── Kernel.pm │ │ ├── Closure.pm │ │ ├── State.pm │ │ ├── opcodes.pl │ │ ├── insns2pascal.pl │ │ ├── Disasm.pm │ │ ├── Instruction.pm │ │ ├── OpCodes.pm │ │ └── Compiler.pm │ ├── Term.pm │ ├── XObject.pm │ ├── ReturnType.pm │ ├── Token.pm │ ├── CharacterSet.pm │ ├── Code.pm │ ├── StreamWriter.pm │ ├── Utils.pm │ ├── Grammar.pm │ ├── IntervalSet.pm │ └── Rule.pm │ ├── Easy.bat │ └── Easy.pm ├── runtime └── Pascal │ ├── Parse.Easy.Version.pas │ ├── Parse.Easy.Parser.Action.pas │ ├── Parse.Easy.Parser.Rule.pas │ ├── Parse.Easy.Lexer.CustomLexer.pas │ ├── Parse.Easy.StackPtr.pas │ ├── Parse.Easy.Parser.State.pas │ ├── Parse.Easy.Lexer.CodePointStream.pas │ ├── Parse.Easy.Lexer.Token.pas │ ├── Parse.Easy.Parser.LR1.pas │ ├── Parse.Easy.Parser.CustomParser.pas │ └── Parse.Easy.Parser.Deserializer.pas ├── .gitignore ├── README.md └── LICENSE /demos/Delphi/Calc/Calc.bat: -------------------------------------------------------------------------------- 1 | easy Calc.g -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSON.bat: -------------------------------------------------------------------------------- 1 | easy JSON.g -------------------------------------------------------------------------------- /demos/Delphi/Expression/Expression.bat: -------------------------------------------------------------------------------- 1 | easy Expression.g -------------------------------------------------------------------------------- /scripts/insns2pascal.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | perl insns2pascal.pl "../runtime/pascal/insns.inc" -------------------------------------------------------------------------------- /demos/Delphi/Calc/CalcDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/Calc/CalcDemo.res -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSONDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/JSON/JSONDemo.res -------------------------------------------------------------------------------- /demos/Delphi/JSON/Examples/Example5.json: -------------------------------------------------------------------------------- 1 | { 2 | "emptyHash" : {}, 3 | "emptyArray" : [], 4 | "emptyString" : "" 5 | } -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/compile.bat: -------------------------------------------------------------------------------- 1 | rem compile Parse::Easy grammar. 2 | eyapp -v -m Parse::Easy::Parse::Parser Parser.eyp 3 | pause -------------------------------------------------------------------------------- /demos/Delphi/Calc/Calc/CalcLexer.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/Calc/Calc/CalcLexer.RES -------------------------------------------------------------------------------- /demos/Delphi/Calc/Calc/CalcParser.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/Calc/Calc/CalcParser.RES -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSON/JSONLexer.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/JSON/JSON/JSONLexer.RES -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSON/JSONParser.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/JSON/JSON/JSONParser.RES -------------------------------------------------------------------------------- /demos/Delphi/Expression/ExpressionDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/Expression/ExpressionDemo.res -------------------------------------------------------------------------------- /demos/Delphi/Expression/Expression/ExpressionLexer.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/Expression/Expression/ExpressionLexer.RES -------------------------------------------------------------------------------- /demos/Delphi/Expression/Expression/ExpressionParser.RES: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MahdiSafsafi/Parse-Easy/HEAD/demos/Delphi/Expression/Expression/ExpressionParser.RES -------------------------------------------------------------------------------- /demos/Delphi/JSON/Examples/Example2.json: -------------------------------------------------------------------------------- 1 | {"menu": { 2 | "id": "file", 3 | "value": "File", 4 | "popup": { 5 | "menuitem": [ 6 | {"value": "New", "onclick": "CreateNewDoc()"}, 7 | {"value": "Open", "onclick": "OpenDoc()"}, 8 | {"value": "Close", "onclick": "CloseDoc()"} 9 | ] 10 | } 11 | }} -------------------------------------------------------------------------------- /demos/Delphi/Calc/CalcDemo.dpr: -------------------------------------------------------------------------------- 1 | program CalcDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | uMain in 'uMain.pas' {Main}, 6 | CalcLexer in 'Calc\CalcLexer.pas', 7 | CalcParser in 'Calc\CalcParser.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TMain, Main); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSONDemo.dpr: -------------------------------------------------------------------------------- 1 | program JSONDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | uMain in 'uMain.pas' {Main}, 6 | JSONLexer in 'JSON\JSONLexer.pas', 7 | JSONParser in 'JSON\JSONParser.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TMain, Main); 15 | Application.Run; 16 | end. 17 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Version.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Version.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Version; 14 | use strict; 15 | use warnings; 16 | 17 | $Parse::Easy::Version::Major = 1; 18 | $Parse::Easy::Version::Minor = 0; 19 | 1; 20 | -------------------------------------------------------------------------------- /demos/Delphi/Expression/ExpressionDemo.dpr: -------------------------------------------------------------------------------- 1 | program ExpressionDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | uMain in 'uMain.pas' {Main}, 6 | ExpressionLexer in 'Expression\ExpressionLexer.pas', 7 | ExpressionParser in 'Expression\ExpressionParser.pas', 8 | ExpressionBase in 'ExpressionBase.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TMain, Main); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /lib/Parse/Easy.bat: -------------------------------------------------------------------------------- 1 | @echo off 2 | 3 | set "current_dir=%~dp0" 4 | for %%I in ("%current_dir%\..") do set "lib_folder=%%~fI" 5 | 6 | rem run perl. 7 | 8 | perl -I %lib_folder% -x -S %0 %* 9 | 10 | goto END_OF_PERL 11 | 12 | rem Perl script: 13 | #!/usr/bin/perl 14 | 15 | use strict; 16 | use warnings; 17 | use feature qw(say); 18 | use Parse::Easy; 19 | 20 | my ($file) = @ARGV; 21 | 22 | my $easy = Parse::Easy->new($file); 23 | $easy->generate(); 24 | 25 | __END__ 26 | 27 | :END_OF_PERL 28 | 29 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Epsilon.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Epsilon.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Epsilon; 14 | use strict; 15 | use warnings; 16 | use Data::Dump qw(pp); 17 | use feature qw(say); 18 | use Parse::Easy::Term; 19 | our @ISA = qw(Parse::Easy::Term); 20 | use Carp; 21 | -------------------------------------------------------------------------------- /lib/Parse/Easy/NoTerm.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/NoTerm.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::NoTerm; 14 | use strict; 15 | use warnings; 16 | use Data::Dump qw(pp); 17 | use feature qw(say); 18 | use Parse::Easy::Term; 19 | our @ISA = qw(Parse::Easy::Term); 20 | use Carp; 21 | 22 | 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Control.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Control.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Control; 14 | use strict; 15 | use warnings; 16 | use Data::Dump qw(pp); 17 | use feature qw(say); 18 | use Parse::Easy::NoTerm; 19 | our @ISA = qw(Parse::Easy::NoTerm); 20 | use Carp; 21 | 22 | 23 | 1; 24 | -------------------------------------------------------------------------------- /demos/Delphi/Expression/ExpressionDemo.dfm: -------------------------------------------------------------------------------- 1 | object Form5: TForm5 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form5' 5 | ClientHeight = 201 6 | ClientWidth = 447 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Memo1: TMemo 17 | Left = 112 18 | Top = 24 19 | Width = 185 20 | Height = 89 21 | Lines.Strings = ( 22 | 'Memo1') 23 | TabOrder = 0 24 | end 25 | end 26 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Wildcard.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Wildcard.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Wildcard; 14 | use strict; 15 | use warnings; 16 | use Set::IntSpan; 17 | 18 | $Parse::Easy::Wildcard::MIN = 0x0000; 19 | $Parse::Easy::Wildcard::MAX = 0xffff; 20 | 21 | sub wildcard { 22 | Set::IntSpan->new( sprintf "%s-%s", $Parse::Easy::Wildcard::MIN, $Parse::Easy::Wildcard::MAX ) 23 | } 24 | 1; 25 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Version.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Version; 6 | 7 | interface 8 | 9 | function GetMinorVersion(): Integer; 10 | function GetMajorVersion(): Integer; 11 | 12 | implementation 13 | 14 | const 15 | MINOR_VERSION = 1; 16 | MAJOR_VERSION = 0; 17 | 18 | function GetMinorVersion(): Integer; 19 | begin 20 | Result := MINOR_VERSION; 21 | end; 22 | 23 | function GetMajorVersion(): Integer; 24 | begin 25 | Result := MAJOR_VERSION; 26 | end; 27 | 28 | end. 29 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Target/Pascal/Config.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Target/Pascal/Config.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Target::Pascal::Config; 14 | use strict; 15 | use warnings; 16 | use Storable qw/dclone/; 17 | use Exporter qw(import); 18 | our @EXPORT_OK = qw/get_config/; 19 | 20 | my %config = ( rcc => 'C:\Program Files (x86)\Embarcadero\Studio\19.0\bin\BRCC32.EXE', ); 21 | 22 | sub get_config { dclone \%config } 23 | 1; 24 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/Examples/Example1.json: -------------------------------------------------------------------------------- 1 | { 2 | "glossary": { 3 | "title": "example glossary", 4 | "GlossDiv": { 5 | "title": "S", 6 | "GlossList": { 7 | "GlossEntry": { 8 | "ID": "SGML", 9 | "SortAs": "SGML", 10 | "GlossTerm": "Standard Generalized Markup Language", 11 | "Acronym": "SGML", 12 | "Abbrev": "ISO 8879:1986", 13 | "GlossDef": { 14 | "para": "A meta-markup language, used to create markup languages such as DocBook.", 15 | "GlossSeeAlso": ["GML", "XML"] 16 | }, 17 | "GlossSee": "markup" 18 | } 19 | } 20 | } 21 | } 22 | } -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/RecursiveDescentParser.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parse/RecursiveDescentParser.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parse::RecursiveDescentParser; 14 | use strict; 15 | use warnings; 16 | 17 | sub new { 18 | my ( $class, $lexer ) = @_; 19 | my $self = { lexer => $lexer, }; 20 | bless $self, $class; 21 | $self; 22 | } 23 | sub lexer { $_[0]->{lexer} }; 24 | sub parse { ... } 25 | sub error{ 26 | my($self,$msg)=@_; 27 | die $msg; 28 | } 29 | 1; 30 | 31 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/Examples/Example3.json: -------------------------------------------------------------------------------- 1 | {"widget": { 2 | "debug": "on", 3 | "window": { 4 | "title": "Sample Konfabulator Widget", 5 | "name": "main_window", 6 | "width": 500, 7 | "height": 500 8 | }, 9 | "image": { 10 | "src": "Images/Sun.png", 11 | "name": "sun1", 12 | "hOffset": 250, 13 | "vOffset": 250, 14 | "alignment": "center" 15 | }, 16 | "text": { 17 | "data": "Click Here", 18 | "size": 36, 19 | "style": "bold", 20 | "name": "text1", 21 | "hOffset": 250, 22 | "vOffset": 100, 23 | "alignment": "center", 24 | "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;" 25 | } 26 | }} -------------------------------------------------------------------------------- /lib/Parse/Easy/Parser/Action.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parser/Action.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parser::Action; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Token; 19 | use Parse::Easy::Utils qw(sameItems); 20 | our @ISA = qw(Parse::Easy::Token); 21 | 22 | sub new { 23 | my ( $class, $action, $value ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->{type} = $action; 26 | $self->{value} = $value; 27 | $self; 28 | } 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Target/Pascal/Utils.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Target/Pascal/Utils.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Target::Pascal::Utils; 14 | use strict; 15 | use warnings; 16 | use autodie; 17 | use Exporter qw(import); 18 | use Parse::Easy::Target::Pascal::Config qw/get_config/; 19 | our @EXPORT_OK = qw/generateRes/; 20 | 21 | my $config = get_config(); 22 | 23 | sub generateRes { 24 | my ( $name, $rc, $res, $binary ) = @_; 25 | my $rcc = sprintf '"%s"', $config->{rcc}; 26 | open my $fh, '>', $rc; 27 | printf $fh "%s RCDATA %s\n", $name, $binary; 28 | close $fh; 29 | qx<$rcc $rc>; 30 | } 31 | 1; 32 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Literal.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Literal.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Literal; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::Token); 19 | use Parse::Easy::Token; 20 | use Parse::Easy::CharacterSet; 21 | 22 | sub new { 23 | my ( $class, $bytes ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->{sets} = $bytes; 26 | $self; 27 | } 28 | 29 | sub toCharSets { 30 | my ($self) = @_; 31 | my @sets = (); 32 | foreach my $set ( @{ $self->{sets} } ) { 33 | push @sets, Parse::Easy::CharacterSet->new($set); 34 | } 35 | wantarray ? @sets : \@sets; 36 | } 37 | 38 | 1; -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Parser.Action.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Parser.Action; 6 | 7 | interface 8 | 9 | uses 10 | System.Classes, 11 | System.SysUtils; 12 | 13 | type 14 | TActionType = (atUnkown,atShift, atReduce, atJump); 15 | 16 | TAction = class(TObject) 17 | private 18 | FType: TActionType; 19 | FValue: Integer; 20 | public 21 | constructor Create(AType: TActionType; AValue: Integer); virtual; 22 | property ActionType: TActionType read FType; 23 | property ActionValue: Integer read FValue; 24 | end; 25 | 26 | implementation 27 | 28 | { TAction } 29 | 30 | constructor TAction.Create(AType: TActionType; AValue: Integer); 31 | begin 32 | FType := AType; 33 | FValue := AValue; 34 | end; 35 | 36 | end. 37 | -------------------------------------------------------------------------------- /demos/Delphi/Calc/Calc.g: -------------------------------------------------------------------------------- 1 | grammar Calc; 2 | 3 | // simple calc. 4 | 5 | // lexer fragments: 6 | // ---------------- 7 | fragment DIGIT : [0-9]+; 8 | 9 | // lexer rules: 10 | // ------------ 11 | LPAREN : '('; 12 | RPAREN : ')'; 13 | PLUS : '+'; 14 | MINUS : '-'; 15 | STAR : '*'; 16 | SLASH : '/'; 17 | 18 | DECIMAL : DIGIT; 19 | FLOAT : DIGIT '.' DIGIT; 20 | 21 | WS : [ \t\n\r]+ {skip}; // ignore white-space and newline. 22 | 23 | // parser rules: 24 | // ------------- 25 | expression 26 | : addSubExpression 27 | ; 28 | 29 | addSubExpression 30 | : addSubExpression (PLUS | MINUS) mulDivExpression 31 | | mulDivExpression 32 | ; 33 | 34 | mulDivExpression 35 | : mulDivExpression (STAR | SLASH) unaryExpression 36 | | unaryExpression 37 | ; 38 | 39 | unaryExpression 40 | : (PLUS | MINUS)? primaryExpression 41 | ; 42 | 43 | primaryExpression 44 | : LPAREN expression RPAREN 45 | | DECIMAL 46 | | FLOAT 47 | ; -------------------------------------------------------------------------------- /demos/Delphi/JSON/uMain.dfm: -------------------------------------------------------------------------------- 1 | object Main: TMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Main' 5 | ClientHeight = 278 6 | ClientWidth = 554 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object ParseBtn: TButton 17 | Left = 0 18 | Top = 248 19 | Width = 554 20 | Height = 30 21 | Align = alBottom 22 | Caption = 'Parse' 23 | TabOrder = 0 24 | OnClick = ParseBtnClick 25 | end 26 | object LogMemo: TMemo 27 | Left = 0 28 | Top = 0 29 | Width = 554 30 | Height = 248 31 | Align = alClient 32 | Lines.Strings = ( 33 | 'this example loads all json files in the examples folder ' 34 | 'and parse them. if it fails an error will occur.') 35 | TabOrder = 1 36 | ExplicitHeight = 225 37 | end 38 | end 39 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Endian.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Endian.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Endian; 14 | use strict; 15 | use warnings; 16 | use Carp; 17 | use base 'Exporter'; 18 | 19 | our @EXPORT = qw(LITTLEENDIAN BIGENDIAN BE LE unpackInteger); 20 | 21 | use constant LITTLEENDIAN => 0; 22 | use constant BIGENDIAN => 1; 23 | use constant BE => BIGENDIAN; 24 | use constant LE => LITTLEENDIAN; 25 | 26 | my %sz2p = ( 1 => 'C', 2 => 'S', 4 => 'L', 8 => 'Q' ); 27 | 28 | sub unpackInteger { 29 | my ( $value, $size, $signed, $endian ) = @_; 30 | my $pattern = $sz2p{$size}; 31 | $signed and $pattern = lc $pattern; 32 | $endian && $size != 1 and $pattern .= '>'; 33 | $value // croak; 34 | unpack "C*", pack $pattern, $value; 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Target/Pascal/Header.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Target/Pascal/Header.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Target::Pascal::Header; 14 | use strict; 15 | use warnings; 16 | use Exporter qw(import); 17 | our @EXPORT_OK = qw/get_header/; 18 | use Parse::Easy::Version; 19 | 20 | my $Major = $Parse::Easy::Version::Major; 21 | my $Minor = $Parse::Easy::Version::Minor; 22 | 23 | my $header=<= -127 && $value <= 127 and return 8; 31 | $value >= -32768 && $value <= 32767 and return 16; 32 | $value >= -2147483648 && $value <= 2147483647 and return 32; 33 | return 64; 34 | } 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Term.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Term.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Term; 14 | use strict; 15 | use warnings; 16 | use Data::Dump qw(pp); 17 | use feature qw(say); 18 | use Parse::Easy::Token; 19 | our @ISA = qw(Parse::Easy::Token); 20 | use Carp; 21 | 22 | sub new { 23 | my ( $class, $name ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->{name} = $name; 26 | $self; 27 | } 28 | 29 | sub name { 30 | my ($self) = @_; 31 | $self->{name}; 32 | } 33 | 34 | sub same { 35 | my ( $self, $that ) = @_; 36 | defined $that or return 0; 37 | $self == $that 38 | || $self->type() eq $that->type() 39 | && $self->{name} eq $that->{name}; 40 | } 41 | 42 | sub clone { 43 | my ($self) = @_; 44 | Parse::Easy::Token->new( $self->{name} ); 45 | } 46 | 47 | sub toString { 48 | my ($self) = @_; 49 | $self->{name}; 50 | } 51 | 1; 52 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Parser.Rule.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Parser.Rule; 6 | 7 | interface 8 | 9 | uses 10 | System.Classes, 11 | System.SysUtils; 12 | 13 | type 14 | TRuleFlag = (rfAccept); 15 | TRuleFlags = set of TRuleFlag; 16 | 17 | TRule = class(TObject) 18 | private 19 | FIndex: Integer; 20 | FID: Integer; 21 | FNumberOfItems: Integer; 22 | FActionIndex: Integer; 23 | FFlags: TRuleFlags; 24 | public 25 | constructor Create; virtual; 26 | property Id: Integer read FID write FID; 27 | property Index: Integer read FIndex write FIndex; 28 | property NumberOfItems: Integer read FNumberOfItems write FNumberOfItems; 29 | property ActionIndex: Integer read FActionIndex write FActionIndex; 30 | property Flags: TRuleFlags read FFlags write FFlags; 31 | end; 32 | 33 | implementation 34 | 35 | { TRule } 36 | 37 | constructor TRule.Create; 38 | begin 39 | FFlags := []; 40 | end; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /scripts/update_perl_header.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | use File::Find; 5 | use autodie; 6 | use feature qw/say/; 7 | 8 | my @files = (); 9 | my $shebang = '#!/usr/bin/perl'; 10 | my $HEADER = <<'EOH'; 11 | 12 | #BEGIN_HEADER 13 | # 14 | # Module $name Copyright (C) 2018-2019 Mahdi Safsafi. 15 | # 16 | # https://github.com/MahdiSafsafi/Parse-Easy 17 | # 18 | # See licence file 'LICENCE' for use and distribution rights. 19 | # 20 | #END_HEADER 21 | 22 | EOH 23 | 24 | sub wanted { 25 | local $_ = $File::Find::name; 26 | /\.(p[ml])$/ and push @files, $_; 27 | } 28 | 29 | find( \&wanted, '..\lib' ); 30 | 31 | foreach my $file (@files) { 32 | $file =~ /.lib.(.+)/; 33 | my $name = $1; 34 | $name =~ /Parse.Easy.Parse.Parser/ and next; 35 | 36 | local $/ = undef; 37 | open my $fh, '<', $file; 38 | local $_ = <$fh>; 39 | close $fh; 40 | 41 | s/\Q$shebang\E\n+//s; 42 | s/#BEGIN_HEADER.+?#END_HEADER\n+//s; 43 | 44 | my $header = $HEADER; 45 | $header =~ s/\$name/$name/; 46 | $_ = $shebang . "\n" . $header . $_; 47 | 48 | open $fh, '>', $file; 49 | print $fh $_; 50 | close $fh; 51 | } 52 | 1; -------------------------------------------------------------------------------- /lib/Parse/Easy/XObject.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/XObject.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::XObject; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Token; 19 | our @ISA = qw(Parse::Easy::Token); 20 | use Scalar::Util qw(refaddr); 21 | 22 | sub new { 23 | my ( $class, $ref ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->{xobject} = $ref; 26 | $self; 27 | } 28 | 29 | sub same { 30 | my ( $self, $that ) = @_; 31 | defined $that || return 0; 32 | $self == $that 33 | || $self->type() eq $that->type() && $self->{xobject} == $that->{xobject}; 34 | } 35 | 36 | sub xobject { 37 | my ( $self, $value ) = @_; 38 | $self->{xobject} = $value // $self->{xobject}; 39 | } 40 | 41 | sub clone { 42 | my ($self) = @_; 43 | Parse::Easy::XObject->new( $self->{xobject} ); 44 | } 45 | 46 | sub toString { 47 | my ($self) = @_; 48 | refaddr( $self->{xobject} ); 49 | } 50 | 1; 51 | -------------------------------------------------------------------------------- /demos/Delphi/Calc/uMain.dfm: -------------------------------------------------------------------------------- 1 | object Main: TMain 2 | Left = 0 3 | Top = 0 4 | BorderStyle = bsToolWindow 5 | Caption = 'Calc validator' 6 | ClientHeight = 142 7 | ClientWidth = 446 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object DocLabel: TLabel 18 | Left = 8 19 | Top = 8 20 | Width = 409 21 | Height = 26 22 | Caption = 23 | 'This example will check whether a given expression is valid or n' + 24 | 'ot. If it'#39's not valid, an exception will occur.' 25 | WordWrap = True 26 | end 27 | object ParseBtn: TButton 28 | Left = 8 29 | Top = 109 30 | Width = 431 31 | Height = 25 32 | Caption = 'Parse' 33 | TabOrder = 0 34 | OnClick = ParseBtnClick 35 | end 36 | object ExpressionEdit: TLabeledEdit 37 | Left = 64 38 | Top = 63 39 | Width = 375 40 | Height = 21 41 | EditLabel.Width = 56 42 | EditLabel.Height = 13 43 | EditLabel.Caption = 'Expression:' 44 | LabelPosition = lpLeft 45 | TabOrder = 1 46 | TextHint = 'eg: -1 + (5 * 2)' 47 | end 48 | end 49 | -------------------------------------------------------------------------------- /lib/Parse/Easy/ReturnType.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/ReturnType.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::ReturnType; 14 | use strict; 15 | use warnings; 16 | use Data::Dump qw(pp); 17 | use feature qw(say); 18 | use Parse::Easy::Term; 19 | our @ISA = qw(Parse::Easy::Token); 20 | use Carp; 21 | 22 | sub new { 23 | my ( $class, $type ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->{value} = $type; 26 | $type=~s/^T//; 27 | $self->{name} = sprintf "FReturnValueAs%s",$type; 28 | 29 | $self; 30 | } 31 | 32 | sub value { 33 | my ($self) = @_; 34 | $self->{value}; 35 | } 36 | 37 | sub name { 38 | my ($self) = @_; 39 | $self->{name}; 40 | } 41 | 42 | sub same { 43 | my ( $self, $that ) = @_; 44 | defined $that or return 0; 45 | $self == $that 46 | || $self->type() eq $that->type() 47 | && $self->{name} eq $that->{name}; 48 | } 49 | 50 | sub clone { 51 | my ($self) = @_; 52 | Parse::Easy::ReturnType->new( $self->{name} ); 53 | } 54 | 55 | sub toString { 56 | my ($self) = @_; 57 | $self->{name}; 58 | } 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /demos/Delphi/Calc/uMain.pas: -------------------------------------------------------------------------------- 1 | unit uMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls; 8 | 9 | type 10 | TMain = class(TForm) 11 | ParseBtn: TButton; 12 | DocLabel: TLabel; 13 | ExpressionEdit: TLabeledEdit; 14 | procedure ParseBtnClick(Sender: TObject); 15 | private 16 | { Private declarations } 17 | public 18 | { Public declarations } 19 | end; 20 | 21 | var 22 | Main: TMain; 23 | 24 | implementation 25 | 26 | {$R *.dfm} 27 | 28 | 29 | uses 30 | CalcLexer, 31 | CalcParser; 32 | 33 | procedure TMain.ParseBtnClick(Sender: TObject); 34 | var 35 | StringStream: TStringStream; 36 | Lexer: TCalcLexer; 37 | Parser: TCalcParser; 38 | begin 39 | StringStream := TStringStream.Create(ExpressionEdit.Text, TEncoding.UTF8); 40 | try 41 | Lexer := TCalcLexer.Create(StringStream); 42 | try 43 | Parser := TCalcParser.Create(Lexer); 44 | try 45 | Parser.Parse(); 46 | finally 47 | Parser.Free(); 48 | end; 49 | finally 50 | Lexer.Free(); 51 | end; 52 | finally 53 | StringStream.Free(); 54 | end; 55 | end; 56 | 57 | end. 58 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Token.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Token.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Token; 14 | use strict; 15 | use warnings; 16 | use Data::Dump qw(pp); 17 | use feature qw(say); 18 | use Carp; 19 | 20 | sub new { 21 | my ($class) = @_; 22 | my $self = { type => undef, }; 23 | bless $self, $class; 24 | ref($self) =~ /(\w+)$/ and $self->{type} = lc $1; 25 | $self; 26 | } 27 | 28 | sub clone { ... } 29 | sub same { ... } 30 | sub toString { ... } 31 | 32 | sub findIn { 33 | my ( $self, $array ) = @_; 34 | my $i = $self->indexIn($array); 35 | return $i >= 0 ? $array->[$i] : undef; 36 | } 37 | 38 | sub indexIn { 39 | my ( $self, $array ) = @_; 40 | $self->same( $array->[$_] ) and return $_ for ( 0 .. $#$array ); 41 | -1; 42 | } 43 | 44 | sub existsIn { 45 | my ( $self, $array ) = @_; 46 | $self->indexIn($array) >= 0; 47 | } 48 | 49 | sub addUniqueTo { 50 | my ( $self, $array ) = @_; 51 | $self->existsIn($array) and return 0; 52 | push @$array, $self; 53 | } 54 | 55 | sub type { 56 | my ($self) = @_; 57 | $self->{type}; 58 | } 59 | 1; 60 | -------------------------------------------------------------------------------- /demos/Delphi/Calc/Calc/CalcParser.pas: -------------------------------------------------------------------------------- 1 | 2 | // ------------------------------------------------------- 3 | // 4 | // This file was generated using Parse::Easy v1.0 alpha. 5 | // 6 | // https://github.com/MahdiSafsafi/Parse-Easy 7 | // 8 | // DO NOT EDIT !!! ANY CHANGE MADE HERE WILL BE LOST !!! 9 | // 10 | // ------------------------------------------------------- 11 | 12 | unit CalcParser; 13 | 14 | interface 15 | 16 | uses System.SysUtils, System.Classes, WinApi.Windows, 17 | Parse.Easy.Lexer.Token, 18 | Parse.Easy.Parser.LR1, 19 | Parse.Easy.Parser.CustomParser; 20 | 21 | type TCalcParser = class(TLR1) 22 | protected 23 | procedure UserAction(Index: Integer); override; 24 | public 25 | class constructor Create; 26 | end; 27 | 28 | implementation 29 | 30 | {$R 'CalcParser.res'} 31 | 32 | { TCalcParser } 33 | 34 | class constructor TCalcParser.Create; 35 | begin 36 | Deserialize('CALCPARSER'); 37 | end; 38 | 39 | procedure TCalcParser.UserAction(Index: Integer); 40 | begin 41 | case Index of 42 | 0000: 43 | begin 44 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsPointer); 45 | end; 46 | 0001: 47 | begin 48 | ReturnValue^.AsList := nil; 49 | end; 50 | end; 51 | end; 52 | 53 | end. 54 | -------------------------------------------------------------------------------- /lib/Parse/Easy/CharacterSet.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/CharacterSet.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::CharacterSet; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::IntervalSet); 19 | use Parse::Easy::IntervalSet; 20 | 21 | sub codePointToString { 22 | my ($codepoint) = @_; 23 | local $_ = chr $codepoint; 24 | if ( $_ eq ' ' ) { 25 | return sprintf "'%s'", $_ ; 26 | } 27 | elsif (/\p{XPosixPrint}/) { 28 | return sprintf "'%s'", $_ ; 29 | } 30 | else { 31 | return sprintf "'\\u%04x'", $codepoint ; 32 | } 33 | } 34 | 35 | sub new { 36 | my ($class) = shift; 37 | my $self = $class->SUPER::new(@_); 38 | } 39 | 40 | sub toString { 41 | my ($self) = @_; 42 | my @sets = $self->sets(); 43 | my @data = (); 44 | foreach my $set (@sets) { 45 | my $min = $set->min(); 46 | my $max = $set->max(); 47 | my $data = 48 | $min == $max 49 | ? sprintf "%s", codePointToString($min) 50 | : sprintf "%s .. %s", codePointToString($min), codePointToString($max); 51 | 52 | push @data, $data; 53 | } 54 | sprintf "[%s]", join ', ', @data ; 55 | } 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Code.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Code.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Code; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::Token); 19 | use Parse::Easy::Token; 20 | use Digest::MD5 qw(md5 md5_hex); 21 | 22 | sub new { 23 | my ( $class, $code ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->{code} = $code; 26 | $self->{index} = undef; 27 | $self->{hashcode} = md5_hex($code); 28 | $self; 29 | } 30 | 31 | sub index { 32 | my ( $self, $value ) = @_; 33 | $self->{index} = $value // $self->{index}; 34 | } 35 | 36 | sub code { 37 | my ( $self, $value ) = @_; 38 | $self->{code} = $value // $self->{code}; 39 | } 40 | 41 | sub same { 42 | my ( $self, $that ) = @_; 43 | $self == $that 44 | || $self->type() eq $that->type() && $self->{hashcode} eq $that->{hashcode}; 45 | } 46 | 47 | sub clone { 48 | my ($self) = @_; 49 | bless { 50 | code => $self->{code}, 51 | hashcode => $self->{hashcode}, 52 | }, 53 | __PACKAGE__; 54 | } 55 | 56 | sub toString { 57 | my ($self) = @_; 58 | '{' . $self->{code} . '}'; 59 | } 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/Parse/Easy.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy; 14 | use strict; 15 | use warnings; 16 | use autodie; 17 | use feature qw/say/; 18 | use Parse::Easy::Parse::Parser; 19 | use Config; 20 | 21 | sub new { 22 | my ( $class, $file ) = @_; 23 | my $self = { file => $file, }; 24 | bless $self, $class; 25 | $self; 26 | } 27 | 28 | sub opening { 29 | my ($self) = @_; 30 | my $arch = $Config{use64bitint} ? 'x64' : 'x86'; 31 | print <opening(); 45 | my $file = $self->{file}; 46 | my $string = ''; 47 | local $/ = undef; 48 | open my $fh, '<', $file; 49 | $string = <$fh>; 50 | close $fh; 51 | printf "parsing file '%s'.\n",$file; 52 | my $parser = Parse::Easy::Parse::Parser->new(); 53 | $parser->YYInput($string); 54 | my $grammar = $parser->Run(); 55 | $grammar->process(); 56 | } 57 | 1; 58 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Lexer.CustomLexer.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Lexer.CustomLexer; 6 | 7 | interface 8 | 9 | uses 10 | System.SysUtils, 11 | System.Types, 12 | System.Classes, 13 | System.ZLib, 14 | Vcl.Dialogs, 15 | Parse.Easy.Lexer.CodePointStream, 16 | Parse.Easy.Lexer.VirtualMachine, 17 | Parse.Easy.Lexer.Token; 18 | 19 | type 20 | TCustomLexer = class(TVirtualMachine) 21 | private 22 | FToken: TToken; 23 | public 24 | constructor Create(AStream: TStringStream); override; 25 | destructor Destroy(); override; 26 | function Peek(): TToken; 27 | function Advance(): TToken; 28 | function GetTokenName(Index: Integer): string; virtual; abstract; 29 | end; 30 | 31 | implementation 32 | 33 | { TCustomLexer } 34 | 35 | constructor TCustomLexer.Create(AStream: TStringStream); 36 | begin 37 | inherited; 38 | FToken := nil; 39 | end; 40 | 41 | destructor TCustomLexer.Destroy(); 42 | begin 43 | 44 | inherited; 45 | end; 46 | 47 | function TCustomLexer.Advance(): TToken; 48 | begin 49 | Result := FToken; 50 | FToken := Parse(); 51 | end; 52 | 53 | function TCustomLexer.Peek: TToken; 54 | begin 55 | if not Assigned(FToken) then 56 | Advance(); 57 | Result := FToken; 58 | end; 59 | 60 | end. 61 | -------------------------------------------------------------------------------- /demos/Delphi/Expression/uMain.pas: -------------------------------------------------------------------------------- 1 | unit uMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | type 10 | TMain = class(TForm) 11 | ScriptMemo: TMemo; 12 | LogMemo: TMemo; 13 | ParseBtn: TButton; 14 | procedure ParseBtnClick(Sender: TObject); 15 | private 16 | { Private declarations } 17 | public 18 | { Public declarations } 19 | end; 20 | 21 | var 22 | Main: TMain; 23 | 24 | implementation 25 | 26 | uses 27 | System.Math, 28 | ExpressionLexer, 29 | ExpressionParser; 30 | 31 | {$R *.dfm} 32 | 33 | 34 | procedure TMain.ParseBtnClick(Sender: TObject); 35 | var 36 | Lexer: TExpressionLexer; 37 | Parser: TExpressionParser; 38 | StringStream: TStringStream; 39 | begin 40 | StringStream := TStringStream.Create(ScriptMemo.Text, TEncoding.UTF8); 41 | try 42 | Lexer := TExpressionLexer.Create(StringStream); 43 | try 44 | Parser := TExpressionParser.Create(Lexer); 45 | try 46 | Parser.Console := LogMemo; 47 | Parser.Parse(); 48 | finally 49 | Parser.Free(); 50 | end; 51 | finally 52 | Lexer.Free(); 53 | end; 54 | finally 55 | StringStream.Free(); 56 | end; 57 | end; 58 | 59 | initialization 60 | 61 | ReportMemoryLeaksOnShutdown := True; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSON.g: -------------------------------------------------------------------------------- 1 | grammar JSON; 2 | 3 | fragment HEX : [0-9a-fA-F]; 4 | 5 | fragment ESCAPED_CHAR 6 | : "\\" 7 | | '"' 8 | | '/' 9 | | 'b' 10 | | 'n' 11 | | 'r' 12 | | 't' 13 | | 'u' HEX HEX HEX HEX 14 | ; 15 | 16 | fragment CHAR 17 | : [\X [\u0020-\uffff] - ["\\]] 18 | ; 19 | 20 | fragment ESCAPE 21 | : BACKSLASH ESCAPED_CHAR 22 | ; 23 | 24 | BACKSLASH : "\\"; 25 | LPAREN : '('; 26 | RPAREN : ')'; 27 | LBRACE : '{'; 28 | RBRACE : '}'; 29 | LBRACK : '['; 30 | RBRACK : ']'; 31 | SQUOTE : "'"; //' 32 | DQUOTE : '"'; 33 | PLUS : '+'; 34 | MINUS : '-'; 35 | COLON : ':'; 36 | COMMA : ','; 37 | 38 | TK_FALSE : 'false'; 39 | TK_TRUE : 'true'; 40 | TK_NULL : 'null'; 41 | 42 | DQSTRING : DQUOTE (CHAR | ESCAPE)* DQUOTE; 43 | 44 | DIGIT : '0' | [1-9][0-9]*; 45 | FRAC : '.' [0-9]+; 46 | EXP : [Ee] ('+'|'-') [0-9]+; 47 | 48 | WS : [\u0009\u000a\u000d\u0020]+ {Skip}; 49 | 50 | 51 | json 52 | : element 53 | ; 54 | 55 | element 56 | : object 57 | | array 58 | | string 59 | | number 60 | | TK_FALSE 61 | | TK_TRUE 62 | | TK_NULL 63 | ; 64 | 65 | object 66 | : LBRACE props? RBRACE 67 | ; 68 | 69 | props 70 | : prop COMMA props 71 | | prop 72 | ; 73 | 74 | prop 75 | : string COLON element 76 | ; 77 | 78 | array 79 | : LBRACK elements? RBRACK 80 | ; 81 | 82 | elements 83 | : element COMMA elements 84 | | element 85 | ; 86 | 87 | string 88 | : DQSTRING 89 | ; 90 | 91 | number 92 | : int FRAC? EXP? 93 | ; 94 | 95 | int 96 | : MINUS? DIGIT 97 | ; 98 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/uMain.pas: -------------------------------------------------------------------------------- 1 | unit uMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 8 | 9 | type 10 | TMain = class(TForm) 11 | ParseBtn: TButton; 12 | LogMemo: TMemo; 13 | procedure ParseBtnClick(Sender: TObject); 14 | private 15 | { Private declarations } 16 | public 17 | { Public declarations } 18 | end; 19 | 20 | var 21 | Main: TMain; 22 | 23 | implementation 24 | 25 | {$R *.dfm} 26 | 27 | 28 | uses 29 | System.Types, 30 | System.IOUtils, 31 | JSONLexer, 32 | JSONParser; 33 | 34 | procedure TMain.ParseBtnClick(Sender: TObject); 35 | var 36 | StringStream: TStringStream; 37 | Lexer: TJSONLexer; 38 | Parser: TJSONParser; 39 | Files: TStringDynArray; 40 | I: Integer; 41 | Path: string; 42 | begin 43 | Files := System.IOUtils.TDirectory.GetFiles('../../examples'); 44 | LogMemo.Clear(); 45 | for I := 0 to Length(Files) - 1 do 46 | begin 47 | Path := Files[I]; 48 | LogMemo.Lines.Add(Format('parsing json file "%s"', [Path])); 49 | Sleep(100); 50 | StringStream := TStringStream.Create(); 51 | try 52 | StringStream.LoadFromFile(Path); 53 | Lexer := TJSONLexer.Create(StringStream); 54 | try 55 | Parser := TJSONParser.Create(Lexer); 56 | try 57 | Parser.Parse(); 58 | finally 59 | Parser.Free(); 60 | end; 61 | finally 62 | Lexer.Free(); 63 | end; 64 | finally 65 | StringStream.Free(); 66 | end; 67 | end; 68 | end; 69 | 70 | end. 71 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/opcodes.txt: -------------------------------------------------------------------------------- 1 | # macros: 2 | db uimm8 [ u8 ] 3 | dw uimm16 [ u16 ] 4 | dd uimm32 [ u32 ] 5 | label [ ] 6 | 7 | vmstart [0x00] 8 | vmend [0x01] 9 | 10 | # call & branches instructions: 11 | call rel8 [0x02 ob] 12 | call rel16 [0x03 ow] 13 | call rel32 [0x04 od] 14 | b rel8 [0x05 ob] 15 | b rel16 [0x06 ow] 16 | b rel32 [0x07 od] 17 | beq rel8 [0x08 ob] 18 | beq rel16 [0x09 ow] 19 | beq rel32 [0x0a od] 20 | bneq rel8 [0x0b ob] 21 | bneq rel16 [0x0c ow] 22 | bneq rel32 [0x0d od] 23 | bgt rel8 [0x0e ob] 24 | bgt rel16 [0x0f ow] 25 | bgt rel32 [0x10 od] 26 | bge rel8 [0x11 ob] 27 | bge rel16 [0x12 ow] 28 | bge rel32 [0x13 od] 29 | blt rel8 [0x14 ob] 30 | blt rel16 [0x15 ow] 31 | blt rel32 [0x16 od] 32 | ble rel8 [0x17 ob] 33 | ble rel16 [0x18 ow] 34 | ble rel32 [0x19 od] 35 | 36 | # simple instructions: 37 | nop [0x1a] 38 | peek [0x1b] 39 | advance [0x1c] 40 | forget [0x1d] 41 | ret [0x1e] 42 | 43 | 44 | # setstate instructions: 45 | setstate uimm32 [0x23 u32] 46 | 47 | # mark instructions: 48 | mark imm8 [0x24 i8] 49 | mark imm16 [0x25 i16] 50 | mark imm32 [0x26 i32] 51 | 52 | 53 | 54 | # cmp instructions: 55 | cmp r0, uimm8 [0x27 u8 ] 56 | cmp r0, uimm16 [0x28 u16] 57 | cmp r0, uimm32 [0x29 u32] 58 | 59 | inrange rr, offset [0x2a mf] 60 | isatx imm8 [0x2b i8] 61 | 62 | 63 | # aliases for HINT: 64 | ststart [0x30 0x00] alias 65 | stend [0x30 0x01] alias 66 | 67 | # HINT instructions: 68 | hint uimm8 [0x30 u8] -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/Kernel.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/Kernel.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Lexer::Kernel; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Token; 19 | use Parse::Easy::Utils qw(sameItems); 20 | our @ISA = qw(Parse::Easy::Token); 21 | 22 | sub new { 23 | my ( $class, $grammar, $closures ) = @_; 24 | my @drivers = @$closures; 25 | my $index = scalar @{ $grammar->{kernels} }; 26 | my $self = $class->SUPER::new(); 27 | push @{ $grammar->{kernels} }, $self; 28 | %$self = ( 29 | %$self, 30 | ( 31 | name => sprintf( "Kernel%d", $index ), 32 | index => $index, 33 | grammar => $grammar, 34 | drivers => \@drivers, 35 | closures => $closures, 36 | gotos => [], 37 | ) 38 | ); 39 | $self; 40 | } 41 | 42 | sub addGoTo { 43 | my ( $self, $key, $target ) = @_; 44 | push @{ $self->{gotos} }, 45 | { 46 | key => $key, 47 | target => $target, 48 | }; 49 | } 50 | 51 | sub toString { 52 | my ($self) = @_; 53 | my @data = (); 54 | push @data, sprintf( "Kernel %d:\n", $self->{index} ); 55 | push @data, sprintf( "%s\n", $_->toString() ) foreach ( @{ $self->{drivers} } ); 56 | push @data, "\n"; 57 | foreach my $closure(@{$self->{closures}}){ 58 | $closure->ended() or next; 59 | push @data,sprintf "ACCEPT %s\n",$closure->{rule}->{name}; 60 | } 61 | 62 | foreach my $goto(@{$self->{gotos}}){ 63 | my $key=$goto->{key}; 64 | my $target = $goto->{target}; 65 | push @data,sprintf "%s => %d\n",$key->toString(), $target->{index}; 66 | } 67 | join( '', @data ); 68 | } 69 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parser/Kernel.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parser/Kernel.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parser::Kernel; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Token; 19 | use Parse::Easy::Utils qw(sameItems); 20 | our @ISA = qw(Parse::Easy::Token); 21 | 22 | sub new { 23 | my ( $class, $grammar, $closures ) = @_; 24 | my @drivers = @$closures; 25 | my $index = scalar @{ $grammar->{kernels} }; 26 | my $self = $class->SUPER::new(); 27 | push @{ $grammar->{kernels} }, $self; 28 | %$self = ( 29 | %$self, 30 | ( 31 | name => sprintf( "Kernel%d", $index ), 32 | index => $index, 33 | grammar => $grammar, 34 | drivers => \@drivers, 35 | closures => $closures, 36 | gotos => [], 37 | ) 38 | ); 39 | $self; 40 | } 41 | 42 | sub addGoTo { 43 | my ( $self, $key, $target ) = @_; 44 | push @{ $self->{gotos} }, 45 | { 46 | key => $key, 47 | target => $target, 48 | }; 49 | } 50 | 51 | sub toString { 52 | my ($self) = @_; 53 | my @data = (); 54 | push @data, sprintf( "Kernel %d:\n", $self->{index} ); 55 | push @data, sprintf( "%s\n", $_->toString() ) foreach ( @{ $self->{drivers} } ); 56 | push @data, "\n"; 57 | foreach my $closure(@{$self->{closures}}){ 58 | $closure->ended() or next; 59 | push @data,sprintf "ACCEPT %s\n",$closure->{rule}->{name}; 60 | } 61 | 62 | foreach my $goto(@{$self->{gotos}}){ 63 | my $key=$goto->{key}; 64 | my $target = $goto->{target}; 65 | push @data,sprintf "%s => %d\n",$key->toString(), $target->{index}; 66 | } 67 | join( '', @data ); 68 | } 69 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.StackPtr.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.StackPtr; 6 | 7 | interface 8 | 9 | const 10 | MAX_STACK_ITEM_COUNT = 4000; 11 | 12 | type 13 | TStackPtr = class(TObject) 14 | private 15 | FIndex: Integer; 16 | FArray: array [0 .. MAX_STACK_ITEM_COUNT - 1] of Pointer; 17 | function GetCount: Integer; 18 | function GetItem(Index: Integer): Pointer; 19 | procedure SetItem(Index: Integer; const Value: Pointer); 20 | public 21 | constructor Create; virtual; 22 | destructor Destroy; override; 23 | procedure Push(Value: Pointer); 24 | function Pop(): Pointer; 25 | function Peek(): Pointer; 26 | property Count: Integer read GetCount; 27 | property Items[Index: Integer]: Pointer read GetItem write SetItem; default; 28 | end; 29 | 30 | implementation 31 | 32 | { TStackPtr } 33 | 34 | constructor TStackPtr.Create; 35 | begin 36 | FIndex := 0; 37 | end; 38 | 39 | destructor TStackPtr.Destroy; 40 | begin 41 | 42 | inherited; 43 | end; 44 | 45 | function TStackPtr.GetCount: Integer; 46 | begin 47 | Result := FIndex; 48 | end; 49 | 50 | function TStackPtr.Peek: Pointer; 51 | begin 52 | Result := FArray[FIndex - 1]; 53 | end; 54 | 55 | function TStackPtr.Pop: Pointer; 56 | begin 57 | Result := FArray[FIndex - 1]; 58 | Dec(FIndex); 59 | end; 60 | 61 | procedure TStackPtr.Push(Value: Pointer); 62 | begin 63 | FArray[FIndex] := Value; 64 | Inc(FIndex); 65 | end; 66 | 67 | function TStackPtr.GetItem(Index: Integer): Pointer; 68 | begin 69 | Result := FArray[index]; 70 | end; 71 | 72 | procedure TStackPtr.SetItem(Index: Integer; const Value: Pointer); 73 | begin 74 | FArray[Index] := Value; 75 | end; 76 | 77 | end. 78 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/RecursiveDescentLexer.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parse/RecursiveDescentLexer.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parse::RecursiveDescentLexer; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | 19 | sub new { 20 | my ( $class, $input ) = @_; 21 | my $self = { 22 | input => ref($input) ? $input : \$input, 23 | current => undef, 24 | matched => undef, 25 | }; 26 | bless $self, $class; 27 | $self; 28 | } 29 | 30 | sub next { ... } 31 | sub error { ... } 32 | sub expect { ... } 33 | sub matched { $_[0]->{matched} } 34 | 35 | sub fetch { 36 | my $self = shift; 37 | my ( $type, $value ) = $self->next(); 38 | return { 39 | type => $type, 40 | value => $value, 41 | }; 42 | } 43 | 44 | sub check { 45 | my ( $self, $type ) = @_; 46 | $self->EOF() and return 0; 47 | $self->peek()->{type} eq $type; 48 | } 49 | 50 | sub match { 51 | my ( $self, $symbols, $raise ) = @_; 52 | 53 | for my $i ( 0 .. @$symbols - 1 ) { 54 | my $symbol = $symbols->[$i]; 55 | if ( $self->check($symbol) ) { 56 | $self->{matched} = $symbol; 57 | $self->advance(); 58 | return 1; 59 | } 60 | } 61 | if ($raise) { 62 | $self->expect( $symbols ); 63 | } 64 | 0; 65 | } 66 | 67 | sub skip { 68 | my ( $self, $symbols ) = @_; 69 | $self->match( $symbols, 1 ); 70 | } 71 | 72 | sub EOF { 73 | my ($self) = @_; 74 | $self->peek()->{type} eq ''; 75 | } 76 | 77 | sub advance { 78 | my ($self) = @_; 79 | my $current = $self->{current}; 80 | $self->{current} = $self->fetch(); 81 | $current; 82 | } 83 | 84 | sub peek { 85 | my ($self) = @_; 86 | $self->{current}; 87 | } 88 | 89 | 1; 90 | -------------------------------------------------------------------------------- /demos/Delphi/Calc/Calc/CalcLexer.pas: -------------------------------------------------------------------------------- 1 | 2 | // ------------------------------------------------------- 3 | // 4 | // This file was generated using Parse::Easy v1.0 alpha. 5 | // 6 | // https://github.com/MahdiSafsafi/Parse-Easy 7 | // 8 | // DO NOT EDIT !!! ANY CHANGE MADE HERE WILL BE LOST !!! 9 | // 10 | // ------------------------------------------------------- 11 | 12 | unit CalcLexer; 13 | 14 | interface 15 | 16 | uses System.SysUtils, WinApi.Windows, 17 | Parse.Easy.Lexer.CustomLexer; 18 | 19 | type TCalcLexer = class(TCustomLexer) 20 | protected 21 | procedure UserAction(Index: Integer); override; 22 | public 23 | class constructor Create; 24 | function GetTokenName(Index: Integer): string; override; 25 | end; 26 | 27 | const 28 | 29 | EOF = 0000; 30 | LPAREN = 0001; 31 | RPAREN = 0002; 32 | PLUS = 0003; 33 | MINUS = 0004; 34 | STAR = 0005; 35 | SLASH = 0006; 36 | DECIMAL = 0007; 37 | FLOAT = 0008; 38 | WS = 0009; 39 | SECTION_DEFAULT = 0000; 40 | 41 | 42 | implementation 43 | 44 | {$R CalcLexer.RES} 45 | 46 | { TCalcLexer } 47 | 48 | class constructor TCalcLexer.Create; 49 | begin 50 | Deserialize('CALCLEXER'); 51 | end; 52 | 53 | procedure TCalcLexer.UserAction(Index: Integer); 54 | begin 55 | case Index of 56 | 0000: 57 | begin 58 | skip 59 | end; 60 | end; 61 | end; 62 | 63 | function TCalcLexer.GetTokenName(Index: Integer): string; 64 | begin 65 | case Index of 66 | 0000 : exit('EOF' ); 67 | 0001 : exit('LPAREN' ); 68 | 0002 : exit('RPAREN' ); 69 | 0003 : exit('PLUS' ); 70 | 0004 : exit('MINUS' ); 71 | 0005 : exit('STAR' ); 72 | 0006 : exit('SLASH' ); 73 | 0007 : exit('DECIMAL' ); 74 | 0008 : exit('FLOAT' ); 75 | 0009 : exit('WS' ); 76 | end; 77 | Result := 'Unkown' + IntToStr(Index); 78 | end; 79 | 80 | end. 81 | -------------------------------------------------------------------------------- /lib/Parse/Easy/StreamWriter.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/StreamWriter.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::StreamWriter; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Endian qw(unpackInteger); 19 | use Carp; 20 | 21 | sub new { 22 | my ( $class, $endian ) = @_; 23 | my $self = { 24 | endian => $endian, 25 | pos => 0, 26 | data => '', 27 | }; 28 | bless $self, $class; 29 | $self; 30 | } 31 | 32 | sub size { $_[0]->{pos} } 33 | 34 | sub pos { 35 | my ( $self, $value ) = @_; 36 | $self->{pos} = $value // $self->{pos}; 37 | } 38 | 39 | sub bytes { 40 | my ($self) = @_; 41 | unpack "C*", $self->{data}; 42 | } 43 | 44 | sub writeBytes { 45 | my ($self) = shift; 46 | vec( $self->{data}, $self->{pos}++, 8 ) = $_ foreach (@_); 47 | } 48 | 49 | sub writeString { 50 | my ( $self, $string ) = @_; 51 | $self->writeBytes( unpack "C*", pack "Z*", $string ); 52 | } 53 | 54 | sub writeUnicode { 55 | my ( $self, $string ) = @_; 56 | my @chars = $string =~ /(.)/g; 57 | $self->writeInteger( ord $_, 2 ) foreach (@chars); 58 | $self->writeInteger( 0, 2 ); 59 | } 60 | 61 | sub write8 { 62 | my ( $self, $value ) = @_; 63 | $self->writeBytes($value); 64 | } 65 | 66 | sub write16 { 67 | my ( $self, $value, $signed ) = @_; 68 | $self->writeInteger( $value, 2, $signed ); 69 | } 70 | 71 | sub write32 { 72 | my ( $self, $value, $signed ) = @_; 73 | $self->writeInteger( $value, 4, $signed ); 74 | } 75 | 76 | sub write64 { 77 | my ( $self, $value, $signed ) = @_; 78 | $self->writeInteger( $value, 8, $signed ); 79 | } 80 | 81 | sub writeInteger { 82 | my ( $self, $value, $size, $signed ) = @_; 83 | $value // croak; 84 | $self->writeBytes( unpackInteger( $value, $size, $signed, $self->{endian} ) ); 85 | } 86 | 87 | 1; 88 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Utils.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Utils.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Utils; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Exporter qw(import); 19 | our @EXPORT_OK = qw(elapsed sameItems normalizeRanges); 20 | use Unicode::UCD; 21 | use Carp; 22 | use Time::HiRes; 23 | 24 | sub elapsed { 25 | my ( $name, $code ) = @_; 26 | my $start = [Time::HiRes::gettimeofday]; 27 | $code->(); 28 | my $end = [Time::HiRes::gettimeofday]; 29 | my $elapsed = Time::HiRes::tv_interval( $start, $end ); 30 | printf "function %s executed in %s.\n", $name, $elapsed; 31 | } 32 | 33 | sub normalizeRanges { 34 | my ($ref) = @_; 35 | my @ranges = (); 36 | my $i = 0; 37 | my $set = Parse::Easy::CharacterSet->new(); 38 | while (1) { 39 | my $current = $ref->[ $i++ ] // last; 40 | my $next = $ref->[ $i++ ] // push( @ranges, { from => $current, to => $Unicode::UCD::MAX_CP } ) && last; 41 | push @ranges, { from => $current, to => --$next }; 42 | } 43 | foreach my $range (@ranges) { 44 | my $pattern = sprintf "%d-%d", $range->{from}, $range->{to}; 45 | my $interval = Parse::Easy::CharacterSet->new($pattern); 46 | $set->U($interval); 47 | } 48 | $set; 49 | } 50 | 51 | sub sameItems { 52 | my ( $array1, $array2, $byReference ) = @_; 53 | my $count = scalar @$array1; 54 | $count != scalar @$array2 and return 0; 55 | for my $i ( 0 .. $count - 1 ) { 56 | my $a = $array1->[$i]; 57 | my $b = $array2->[$i]; 58 | my $ref = ref($a); 59 | $ref ne ref($b) and return 0; 60 | $ref && $a == $b and next; 61 | 62 | if ($byReference) { 63 | !$ref and croak( sprintf("sameItems expecting reference item.") ); 64 | $a == $b or return 0; 65 | } 66 | else { 67 | if ($ref) { 68 | $a->same($b) or return 0; 69 | } 70 | else { 71 | $a eq $b or return 0; 72 | } 73 | } 74 | } 75 | 1; 76 | } 77 | 78 | 1; 79 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/Closure.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/Closure.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Lexer::Closure; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::Token); 19 | use Parse::Easy::Utils qw(sameItems); 20 | 21 | sub new { 22 | my ( $class, $rule, $dotIndex, $items ) = @_; 23 | my $self = $class->SUPER::new(); 24 | my @items = @$items; 25 | $self->{rule} = $rule; 26 | $self->{dotIndex} = $dotIndex; 27 | $self->{items} = \@items; 28 | $self; 29 | } 30 | 31 | sub dotIndex { 32 | my ( $self, $value ) = @_; 33 | $self->{dotIndex} = $value // $self->{dotIndex}; 34 | } 35 | 36 | sub rule { 37 | my ($self) = @_; 38 | $self->{rule}; 39 | } 40 | 41 | sub items { 42 | my ($self) = @_; 43 | $self->{items}; 44 | } 45 | 46 | sub ended { 47 | my ($self) = @_; 48 | $self->{dotIndex} >= scalar @{ $self->{items} }; 49 | } 50 | 51 | sub clone { 52 | my ($self) = @_; 53 | Parse::Easy::Lexer::Closure->new( $self->{rule}, $self->{dotIndex}, $self->{items} ); 54 | } 55 | 56 | sub nextClosure { 57 | my ($self) = @_; 58 | $self->ended() and return undef; 59 | my $next = $self->clone(); 60 | $next->{dotIndex}++; 61 | $next; 62 | } 63 | 64 | sub same { 65 | my ( $self, $that ) = @_; 66 | $self == $that 67 | || $self->{rule} == $that->{rule} && # same rule 68 | $self->{dotIndex} == $that->{dotIndex} && # same dotIndex 69 | sameItems( $self->{items}, $that->{items}, 1 ) # same items 70 | } 71 | 72 | sub toString { 73 | my ($self) = @_; 74 | my $rule = $self->{rule}; 75 | my $dotIndex = $self->{dotIndex}; 76 | my $count = scalar @{ $self->{items} }; 77 | my @data = (); 78 | for my $i ( 0 .. $count - 1 ) { 79 | my $item = $self->{items}->[$i]; 80 | $dotIndex == $i and push @data, "."; 81 | push @data, $item->toString(); 82 | } 83 | $dotIndex >= $count and push @data, "."; 84 | sprintf "%s -> %s", $rule->{name}, join ' ', @data; 85 | } 86 | 1; 87 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ############################################################### 2 | # Parse::Easy # 3 | ############################################################### 4 | 5 | *.binary 6 | *.verbosity 7 | *.rc 8 | 9 | ############################################################### 10 | # Eclipse # 11 | ############################################################### 12 | 13 | .includepath 14 | .project 15 | 16 | ############################################################### 17 | # Delphi # 18 | ############################################################### 19 | 20 | # Delphi compiler-generated binaries (safe to delete) 21 | *.exe 22 | *.dll 23 | *.bpl 24 | *.bpi 25 | *.dcp 26 | *.so 27 | *.apk 28 | *.drc 29 | *.map 30 | *.dres 31 | *.rsm 32 | *.tds 33 | *.dcu 34 | *.lib 35 | *.a 36 | *.o 37 | *.ocx 38 | 39 | # Delphi autogenerated files (duplicated info) 40 | *.cfg 41 | *.hpp 42 | *Resource.rc 43 | 44 | # Delphi local files (user-specific info) 45 | *.local 46 | *.identcache 47 | *.projdata 48 | *.tvsconfig 49 | *.dsk 50 | 51 | # Delphi history and backups 52 | __history/ 53 | __recovery/ 54 | *.~* 55 | 56 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 57 | *.stat 58 | 59 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 60 | modules/ 61 | 62 | ############################################################### 63 | # Perl # 64 | ############################################################### 65 | 66 | !Build/ 67 | .last_cover_stats 68 | /META.yml 69 | /META.json 70 | /MYMETA.* 71 | *.o 72 | *.pm.tdy 73 | *.bs 74 | 75 | # Devel::Cover 76 | cover_db/ 77 | 78 | # Devel::NYTProf 79 | nytprof.out 80 | 81 | # Dizt::Zilla 82 | /.build/ 83 | 84 | # Module::Build 85 | _build/ 86 | Build 87 | Build.bat 88 | 89 | # Module::Install 90 | inc/ 91 | 92 | # ExtUtils::MakeMaker 93 | /blib/ 94 | /_eumm/ 95 | /*.gz 96 | /Makefile 97 | /Makefile.old 98 | /MANIFEST.bak 99 | /pm_to_blib 100 | /*.zip 101 | 102 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSON/JSONParser.pas: -------------------------------------------------------------------------------- 1 | 2 | // ------------------------------------------------------- 3 | // 4 | // This file was generated using Parse::Easy v1.0 alpha. 5 | // 6 | // https://github.com/MahdiSafsafi/Parse-Easy 7 | // 8 | // DO NOT EDIT !!! ANY CHANGE MADE HERE WILL BE LOST !!! 9 | // 10 | // ------------------------------------------------------- 11 | 12 | unit JSONParser; 13 | 14 | interface 15 | 16 | uses System.SysUtils, System.Classes, WinApi.Windows, 17 | Parse.Easy.Lexer.Token, 18 | Parse.Easy.Parser.LR1, 19 | Parse.Easy.Parser.CustomParser; 20 | 21 | type TJSONParser = class(TLR1) 22 | protected 23 | procedure UserAction(Index: Integer); override; 24 | public 25 | class constructor Create; 26 | end; 27 | 28 | implementation 29 | 30 | {$R 'JSONParser.res'} 31 | 32 | { TJSONParser } 33 | 34 | class constructor TJSONParser.Create; 35 | begin 36 | Deserialize('JSONPARSER'); 37 | end; 38 | 39 | procedure TJSONParser.UserAction(Index: Integer); 40 | begin 41 | case Index of 42 | 0000: 43 | begin 44 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsPointer); 45 | end; 46 | 0001: 47 | begin 48 | ReturnValue^.AsList := nil; 49 | end; 50 | 0002: 51 | begin 52 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsPointer); 53 | end; 54 | 0003: 55 | begin 56 | ReturnValue^.AsList := nil; 57 | end; 58 | 0004: 59 | begin 60 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsToken); 61 | end; 62 | 0005: 63 | begin 64 | ReturnValue^.AsList := nil; 65 | end; 66 | 0006: 67 | begin 68 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsToken); 69 | end; 70 | 0007: 71 | begin 72 | ReturnValue^.AsList := nil; 73 | end; 74 | 0008: 75 | begin 76 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsToken); 77 | end; 78 | 0009: 79 | begin 80 | ReturnValue^.AsList := nil; 81 | end; 82 | end; 83 | end; 84 | 85 | end. 86 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Parser.State.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Parser.State; 6 | 7 | interface 8 | 9 | uses 10 | System.Classes, 11 | System.SysUtils; 12 | 13 | type 14 | TState = class(TObject) 15 | private 16 | FIndex: Integer; 17 | FTerms: TList; 18 | FNoTerms: TList; 19 | FNumberOfTerms: Integer; 20 | FNumberOfNoTerms: Integer; 21 | procedure SetNumberOfNoTerms(const Value: Integer); 22 | procedure SetNumberOfTerms(const Value: Integer); 23 | public 24 | constructor Create; virtual; 25 | destructor Destroy; override; 26 | property Index: Integer read FIndex write FIndex; 27 | property NumberOfTerms: Integer read FNumberOfTerms write SetNumberOfTerms; 28 | property NumberOfNoTerms: Integer read FNumberOfNoTerms write SetNumberOfNoTerms; 29 | property Terms: TList read FTerms; 30 | property NoTerms: TList read FNoTerms; 31 | end; 32 | 33 | implementation 34 | 35 | { TState } 36 | 37 | constructor TState.Create; 38 | begin 39 | FNumberOfTerms := -1; 40 | FNumberOfNoTerms := -1; 41 | FTerms := TList.Create; 42 | FNoTerms := TList.Create; 43 | end; 44 | 45 | destructor TState.Destroy; 46 | var 47 | I: Integer; 48 | begin 49 | for I := 0 to FTerms.Count - 1 do 50 | if Assigned(FTerms[I]) then 51 | TObject(FTerms[I]).Free; 52 | 53 | for I := 0 to FNoTerms.Count - 1 do 54 | if Assigned(FNoTerms[I]) then 55 | TObject(FNoTerms[I]).Free; 56 | 57 | FTerms.Free; 58 | FNoTerms.Free; 59 | inherited; 60 | end; 61 | 62 | procedure TState.SetNumberOfNoTerms(const Value: Integer); 63 | var 64 | I: Integer; 65 | begin 66 | if (FNumberOfNoTerms <> Value) then 67 | begin 68 | FNumberOfNoTerms := Value; 69 | FNoTerms.Clear; 70 | for I := 0 to Value - 1 do 71 | FNoTerms.Add(nil); 72 | end; 73 | end; 74 | 75 | procedure TState.SetNumberOfTerms(const Value: Integer); 76 | var 77 | I: Integer; 78 | begin 79 | if (FNumberOfTerms <> Value) then 80 | begin 81 | FNumberOfTerms := Value; 82 | FTerms.Clear; 83 | for I := 0 to Value - 1 do 84 | FTerms.Add(nil); 85 | end; 86 | end; 87 | 88 | end. 89 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/State.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/State.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Lexer::State; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Token; 19 | use Parse::Easy::Utils qw(sameItems); 20 | our @ISA = qw(Parse::Easy::Token); 21 | 22 | sub new { 23 | my ( $class, $kernel ) = @_; 24 | my $self = $class->SUPER::new(); 25 | $self->buildStateFromKernel($kernel); 26 | $self; 27 | } 28 | 29 | sub index { 30 | my ( $self, $index ) = @_; 31 | if ( defined $index ) { 32 | $self->{index} = $index; 33 | $self->{name} = "State$index"; 34 | } 35 | $self->{index}; 36 | } 37 | 38 | sub buildStateFromKernel { 39 | my ( $self, $kernel ) = @_; 40 | my @accepts = (); 41 | foreach my $closure ( @{ $kernel->{closures} } ) { 42 | $closure->ended() or next; 43 | push @accepts, $closure->{rule}; 44 | } 45 | my @gotos = sort { $a->{target} - $b->{target} } @{ $kernel->{gotos} }; 46 | $self->{gotos} = \@gotos; 47 | $self->{accepts} = \@accepts; 48 | } 49 | 50 | sub sameGotos { 51 | my ( $self, $that ) = @_; 52 | scalar @{ $self->{gotos} } != scalar @{ $that->{gotos} } and return 0; 53 | for my $i ( 0 .. scalar @{ $self->{gotos} } - 1 ) { 54 | my $a = $self->{gotos}->[$i]; 55 | my $b = $that->{gotos}->[$i]; 56 | $a->{target} == $b->{target} or return 0; 57 | $a->{key}->same( $b->{key} ) or return 0; 58 | } 59 | 1; 60 | } 61 | 62 | sub same { 63 | my ( $self, $that ) = @_; 64 | $self == $that 65 | || $self->type() eq $that->type() && # same type 66 | sameItems( $self->{accepts}, $that->{accepts}, 0 ) && # same accepted rules 67 | sameGotos( $self, $that ); 68 | } 69 | 70 | sub toString { 71 | my ($self) = @_; 72 | my @data = (); 73 | push @data, sprintf( "State %d:\n", $self->{index} ); 74 | foreach my $accept ( @{ $self->{accepts} } ) { 75 | push @data, sprintf "ACCEPT %s\n", $accept->{name}; 76 | } 77 | 78 | foreach my $goto ( @{ $self->{gotos} } ) { 79 | my $key = $goto->{key}; 80 | my $target = $goto->{target}; 81 | push @data, sprintf "%s => %d\n", $key->toString(), $target->{index}; 82 | } 83 | join( '', @data ); 84 | } 85 | 86 | 1; 87 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/JSON/JSONLexer.pas: -------------------------------------------------------------------------------- 1 | 2 | // ------------------------------------------------------- 3 | // 4 | // This file was generated using Parse::Easy v1.0 alpha. 5 | // 6 | // https://github.com/MahdiSafsafi/Parse-Easy 7 | // 8 | // DO NOT EDIT !!! ANY CHANGE MADE HERE WILL BE LOST !!! 9 | // 10 | // ------------------------------------------------------- 11 | 12 | unit JSONLexer; 13 | 14 | interface 15 | 16 | uses System.SysUtils, WinApi.Windows, 17 | Parse.Easy.Lexer.CustomLexer; 18 | 19 | type TJSONLexer = class(TCustomLexer) 20 | protected 21 | procedure UserAction(Index: Integer); override; 22 | public 23 | class constructor Create; 24 | function GetTokenName(Index: Integer): string; override; 25 | end; 26 | 27 | const 28 | 29 | EOF = 0000; 30 | BACKSLASH = 0001; 31 | LPAREN = 0002; 32 | RPAREN = 0003; 33 | LBRACE = 0004; 34 | RBRACE = 0005; 35 | LBRACK = 0006; 36 | RBRACK = 0007; 37 | SQUOTE = 0008; 38 | DQUOTE = 0009; 39 | PLUS = 0010; 40 | MINUS = 0011; 41 | COLON = 0012; 42 | COMMA = 0013; 43 | TK_FALSE = 0014; 44 | TK_TRUE = 0015; 45 | TK_NULL = 0016; 46 | DQSTRING = 0017; 47 | DIGIT = 0018; 48 | FRAC = 0019; 49 | EXP = 0020; 50 | WS = 0021; 51 | SECTION_DEFAULT = 0000; 52 | 53 | 54 | implementation 55 | 56 | {$R JSONLexer.RES} 57 | 58 | { TJSONLexer } 59 | 60 | class constructor TJSONLexer.Create; 61 | begin 62 | Deserialize('JSONLEXER'); 63 | end; 64 | 65 | procedure TJSONLexer.UserAction(Index: Integer); 66 | begin 67 | case Index of 68 | 0000: 69 | begin 70 | Skip 71 | end; 72 | end; 73 | end; 74 | 75 | function TJSONLexer.GetTokenName(Index: Integer): string; 76 | begin 77 | case Index of 78 | 0000 : exit('EOF' ); 79 | 0001 : exit('BACKSLASH'); 80 | 0002 : exit('LPAREN' ); 81 | 0003 : exit('RPAREN' ); 82 | 0004 : exit('LBRACE' ); 83 | 0005 : exit('RBRACE' ); 84 | 0006 : exit('LBRACK' ); 85 | 0007 : exit('RBRACK' ); 86 | 0008 : exit('SQUOTE' ); 87 | 0009 : exit('DQUOTE' ); 88 | 0010 : exit('PLUS' ); 89 | 0011 : exit('MINUS' ); 90 | 0012 : exit('COLON' ); 91 | 0013 : exit('COMMA' ); 92 | 0014 : exit('TK_FALSE'); 93 | 0015 : exit('TK_TRUE' ); 94 | 0016 : exit('TK_NULL' ); 95 | 0017 : exit('DQSTRING'); 96 | 0018 : exit('DIGIT' ); 97 | 0019 : exit('FRAC' ); 98 | 0020 : exit('EXP' ); 99 | 0021 : exit('WS' ); 100 | end; 101 | Result := 'Unkown' + IntToStr(Index); 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Target/Pascal/Parser.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Target/Pascal/Parser.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Target::Pascal::Parser; 14 | use strict; 15 | use warnings; 16 | use autodie; 17 | use Parse::Easy::Target::Pascal::Header qw(get_header); 18 | my $header = get_header(); 19 | 20 | sub new { 21 | my ( $class, $parser ) = @_; 22 | my $self = { parser => $parser, }; 23 | bless $self, $class; 24 | $self; 25 | } 26 | 27 | sub generate { 28 | my ($self) = @_; 29 | my $parser = $self->{parser}; 30 | my $name = $parser->{name}; 31 | my $parentunitname = $parser->{parentunitname}; 32 | my $parentclassname = $parser->{parentclassname}; 33 | my $classname = $parser->{classname}; 34 | my $unitname = $parser->{unitname}; 35 | my $unitfile = $parser->{unitfile}; 36 | my $resfile = $parser->{resfile}; 37 | my @actions = (); 38 | foreach my $rule ( @{ $parser->{allRules} } ) { 39 | my $action = $rule->{action}; 40 | $action or next; 41 | push @actions, { index => $action->index(), data => $action->code() }; 42 | } 43 | 44 | open my $fh, '>', $unitfile; 45 | printf $fh $header; 46 | printf $fh "unit %s;\n\n", $unitname; 47 | printf $fh "interface\n\n"; 48 | printf $fh "uses System.SysUtils, System.Classes, WinApi.Windows, \n"; 49 | printf $fh " %s,\n", $_ foreach ( @{ $parser->{units} } ); 50 | printf $fh " Parse.Easy.Lexer.Token,\n"; 51 | printf $fh " %s,\n", $parentunitname if($parentunitname); 52 | printf $fh " Parse.Easy.Parser.CustomParser;\n\n"; 53 | printf $fh "type %s = class(%s)\n", $classname, $parentclassname; 54 | printf $fh " protected\n"; 55 | printf $fh " procedure UserAction(Index: Integer); override;\n"; 56 | printf $fh " public\n"; 57 | printf $fh " class constructor Create;\n"; 58 | printf $fh "end;\n\n"; 59 | 60 | printf $fh "implementation\n\n"; 61 | printf $fh "{\$R '%s'}\n\n", $resfile; 62 | 63 | printf $fh "{ %s }\n\n", $classname; 64 | 65 | printf $fh "class constructor %s.%s;\n", $classname, 'Create'; 66 | printf $fh "begin\n"; 67 | printf $fh " Deserialize('%s');\n", uc $name; 68 | printf $fh "end;\n\n"; 69 | 70 | printf $fh "procedure %s.%s(Index: Integer);\n", $classname, 'UserAction'; 71 | printf $fh "begin\n"; 72 | if (@actions) { 73 | printf $fh " case Index of\n"; 74 | foreach my $item (@actions) { 75 | printf $fh " %04d:\n", $item->{index}; 76 | printf $fh " begin\n"; 77 | printf $fh " %s\n", $item->{data}; 78 | printf $fh " end;\n"; 79 | } 80 | printf $fh " end;\n"; 81 | } 82 | printf $fh "end;\n\n"; 83 | 84 | printf $fh "end.\n"; 85 | close $fh; 86 | } 87 | 1; 88 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/opcodes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/opcodes.pl Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | use strict; 14 | use warnings; 15 | use feature qw(say); 16 | use Data::Dump qw(pp); 17 | 18 | my @instructions = (); 19 | my $file = 'opcodes.txt'; 20 | open my $fh, '<', $file or die $!; 21 | 22 | my %char2size = ( 23 | b => 8, 24 | w => 16, 25 | d => 32, 26 | ); 27 | 28 | sub maxSize { 29 | my ($patterns) = @_; 30 | my $result = 0; 31 | for my $i ( 0 .. @$patterns - 1 ) { 32 | local $_ = $patterns->[$i]; 33 | if (/^0x[a-f0-9]{2}$/) { 34 | $result += 8; 35 | } 36 | elsif (/^o([bwd])$/) { 37 | $result += $char2size{$1}; 38 | } 39 | elsif (/^[iu](\d+)$/) { 40 | $result += $1; 41 | } 42 | elsif (/^mr$/) { 43 | $result += 8; 44 | } 45 | elsif (/^mf$/) { 46 | $result += 8; 47 | $result += 32; 48 | } 49 | else { 50 | die "unable to handle '$_' in patterns."; 51 | } 52 | } 53 | $result % 8 and die "invalid instruction size."; 54 | 55 | $result / 8; 56 | } 57 | 58 | sub processInsn { 59 | my ( $syntax, $opcodes, $metadata ) = @_; 60 | local $_ = $syntax; 61 | s/^(\w+)\s*//; 62 | my $mnem = $1; 63 | my @args = split /\s*,\s*/; 64 | $_ = $opcodes; 65 | s/^\s+|\s+$//g; 66 | my @patterns = (); 67 | @patterns = split /\s+/ unless (/^\s*$/); 68 | my ( $immediate, $relative ) = ( 0, 0 ); 69 | 70 | foreach (@args) { 71 | /^[iu]mm\d+$/ and $immediate++; 72 | /^rel\d+$/ and $relative++; 73 | } 74 | my $maxsize = maxSize( \@patterns ); 75 | $metadata = $metadata // ''; 76 | my @flags = $metadata =~ /(\w+)/g; 77 | my $insn = { 78 | mnem => $mnem, 79 | args => \@args, 80 | patterns => \@patterns, 81 | relative => $relative, 82 | immediate => $immediate, 83 | maxsize => $maxsize, 84 | }; 85 | $insn->{$_} = 1 foreach (@flags); 86 | push @instructions, $insn; 87 | } 88 | 89 | while (<$fh>) { 90 | chomp; 91 | /^\s*(#.*)*$/ and next; 92 | die sprintf "invalid line %d" unless (/^\s*(.+?)\s+\[(.+?)\]\s*(.*)$/); 93 | processInsn( $1, $2, $3 ); 94 | } 95 | close $fh; 96 | 97 | open $fh, '>', 'OpCodes.pm' or die $!; 98 | 99 | printf $fh <<"EOF" 100 | ################################################# 101 | # automatically generated file. do not edit !!! # 102 | ################################################# 103 | 104 | package Parse::Easy::Lexer::OpCodes; 105 | use strict; 106 | use warnings; 107 | use base qw(Exporter); 108 | our \@EXPORT_OK = qw(instructions); 109 | 110 | my \@instructions = %s; 111 | 112 | sub instructions { \\\@instructions } 113 | 114 | 1; 115 | EOF 116 | , pp @instructions; 117 | 118 | close $fh; 119 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Status: 2 | Parse::Easy is in an **ALPHA** state, meaning: 3 | - You **MAY** encounter some issues, bugs, memory-leaks. 4 | - Some features may not work as expected. 5 | - Documentation is not completed yet. 6 | - The specification is not final, and may also change. 7 | - There is a lot of features that are not availaible yet (some of them are partially implemented, the reset is not imlemented yet). The documentation and the examples will never refer/use them unless they are 100% imlemented. 8 | 9 | Please, help improving this tools by providing your feed-back. 10 | 11 | # Parse-Easy 12 | Parse::Easy is a lexer and parser generator for Pascal. When I started working on it, two things were critical for me. The first thing, making it an easy tools (that's why it's called Easy), easy means user friendly, that's it easy to use and easy to read/write grammars. The second thing, making it powerful, Parse::Easy is thread-safe, object-oriented, supports unicode, regular expressions, LR1, GLR,... 13 | 14 | ## Lexer features: 15 | - Parse::Easy::Lexer generates bytecodes instead of tables. which than handled by a virtual-machine (VM) that matches lexer patterns. 16 | - Parse::Easy::Lexer generates unicode lexer analyser. 17 | - Supports matching on particular conditions. 18 | - Supports unicode properties. 19 | - Supports character-set. 20 | - Supports expression on character-set. 21 | - Supports EBNF. 22 | - Lexer analyser produced by Parse::Easy::Lexer is thread-safe. 23 | 24 | ## Parser features: 25 | - Supports generating LR1 parser. 26 | - Supports generating GLR parser. 27 | - Supports EBNF. 28 | - Thread-safe. 29 | 30 | ## Documentation: 31 | Please refer to the wiki [page](https://github.com/MahdiSafsafi/Parse-Easy/wiki). 32 | 33 | ## Example: 34 | The following grammar, parses expression such ```5 * 2 + ((3.3 / 3) - 1)```. Note that it respects operator-precedences. 35 | 36 | There is also a full example (see demos folder) that parses and evaluates expressions and outputs the result to the console. 37 | ``` 38 | grammar Calc; 39 | 40 | // simple calc. 41 | 42 | // lexer fragments: 43 | // ---------------- 44 | fragment DIGIT : [0-9]+; 45 | 46 | // lexer rules: 47 | // ------------ 48 | LPAREN : '('; 49 | RPAREN : ')'; 50 | PLUS : '+'; 51 | MINUS : '-'; 52 | STAR : '*'; 53 | SLASH : '/'; 54 | 55 | DECIMAL : DIGIT; 56 | FLOAT : DIGIT '.' DIGIT; 57 | 58 | WS : [ \t\n\r]+ {skip}; // ignore white-space and newline. 59 | 60 | // parser rules: 61 | // ------------- 62 | expression 63 | : addSubExpression 64 | ; 65 | 66 | addSubExpression 67 | : addSubExpression (PLUS | MINUS) mulDivExpression 68 | | mulDivExpression 69 | ; 70 | 71 | mulDivExpression 72 | : mulDivExpression (STAR | SLASH) unaryExpression 73 | | unaryExpression 74 | ; 75 | 76 | unaryExpression 77 | : (PLUS | MINUS)? primaryExpression 78 | ; 79 | 80 | primaryExpression 81 | : LPAREN expression RPAREN 82 | | DECIMAL 83 | | FLOAT 84 | ; 85 | ``` 86 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parser/Closure.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parser/Closure.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parser::Closure; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::Token); 19 | use Parse::Easy::Utils qw(sameItems); 20 | 21 | sub new { 22 | my ( $class, $rule, $dotIndex ) = @_; 23 | my $self = $class->SUPER::new(); 24 | $self->{rule} = $rule; 25 | $self->{dotIndex} = $dotIndex; 26 | $self->{lookAheads} = []; 27 | $self->computeLookAheads(); 28 | $self; 29 | } 30 | 31 | sub computeLookAheads { 32 | my ($self) = @_; 33 | my $rule = $self->{rule}; 34 | my $name = $rule->name(); 35 | my $grammar = $rule->{grammar}; 36 | my @follows = @{ $grammar->{follows}->{$name} }; 37 | $self->{lookAheads}=\@follows; 38 | } 39 | 40 | sub ended { 41 | my ($self) = @_; 42 | $self->{dotIndex} >= scalar @{ $self->{rule}->{items} }; 43 | } 44 | 45 | sub clone { 46 | my ($self) = @_; 47 | Parse::Easy::Parser::Closure->new( $self->{rule}, $self->{dotIndex} ); 48 | } 49 | 50 | sub nextClosure { 51 | my ($self) = @_; 52 | $self->ended() and return undef; 53 | my $item = $self->{rule}->{items}->[ $self->{dotIndex} ]; 54 | $item->type() eq 'epsilon' and return undef; 55 | my $next = $self->clone(); 56 | $next->{dotIndex}++; 57 | $next; 58 | } 59 | 60 | sub sameLookAheads { 61 | my ( $a, $b ) = @_; 62 | scalar @$a != scalar @$b and return 0; 63 | for my $i ( 0 .. scalar @$a - 1 ) { 64 | my $item1 = $a->[$i]; 65 | my $found = 0; 66 | for my $j ( 0 .. scalar @$b - 1 ) { 67 | my $item2 = $b->[$j]; 68 | if ( $item1->same($item2) ) { 69 | $found++; 70 | last; 71 | } 72 | } 73 | $found || return 0; 74 | } 75 | 1; 76 | } 77 | 78 | sub same { 79 | my ( $self, $that ) = @_; 80 | $self == $that 81 | || $self->{rule} == $that->{rule} && # same rule 82 | $self->{dotIndex} == $that->{dotIndex} && # same dotIndex 83 | sameLookAheads( $self->{lookAheads}, $that->{lookAheads} ); 84 | } 85 | 86 | sub toString { 87 | my ($self) = @_; 88 | my $rule = $self->{rule}; 89 | my $dotIndex = $self->{dotIndex}; 90 | my $count = scalar @{ $self->{rule}->{items} }; 91 | my @lookAheads = (); 92 | foreach my $lookahead ( @{ $self->{lookAheads} } ) { 93 | push @lookAheads, $lookahead->toString(); 94 | } 95 | my $lookAheads = join( ', ', @lookAheads ); 96 | my @data = (); 97 | for my $i ( 0 .. $count - 1 ) { 98 | my $item = $self->{rule}->{items}->[$i]; 99 | $dotIndex == $i and push @data, "."; 100 | push @data, $item->toString(); 101 | } 102 | $dotIndex >= $count and push @data, "."; 103 | sprintf "%s -> %s ; [%s]", $rule->{name}, join( ' ', @data ), $lookAheads; 104 | } 105 | 1; 106 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Grammar.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Grammar.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Grammar; 14 | use strict; 15 | use warnings; 16 | use feature qw(say fc); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Lexer; 19 | use Parse::Easy::Parser; 20 | use Parse::Easy::Wildcard; 21 | 22 | sub new { 23 | my ($class) = @_; 24 | my $self = { 25 | name => undef, 26 | lexer => undef, 27 | parser => undef, 28 | }; 29 | bless $self, $class; 30 | $self->{lexer} = Parse::Easy::Lexer->new(); 31 | $self->{parser} = Parse::Easy::Parser->new(); 32 | $self; 33 | } 34 | 35 | sub processUse { 36 | my ( $self, $name, $args ) = @_; 37 | my $lexer = $self->{lexer}; 38 | my $parser = $self->{parser}; 39 | my $fcname = lc $name; 40 | my %shortcuts = ( 41 | 'ascii' => 'lexer::ascii', 42 | 'unicode' => 'lexer::unicode', 43 | 'lr1' => 'parser::lr1', 44 | 'glr' => 'parser::glr', 45 | ); 46 | exists $shortcuts{$fcname} and $fcname = $shortcuts{$fcname}; 47 | my $lexerASCII = sub { 48 | $Parse::Easy::Wildcard::MIN = 0x00; 49 | $Parse::Easy::Wildcard::MAX = 0xff; 50 | }; 51 | my $lexerUnicode = sub { 52 | $Parse::Easy::Wildcard::MIN = 0x0000; 53 | $Parse::Easy::Wildcard::MAX = 0xffff; 54 | }; 55 | my $lexerCodePoint = sub { 56 | my ( $min, $max ) = @$args; 57 | defined $min and $Parse::Easy::Wildcard::MIN = $min; 58 | defined $max and $Parse::Easy::Wildcard::MAX = $max; 59 | }; 60 | my $parserBaseClass = sub { 61 | my ($class) = @$args; 62 | $parser->{parentclassname} = $class; 63 | }; 64 | my $parserUnits = sub { 65 | $parser->addUnit($_) foreach @$args; 66 | }; 67 | my $parserGLR = sub { 68 | $parser->{parentunitname} = 'Parse.Easy.Parser.GLR'; 69 | $parser->{parentclassname} = 'TGLR'; 70 | }; 71 | my $parserLR1 = sub { 72 | $parser->{parentunitname} = 'Parse.Easy.Parser.LR1'; 73 | $parser->{parentclassname} = 'TLR1'; 74 | }; 75 | 76 | my %uses = ( 77 | 'lexer::codepoints' => $lexerCodePoint, 78 | 'lexer::ascii' => $lexerASCII, 79 | 'lexer::unicode' => $lexerUnicode, 80 | 'parser::baseclass' => $parserBaseClass, 81 | 'parser::glr' => $parserGLR, 82 | 'parser::lr1' => $parserLR1, 83 | 'parser::units' => $parserUnits, 84 | ); 85 | my $action = $uses{$fcname}; 86 | unless ( defined $action ) { 87 | warn "unable to find package '$name'"; 88 | return; 89 | } 90 | $action->(); 91 | } 92 | 93 | sub process { 94 | my ($self) = @_; 95 | my $name = $self->{name}; 96 | my $lexer = $self->{lexer}; 97 | mkdir $name unless -d $name; 98 | chdir $name; 99 | $lexer->name("${name}Lexer"); 100 | $lexer->process(); 101 | 102 | my $parser = $self->{parser}; 103 | $parser->{lexer} = $lexer; 104 | $parser->name("${name}Parser"); 105 | $parser->process(); 106 | 107 | } 108 | 1; 109 | -------------------------------------------------------------------------------- /demos/Delphi/Expression/Expression/ExpressionLexer.pas: -------------------------------------------------------------------------------- 1 | 2 | // ------------------------------------------------------- 3 | // 4 | // This file was generated using Parse::Easy v1.0 alpha. 5 | // 6 | // https://github.com/MahdiSafsafi/Parse-Easy 7 | // 8 | // DO NOT EDIT !!! ANY CHANGE MADE HERE WILL BE LOST !!! 9 | // 10 | // ------------------------------------------------------- 11 | 12 | unit ExpressionLexer; 13 | 14 | interface 15 | 16 | uses System.SysUtils, WinApi.Windows, 17 | Parse.Easy.Lexer.CustomLexer; 18 | 19 | type TExpressionLexer = class(TCustomLexer) 20 | protected 21 | procedure UserAction(Index: Integer); override; 22 | public 23 | class constructor Create; 24 | function GetTokenName(Index: Integer): string; override; 25 | end; 26 | 27 | const 28 | 29 | EOF = 0000; 30 | LPAREN = 0001; 31 | RPAREN = 0002; 32 | PLUS = 0003; 33 | MINUS = 0004; 34 | STAR = 0005; 35 | SLASH = 0006; 36 | PERCENT = 0007; 37 | COMMA = 0008; 38 | EQUAL = 0009; 39 | SEMICOLON = 0010; 40 | COS = 0011; 41 | SIN = 0012; 42 | TAN = 0013; 43 | MIN = 0014; 44 | MAX = 0015; 45 | TK_VAR = 0016; 46 | CLEAR = 0017; 47 | ECHO = 0018; 48 | SQ_STRING = 0019; 49 | DQ_STRING = 0020; 50 | DIGIT = 0021; 51 | FLOAT = 0022; 52 | HEX = 0023; 53 | ID = 0024; 54 | COMMENT = 0025; 55 | WS = 0026; 56 | SECTION_DEFAULT = 0000; 57 | 58 | 59 | implementation 60 | 61 | {$R ExpressionLexer.RES} 62 | 63 | { TExpressionLexer } 64 | 65 | class constructor TExpressionLexer.Create; 66 | begin 67 | Deserialize('EXPRESSIONLEXER'); 68 | end; 69 | 70 | procedure TExpressionLexer.UserAction(Index: Integer); 71 | begin 72 | case Index of 73 | 0000: 74 | begin 75 | skip 76 | end; 77 | 0001: 78 | begin 79 | skip 80 | end; 81 | end; 82 | end; 83 | 84 | function TExpressionLexer.GetTokenName(Index: Integer): string; 85 | begin 86 | case Index of 87 | 0000 : exit('EOF' ); 88 | 0001 : exit('LPAREN' ); 89 | 0002 : exit('RPAREN' ); 90 | 0003 : exit('PLUS' ); 91 | 0004 : exit('MINUS' ); 92 | 0005 : exit('STAR' ); 93 | 0006 : exit('SLASH' ); 94 | 0007 : exit('PERCENT' ); 95 | 0008 : exit('COMMA' ); 96 | 0009 : exit('EQUAL' ); 97 | 0010 : exit('SEMICOLON'); 98 | 0011 : exit('COS' ); 99 | 0012 : exit('SIN' ); 100 | 0013 : exit('TAN' ); 101 | 0014 : exit('MIN' ); 102 | 0015 : exit('MAX' ); 103 | 0016 : exit('TK_VAR' ); 104 | 0017 : exit('CLEAR' ); 105 | 0018 : exit('ECHO' ); 106 | 0019 : exit('SQ_STRING'); 107 | 0020 : exit('DQ_STRING'); 108 | 0021 : exit('DIGIT' ); 109 | 0022 : exit('FLOAT' ); 110 | 0023 : exit('HEX' ); 111 | 0024 : exit('ID' ); 112 | 0025 : exit('COMMENT' ); 113 | 0026 : exit('WS' ); 114 | end; 115 | Result := 'Unkown' + IntToStr(Index); 116 | end; 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /lib/Parse/Easy/IntervalSet.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/IntervalSet.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::IntervalSet; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::Token); 19 | use Parse::Easy::Token; 20 | use Set::IntSpan; 21 | 22 | sub makeInterval { 23 | my ($arg) = @_; 24 | ref($arg) eq __PACKAGE__ and return $arg; 25 | Parse::Easy::IntervalSet->new($arg); 26 | } 27 | 28 | sub new { 29 | my ($class) = shift; 30 | my $arg = shift; 31 | my $self = $class->SUPER::new(); 32 | $self->{class} = $class; 33 | $self->{set} = defined $arg && ref($arg) eq 'Set::IntSpan' ? $arg : Set::IntSpan->new($arg); 34 | $self; 35 | } 36 | 37 | sub same { 38 | my ( $self, $that ) = @_; 39 | $self == $that 40 | || $self->type() eq $that->type() && $self->{set}->equal( $that->{set} ); 41 | } 42 | 43 | sub clone { 44 | my ($self) = @_; 45 | my $set = Set::IntSpan->new(''); 46 | $set->copy( $self->{set} ); 47 | $self->{class}->new($set); 48 | } 49 | 50 | sub empty { 51 | my ($self) = @_; 52 | $self->{set}->empty(); 53 | } 54 | 55 | sub union { 56 | my ( $self, $that ) = @_; 57 | my $set = $self->{set}->union( $that->{set} ); 58 | $self->{class}->new($set); 59 | } 60 | 61 | sub diff { 62 | my ( $self, $that ) = @_; 63 | my $set = $self->{set}->diff( $that->{set} ); 64 | $self->{class}->new($set); 65 | } 66 | 67 | sub interSection { 68 | my ( $self, $that ) = @_; 69 | my $set = $self->{set}->intersect( $that->{set} ); 70 | $self->{class}->new($set); 71 | } 72 | 73 | sub xor { 74 | my ( $self, $that ) = @_; 75 | my $set = $self->{set}->xor( $that->{set} ); 76 | $self->{class}->new($set); 77 | } 78 | 79 | sub complement { 80 | my ( $self, $that ) = @_; 81 | my $set = $self->{set}->complement( $that->{set} ); 82 | $self->{class}->new($set); 83 | } 84 | 85 | sub U { 86 | my ( $self, $that ) = @_; 87 | $self->{set}->U( $that->{set} ); 88 | $self; 89 | } 90 | 91 | sub D { 92 | my ( $self, $that ) = @_; 93 | $self->{set}->D( $that->{set} ); 94 | $self; 95 | } 96 | 97 | sub I { 98 | my ( $self, $that ) = @_; 99 | $self->{set}->I( $that->{set} ); 100 | $self; 101 | } 102 | 103 | sub X { 104 | my ( $self, $that ) = @_; 105 | $self->{set}->X( $that->{set} ); 106 | $self; 107 | } 108 | 109 | sub C { 110 | my ( $self, $that ) = @_; 111 | $self->{set}->C( $that->{set} ); 112 | $self; 113 | } 114 | 115 | sub size { 116 | my ($self) = @_; 117 | $self->{set}->size(); 118 | } 119 | 120 | sub min { 121 | my ($self) = @_; 122 | $self->{set}->min(); 123 | } 124 | 125 | sub max { 126 | my ($self) = @_; 127 | $self->{set}->max(); 128 | } 129 | 130 | sub sets { 131 | my ($self) = @_; 132 | my @sets = map { $self->{class}->new($_) } $self->{set}->sets(); 133 | } 134 | 135 | sub toString { 136 | my ($self) = @_; 137 | $self->{set}->run_list(); 138 | } 139 | 140 | 1; 141 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Lexer.CodePointStream.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Lexer.CodePointStream; 6 | 7 | interface 8 | 9 | uses 10 | System.SysUtils, 11 | System.Classes; 12 | 13 | type 14 | 15 | TCodePointStream = class(TObject) 16 | private 17 | FChars: TCharArray; 18 | FPosition: Integer; 19 | FCharCount: Integer; 20 | FLine: Integer; 21 | FColumn: Integer; 22 | function GetPosition: Integer; 23 | procedure SetPosition(const Value: Integer); 24 | function GetColumn: Integer; 25 | function GetLine: Integer; 26 | procedure SetColumn(const Value: Integer); 27 | procedure SetLine(const Value: Integer); 28 | public 29 | constructor Create(AStream: TStringStream); virtual; 30 | destructor Destroy(); override; 31 | function Peek(): Integer; 32 | function Advance(): Integer; 33 | function EndOfFile: Boolean; 34 | property Position: Integer read GetPosition write SetPosition; 35 | property Line: Integer read GetLine write SetLine; 36 | property Column: Integer read GetColumn write SetColumn; 37 | property Chars: TCharArray read FChars; 38 | property CharCount: Integer read FCharCount; 39 | end; 40 | 41 | implementation 42 | 43 | const 44 | EOF = -1; 45 | 46 | { TCodePointStream } 47 | 48 | constructor TCodePointStream.Create(AStream: TStringStream); 49 | begin 50 | FChars := AStream.Encoding.GetChars(AStream.Bytes, AStream.Position, 51 | AStream.Size - AStream.Position); 52 | FCharCount := Length(FChars); 53 | FPosition := 0; 54 | FLine := 1; 55 | FColumn := 1; 56 | end; 57 | 58 | destructor TCodePointStream.Destroy; 59 | begin 60 | 61 | inherited; 62 | end; 63 | 64 | function TCodePointStream.GetPosition: Integer; 65 | begin 66 | Result := FPosition; 67 | end; 68 | 69 | function TCodePointStream.GetColumn: Integer; 70 | begin 71 | Result := FColumn; 72 | end; 73 | 74 | function TCodePointStream.GetLine: Integer; 75 | begin 76 | Result := FLine; 77 | end; 78 | 79 | procedure TCodePointStream.SetColumn(const Value: Integer); 80 | begin 81 | FColumn := Value; 82 | end; 83 | 84 | procedure TCodePointStream.SetLine(const Value: Integer); 85 | begin 86 | FLine := Value; 87 | end; 88 | 89 | procedure TCodePointStream.SetPosition(const Value: Integer); 90 | begin 91 | FPosition := Value; 92 | end; 93 | 94 | function TCodePointStream.EndOfFile: Boolean; 95 | begin 96 | Result := FPosition >= FCharCount; 97 | end; 98 | 99 | function TCodePointStream.Peek: Integer; 100 | begin 101 | if EndOfFile() then 102 | exit(EOF); 103 | Result := Ord(FChars[FPosition]); 104 | end; 105 | 106 | function TCodePointStream.Advance: Integer; 107 | var 108 | CP: Integer; 109 | begin 110 | Result := Peek(); 111 | Inc(FPosition); 112 | CP := Peek(); 113 | if (CP = $000A) then 114 | begin 115 | Inc(FLine); 116 | FColumn := 0; 117 | end 118 | else 119 | Inc(FColumn); 120 | end; 121 | 122 | end. 123 | 124 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parser/State.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parser/State.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parser::State; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Token; 19 | use Parse::Easy::Utils qw(sameItems); 20 | our @ISA = qw(Parse::Easy::Token); 21 | 22 | use Parse::Easy::Parser::Action; 23 | my $ACTION_CLASS = 'Parse::Easy::Parser::Action'; 24 | 25 | sub new { 26 | my ( $class, $kernel ) = @_; 27 | my $self = $class->SUPER::new(); 28 | $self->index( $kernel->{index} ); 29 | $self->{gotos} = []; 30 | $self->buildStateFromKernel($kernel); 31 | $self; 32 | } 33 | 34 | sub index { 35 | my ( $self, $index ) = @_; 36 | if ( defined $index ) { 37 | $self->{index} = $index; 38 | $self->{name} = "State$index"; 39 | } 40 | $self->{index}; 41 | } 42 | 43 | sub addAction { 44 | my ( $self, $key, $action ) = @_; 45 | foreach my $item ( @{ $self->{gotos} } ) { 46 | if ( $item->{key}->same($key) ) { 47 | push @{ $item->{actions} }, $action; 48 | return 0; 49 | } 50 | } 51 | push @{ $self->{gotos} }, 52 | { 53 | key => $key, 54 | actions => [$action] 55 | }; 56 | } 57 | 58 | sub buildStateFromKernel { 59 | my ( $self, $kernel ) = @_; 60 | $self->{closures}=$kernel->{closures}; 61 | foreach my $item ( @{ $kernel->{gotos} } ) { 62 | my $key = $item->{key}; 63 | my $target = $item->{target}; 64 | my $action = undef; 65 | if ( $key->type() eq 'term' ) { 66 | $action = $ACTION_CLASS->new( 'SHIFT', $target ); 67 | } 68 | else { 69 | $action = $ACTION_CLASS->new( 'JUMP', $target ); 70 | } 71 | $self->addAction( $key, $action ); 72 | } 73 | foreach my $closure ( @{ $kernel->{closures} } ) { 74 | my $rule = $closure->{rule}; 75 | if ( $closure->ended() || $rule->{items}->[0]->type() eq 'epsilon' ) { 76 | foreach my $lookAhead ( @{ $closure->{lookAheads} } ) { 77 | my $action = $ACTION_CLASS->new( 'REDUCE', $rule ); 78 | $self->addAction( $lookAhead, $action ); 79 | } 80 | } 81 | } 82 | } 83 | 84 | sub toString { 85 | my ($self) = @_; 86 | my @data = (); 87 | push @data, sprintf "State %d:", $self->index(); 88 | foreach my $closure(@{$self->{closures}}){ 89 | push @data, $closure->toString(); 90 | } 91 | 92 | foreach my $item ( @{ $self->{gotos} } ) { 93 | my $key = $item->{key}; 94 | my $array = $item->{actions}; 95 | my $conflict = scalar @$array > 1; 96 | $conflict and push @data,"conflict:"; 97 | foreach my $action (@$array) { 98 | if ( $action->{type} eq 'SHIFT' ) { 99 | push @data, sprintf " %s shift and goto %d", $key->toString(), $action->{value}->{index}; 100 | } 101 | elsif ( $action->{type} eq 'JUMP' ) { 102 | push @data, sprintf " %s and goto %d", $key->toString(), $action->{value}->{index}; 103 | } 104 | elsif ( $action->{type} eq 'REDUCE' ) { 105 | push @data, sprintf " %s and reduce using rule %s (%d)", $key->toString(), $action->{value}->{name},$action->{value}->{index} 106 | } 107 | } 108 | $conflict and push @data,""; 109 | } 110 | my $data = join("\n",@data); 111 | } 112 | 1; 113 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Lexer.Token.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Lexer.Token; 6 | 7 | interface 8 | 9 | uses System.SysUtils; 10 | 11 | type 12 | TToken = class(TObject) 13 | private 14 | FLine: Integer; 15 | FColumn: Integer; 16 | FType: Integer; 17 | FText: string; 18 | FStartPos: Integer; 19 | FEndPos: Integer; 20 | function GetText: string; 21 | procedure SetText(const Value: string); 22 | function GetColumn: Integer; 23 | function GetLine: Integer; 24 | procedure SetColumn(const Value: Integer); 25 | procedure SetLine(const Value: Integer); 26 | function GetType: Integer; 27 | procedure SetType(const Value: Integer); 28 | function GetEndPos: Integer; 29 | function GetStartPos: Integer; 30 | procedure SetEndPos(const Value: Integer); 31 | procedure SetStartPos(const Value: Integer); 32 | public 33 | constructor Create(); virtual; 34 | destructor Destroy(); override; 35 | function Same(That: TToken): Boolean; 36 | property Text: string read GetText write SetText; 37 | property Line: Integer read GetLine write SetLine; 38 | property Column: Integer read GetColumn write SetColumn; 39 | property TokenType: Integer read GetType write SetType; 40 | property StartPos: Integer read GetStartPos write SetStartPos; 41 | property EndPos: Integer read GetEndPos write SetEndPos; 42 | function ToString: string; override; 43 | end; 44 | 45 | TTokenClass = class of TToken; 46 | 47 | implementation 48 | 49 | { TToken } 50 | 51 | constructor TToken.Create; 52 | begin 53 | FLine := 0; 54 | FColumn := 0; 55 | FType := 0; 56 | FText := ''; 57 | end; 58 | 59 | destructor TToken.Destroy; 60 | begin 61 | 62 | inherited; 63 | end; 64 | 65 | function TToken.Same(That: TToken): Boolean; 66 | begin 67 | Result := TokenType = That.TokenType; 68 | end; 69 | 70 | function TToken.GetColumn: Integer; 71 | begin 72 | Result := FColumn; 73 | end; 74 | 75 | function TToken.GetEndPos: Integer; 76 | begin 77 | Result := FEndPos; 78 | end; 79 | 80 | function TToken.GetStartPos: Integer; 81 | begin 82 | Result := FStartPos; 83 | end; 84 | 85 | function TToken.GetLine: Integer; 86 | begin 87 | Result := FLine; 88 | end; 89 | 90 | function TToken.GetText: string; 91 | begin 92 | Result := FText; 93 | end; 94 | 95 | function TToken.GetType: Integer; 96 | begin 97 | Result := FType; 98 | end; 99 | 100 | procedure TToken.SetColumn(const Value: Integer); 101 | begin 102 | FColumn := Value; 103 | end; 104 | 105 | procedure TToken.SetEndPos(const Value: Integer); 106 | begin 107 | FEndPos := Value; 108 | end; 109 | 110 | procedure TToken.SetLine(const Value: Integer); 111 | begin 112 | FLine := Value; 113 | end; 114 | 115 | procedure TToken.SetStartPos(const Value: Integer); 116 | begin 117 | FStartPos := Value; 118 | end; 119 | 120 | procedure TToken.SetText(const Value: string); 121 | begin 122 | FText := Value; 123 | end; 124 | 125 | procedure TToken.SetType(const Value: Integer); 126 | begin 127 | FType := Value; 128 | end; 129 | 130 | function TToken.ToString: string; 131 | begin 132 | Result := Format('Token(%d, %d:%d, %d:%d)="%s"', [FType, FStartPos, FEndPos, FLine, FColumn, FText]); 133 | end; 134 | 135 | end. 136 | -------------------------------------------------------------------------------- /demos/Delphi/Expression/uMain.dfm: -------------------------------------------------------------------------------- 1 | object Main: TMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Main' 5 | ClientHeight = 372 6 | ClientWidth = 660 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object ScriptMemo: TMemo 17 | Left = 0 18 | Top = 0 19 | Width = 660 20 | Height = 235 21 | Align = alClient 22 | Lines.Strings = ( 23 | '{' 24 | ' this is a simple scripting language !' 25 | ' it parses expressions and evaluates them' 26 | ' and finally sets the result to the output console (memo).' 27 | ' ' 28 | ' variable type can be either : ' 29 | ' - decimal eg : 15.' 30 | ' - hex eg : $1234abc, 0x1234abc.' 31 | ' - float eg : 5.2.' 32 | ' ' 33 | ' string can be either : ' 34 | 35 | ' - single quoted string => just like pascal ( double '#39' to e' + 36 | 'scape '#39'):' 37 | ' '#39'string'#39', '#39#39', '#39#39#39#39'. ' 38 | ' - double quoted string => just like perl (use \ to escape):' 39 | 40 | ' "", "\"", "string $variable", "string \$novar' + 41 | 'iable", ...' 42 | ' ' 43 | ' comments: just like pascal:' 44 | ' - // single line.' 45 | ' - (* multi line *).' 46 | ' - just like this one with {. ' 47 | ' ' 48 | ' operators: ' 49 | ' - +/*-%' 50 | '' 51 | ' built in function:' 52 | ' - min ' 53 | ' - max' 54 | ' - sin' 55 | ' - cos' 56 | ' - tan' 57 | ' - clear' 58 | ' - echo' 59 | '}' 60 | '' 61 | 'clear; // clear console.' 62 | '' 63 | 'var a = 00; // decimal' 64 | 'var b = 0x0a; // hex' 65 | 'var c = $0a; // pascal hex' 66 | 'var d = 00.20; // float' 67 | '' 68 | 'var vmin = min(a, b, c, d);' 69 | 'var vmax = max(a, b, c, d);' 70 | '' 71 | 'echo "min = $vmin ; max = $vmax";' 72 | '' 73 | 74 | 'echo '#39'calculating expression :'#39#39'a = max(1, 10, vmax - 1) * sin( ' + 75 | 'min(d % 2, 4, vmin + 1.1) ) + 10 - ( 5 / 2)'#39#39' '#39';' 76 | 77 | 'a = max(1, 10, vmax - 1) * sin( min(d % 2, 4, vmin + 1.1) ) + 10' + 78 | ' - ( 5 / 2);' 79 | 'echo "a = $a.";' 80 | '' 81 | '// end of script:' 82 | 'echo '#39#39';' 83 | 'echo '#39#39';' 84 | 'echo '#39'script ended.'#39';') 85 | ScrollBars = ssVertical 86 | TabOrder = 0 87 | ExplicitWidth = 626 88 | ExplicitHeight = 185 89 | end 90 | object LogMemo: TMemo 91 | Left = 0 92 | Top = 235 93 | Width = 660 94 | Height = 104 95 | Align = alBottom 96 | Lines.Strings = ( 97 | 'Memo2') 98 | ScrollBars = ssVertical 99 | TabOrder = 1 100 | ExplicitTop = 208 101 | ExplicitWidth = 626 102 | end 103 | object ParseBtn: TButton 104 | Left = 0 105 | Top = 339 106 | Width = 660 107 | Height = 33 108 | Align = alBottom 109 | Caption = 'Parse' 110 | TabOrder = 2 111 | OnClick = ParseBtnClick 112 | ExplicitTop = 312 113 | ExplicitWidth = 626 114 | end 115 | end 116 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Target/Pascal/Lexer.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Target/Pascal/Lexer.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Target::Pascal::Lexer; 14 | use strict; 15 | use warnings; 16 | use Parse::Easy::Target::Pascal::Header qw(get_header); 17 | my $header = get_header(); 18 | 19 | sub new { 20 | my ( $class, $lexer ) = @_; 21 | my $self = { lexer => $lexer, }; 22 | bless $self, $class; 23 | $self; 24 | } 25 | 26 | sub generate { 27 | my ($self) = @_; 28 | my $lexer = $self->{lexer}; 29 | my $name = $lexer->{name}; 30 | my $unitname = $name; 31 | my $classname = "T" . $name; 32 | my $file = "$name.pas"; 33 | my @actions = (); 34 | my @tokens = (); 35 | foreach my $rule ( @{ $lexer->{rules} } ) { 36 | my $action = $rule->{action}; 37 | $action or next; 38 | push @actions, { index => $action->index(), data => $action->code() }; 39 | } 40 | foreach my $key ( sort keys %{ $lexer->{tokens} } ) { 41 | my $value = $lexer->{tokens}->{$key}; 42 | push @tokens, { index => $value, data => $key }; 43 | } 44 | @tokens = sort { $a->{index} - $b->{index} } @tokens; 45 | open my $fh, '>', $file or die "unable to create file '$file'"; 46 | printf $fh $header; 47 | printf $fh "unit %s;\n\n", $unitname; 48 | printf $fh "interface\n\n"; 49 | printf $fh "uses System.SysUtils, WinApi.Windows,\n"; 50 | printf $fh " Parse.Easy.Lexer.CustomLexer;\n\n"; 51 | 52 | printf $fh "type %s = class(TCustomLexer)\n", $classname; 53 | printf $fh " protected\n"; 54 | printf $fh " procedure UserAction(Index: Integer); override;\n"; 55 | printf $fh " public\n"; 56 | printf $fh " class constructor Create;\n"; 57 | printf $fh " function GetTokenName(Index: Integer): string; override;\n"; 58 | printf $fh "end;\n\n"; 59 | 60 | printf $fh "const\n\n"; 61 | printf $fh " %-10s = %04d;\n", $_->{data}, $_->{index} foreach (@tokens); 62 | printf $fh " %-10s = %04d;\n", $_->{name}, $_->{index} foreach ( @{ $lexer->{sections} } ); 63 | 64 | printf $fh "\n\n"; 65 | 66 | printf $fh "implementation\n\n"; 67 | printf $fh "{\$R %s.RES}\n\n", $name; 68 | 69 | printf $fh "{ %s }\n\n", $classname; 70 | 71 | printf $fh "class constructor %s.%s;\n", $classname, 'Create'; 72 | printf $fh "begin\n"; 73 | printf $fh " Deserialize('%s');\n", uc $name; 74 | printf $fh "end;\n\n"; 75 | 76 | printf $fh "procedure %s.%s(Index: Integer);\n", $classname, 'UserAction'; 77 | printf $fh "begin\n"; 78 | if (@actions) { 79 | printf $fh " case Index of\n"; 80 | foreach my $item (@actions) { 81 | printf $fh " %04d:\n", $item->{index}; 82 | printf $fh " begin\n"; 83 | printf $fh " %s\n", $item->{data}; 84 | printf $fh " end;\n"; 85 | } 86 | printf $fh " end;\n"; 87 | } 88 | printf $fh "end;\n\n"; 89 | 90 | printf $fh "function %s.%s(Index: Integer): string;\n", $classname, 'GetTokenName'; 91 | printf $fh "begin\n"; 92 | if (@tokens) { 93 | printf $fh " case Index of\n"; 94 | printf $fh " %04d : exit(%-10s);\n", $_->{index}, "'$_->{data}'" foreach (@tokens); 95 | printf $fh " end;\n"; 96 | } 97 | printf $fh " Result := 'Unkown' + IntToStr(Index);\n"; 98 | printf $fh "end;\n\n"; 99 | 100 | printf $fh "end.\n"; 101 | close $fh; 102 | } 103 | 1; 104 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parser/Exporter.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parser/Exporter.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parser::Exporter; 14 | use strict; 15 | use warnings; 16 | use Parse::Easy::StreamWriter; 17 | use Parse::Easy::Target::Pascal::Utils qw/generateRes/; 18 | use Parse::Easy::Version; 19 | 20 | sub new { 21 | my ( $class, $parser ) = @_; 22 | my $self = { 23 | parser => $parser, 24 | writer => Parse::Easy::StreamWriter->new(0) 25 | }; 26 | bless $self, $class; 27 | $self; 28 | } 29 | 30 | sub outputState { 31 | my ( $self, $state ) = @_; 32 | my $writer = $self->{writer}; 33 | my $parser = $self->{parser}; 34 | my $lexer = $parser->{lexer}; 35 | $writer->write32( $state->{index} ); 36 | my @terms = (); 37 | my @noterms = (); 38 | foreach my $goto ( @{ $state->{gotos} } ) { 39 | my $key = $goto->{key}; 40 | if ( $key->type() eq 'term' ) { 41 | push @terms, $goto; 42 | } 43 | else { 44 | push @noterms, $goto; 45 | } 46 | } 47 | $writer->write32( scalar @terms ); 48 | $writer->write32( scalar @noterms ); 49 | foreach my $goto ( @terms, @noterms ) { 50 | my $key = $goto->{key}; 51 | my $index = undef; 52 | if ( $key->type() eq 'term' ) { 53 | $index = $lexer->{tokens}->{ $key->name() }; 54 | } 55 | else { 56 | $index = $parser->{tokens}->{ $key->name() }; 57 | } 58 | my @actions = @{ $goto->{actions} }; 59 | 60 | $writer->write32($index); 61 | $writer->write32( scalar @actions ); 62 | foreach my $action (@actions) { 63 | my $type = { SHIFT => 1, REDUCE => 2, JUMP => 3 }->{ $action->{type} }; 64 | $writer->write32($type); 65 | $writer->write32( $action->{value}->{index} ); 66 | } 67 | } 68 | } 69 | 70 | sub getRuleItemCount { 71 | my ($rule) = @_; 72 | my $result = 0; 73 | foreach my $item ( @{ $rule->{items} } ) { 74 | $item->type() ne 'epsilon' and $result++; 75 | } 76 | $result; 77 | } 78 | 79 | sub outputRules { 80 | my ( $self, $rule ) = @_; 81 | my $parser = $self->{parser}; 82 | my $writer = $self->{writer}; 83 | foreach my $rule ( @{ $parser->{allRules} } ) { 84 | my $flags = 0; 85 | $rule->accept() and $flags |= 1; 86 | my $actionIndex = -1; 87 | $rule->{action} and $actionIndex = $rule->{action}->{index}; 88 | $writer->write32( $rule->id() ); 89 | $writer->write32($flags); 90 | $writer->write32( getRuleItemCount($rule) ); 91 | $writer->write32($actionIndex); 92 | } 93 | } 94 | 95 | sub generate { 96 | my ($self) = @_; 97 | printf " - initializing data...\n"; 98 | my $parser = $self->{parser}; 99 | my $writer = $self->{writer}; 100 | $writer->write32($Parse::Easy::Version::Major); 101 | $writer->write32($Parse::Easy::Version::Minor); 102 | $writer->write32( scalar @{ $parser->{states} } ); 103 | $writer->write32( scalar @{ $parser->{allRules} } ); 104 | $writer->write32( scalar keys %{ $parser->{lexer}->{tokens} } ); 105 | printf " - outputing rules...\n"; 106 | $self->outputRules(); 107 | printf " - outputing states...\n"; 108 | $self->outputState($_) foreach ( @{ $parser->{states} } ); 109 | printf " - generating binary file...\n"; 110 | 111 | my @bytes = $writer->bytes(); 112 | my $file = $parser->{binfile}; 113 | $self->{parser}->{binary} = $file; 114 | open my $fh, '>:raw', $file; 115 | print $fh pack "C", $_ foreach (@bytes); 116 | close $fh; 117 | printf " - generating resource file...\n"; 118 | generateRes( $parser->{name}, $parser->{rcfile}, $parser->{resfile}, $parser->{binfile} ); 119 | } 120 | 1; 121 | -------------------------------------------------------------------------------- /demos/Delphi/JSON/Examples/Example4.json: -------------------------------------------------------------------------------- 1 | {"web-app": { 2 | "servlet": [ 3 | { 4 | "servlet-name": "cofaxCDS", 5 | "servlet-class": "org.cofax.cds.CDSServlet", 6 | "init-param": { 7 | "configGlossary:installationAt": "Philadelphia, PA", 8 | "configGlossary:adminEmail": "ksm@pobox.com", 9 | "configGlossary:poweredBy": "Cofax", 10 | "configGlossary:poweredByIcon": "/images/cofax.gif", 11 | "configGlossary:staticPath": "/content/static", 12 | "templateProcessorClass": "org.cofax.WysiwygTemplate", 13 | "templateLoaderClass": "org.cofax.FilesTemplateLoader", 14 | "templatePath": "templates", 15 | "templateOverridePath": "", 16 | "defaultListTemplate": "listTemplate.htm", 17 | "defaultFileTemplate": "articleTemplate.htm", 18 | "useJSP": false, 19 | "jspListTemplate": "listTemplate.jsp", 20 | "jspFileTemplate": "articleTemplate.jsp", 21 | "cachePackageTagsTrack": 200, 22 | "cachePackageTagsStore": 200, 23 | "cachePackageTagsRefresh": 60, 24 | "cacheTemplatesTrack": 100, 25 | "cacheTemplatesStore": 50, 26 | "cacheTemplatesRefresh": 15, 27 | "cachePagesTrack": 200, 28 | "cachePagesStore": 100, 29 | "cachePagesRefresh": 10, 30 | "cachePagesDirtyRead": 10, 31 | "searchEngineListTemplate": "forSearchEnginesList.htm", 32 | "searchEngineFileTemplate": "forSearchEngines.htm", 33 | "searchEngineRobotsDb": "WEB-INF/robots.db", 34 | "useDataStore": true, 35 | "dataStoreClass": "org.cofax.SqlDataStore", 36 | "redirectionClass": "org.cofax.SqlRedirection", 37 | "dataStoreName": "cofax", 38 | "dataStoreDriver": "com.microsoft.jdbc.sqlserver.SQLServerDriver", 39 | "dataStoreUrl": "jdbc:microsoft:sqlserver://LOCALHOST:1433;DatabaseName=goon", 40 | "dataStoreUser": "sa", 41 | "dataStorePassword": "dataStoreTestQuery", 42 | "dataStoreTestQuery": "SET NOCOUNT ON;select test='test';", 43 | "dataStoreLogFile": "/usr/local/tomcat/logs/datastore.log", 44 | "dataStoreInitConns": 10, 45 | "dataStoreMaxConns": 100, 46 | "dataStoreConnUsageLimit": 100, 47 | "dataStoreLogLevel": "debug", 48 | "maxUrlLength": 500}}, 49 | { 50 | "servlet-name": "cofaxEmail", 51 | "servlet-class": "org.cofax.cds.EmailServlet", 52 | "init-param": { 53 | "mailHost": "mail1", 54 | "mailHostOverride": "mail2"}}, 55 | { 56 | "servlet-name": "cofaxAdmin", 57 | "servlet-class": "org.cofax.cds.AdminServlet"}, 58 | 59 | { 60 | "servlet-name": "fileServlet", 61 | "servlet-class": "org.cofax.cds.FileServlet"}, 62 | { 63 | "servlet-name": "cofaxTools", 64 | "servlet-class": "org.cofax.cms.CofaxToolsServlet", 65 | "init-param": { 66 | "templatePath": "toolstemplates/", 67 | "log": 1, 68 | "logLocation": "/usr/local/tomcat/logs/CofaxTools.log", 69 | "logMaxSize": "", 70 | "dataLog": 1, 71 | "dataLogLocation": "/usr/local/tomcat/logs/dataLog.log", 72 | "dataLogMaxSize": "", 73 | "removePageCache": "/content/admin/remove?cache=pages&id=", 74 | "removeTemplateCache": "/content/admin/remove?cache=templates&id=", 75 | "fileTransferFolder": "/usr/local/tomcat/webapps/content/fileTransferFolder", 76 | "lookInContext": 1, 77 | "adminGroupID": 4, 78 | "betaServer": true}}], 79 | "servlet-mapping": { 80 | "cofaxCDS": "/", 81 | "cofaxEmail": "/cofaxutil/aemail/*", 82 | "cofaxAdmin": "/admin/*", 83 | "fileServlet": "/static/*", 84 | "cofaxTools": "/tools/*"}, 85 | 86 | "taglib": { 87 | "taglib-uri": "cofax.tld", 88 | "taglib-location": "/WEB-INF/tlds/cofax.tld"}}} 89 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Parser.LR1.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Parser.LR1; 6 | 7 | interface 8 | 9 | uses 10 | System.SysUtils, 11 | System.Classes, 12 | Parse.Easy.StackPtr, 13 | Parse.Easy.Lexer.CustomLexer, 14 | Parse.Easy.Lexer.Token, 15 | Parse.Easy.Parser.CustomParser, 16 | Parse.Easy.Parser.State, 17 | Parse.Easy.Parser.Rule, 18 | Parse.Easy.Parser.Action; 19 | 20 | type 21 | TLR1 = class(TCustomParser) 22 | private 23 | FStack: TStackPtr; 24 | public 25 | constructor Create(ALexer: TCustomLexer); override; 26 | destructor Destroy; override; 27 | function Parse: Boolean; override; 28 | property Stack: TStackPtr read FStack; 29 | end; 30 | 31 | implementation 32 | 33 | { TLR1 } 34 | 35 | constructor TLR1.Create(ALexer: TCustomLexer); 36 | begin 37 | inherited; 38 | FStack := TStackPtr.Create; 39 | end; 40 | 41 | destructor TLR1.Destroy; 42 | begin 43 | FStack.Free; 44 | inherited; 45 | end; 46 | 47 | function TLR1.Parse: Boolean; 48 | var 49 | State: TState; 50 | EState: TState; 51 | Token: TToken; 52 | Actions: TList; 53 | Action: TAction; 54 | Rule: TRule; 55 | PopCount: Integer; 56 | I: Integer; 57 | J: Integer; 58 | Value: PValue; 59 | begin 60 | Result := False; 61 | EState := nil; 62 | if States.Count = 0 then 63 | Exit; 64 | FStack.Push(States[0]); 65 | Token := nil; 66 | ReturnValue := NewValue(); 67 | while (FStack.Count > 0) do 68 | begin 69 | State := FStack.Peek(); 70 | EState := State; 71 | Token := Lexer.Peek(); 72 | Actions := State.Terms[Token.TokenType]; 73 | if not Assigned(Actions) then 74 | begin 75 | Result := False; 76 | Break; 77 | end; 78 | Action := Actions[0]; 79 | case Action.ActionType of 80 | atShift: 81 | begin 82 | State := States[Action.ActionValue]; 83 | Token := Lexer.Advance(); 84 | FStack.Push(Token); 85 | FStack.Push(State); 86 | Value := NewValue(); 87 | Value^.AsToken := Token; 88 | Values.Push(Value); 89 | end; 90 | atReduce: 91 | begin 92 | Rule := Rules[Action.ActionValue]; 93 | PopCount := Rule.NumberOfItems; 94 | if (Rule.ActionIndex <> -1) then 95 | begin 96 | ReturnValue := NewValue(); 97 | UserAction(Rule.ActionIndex); 98 | end; 99 | 100 | for I := 0 to PopCount - 1 do 101 | Values.Pop(); 102 | Values.Push(ReturnValue); 103 | 104 | PopCount := PopCount * 2; 105 | for I := 0 to PopCount - 1 do 106 | FStack.Pop(); 107 | 108 | if rfAccept in Rule.Flags then 109 | begin 110 | Result := True; 111 | Break; 112 | end; 113 | State := FStack.Peek(); 114 | Actions := State.NoTerms[Rule.Id]; 115 | if not Assigned(Actions) then 116 | begin 117 | Result := False; 118 | Break; 119 | end; 120 | Action := Actions[0]; 121 | State := States[Action.ActionValue]; 122 | FStack.Push(Rule); 123 | FStack.Push(State); 124 | end; 125 | else 126 | begin 127 | Result := False; 128 | Break; 129 | end; 130 | end; 131 | end; 132 | if Result then 133 | Exit; 134 | 135 | if Assigned(EState) then 136 | begin 137 | for J := 0 to EState.Terms.Count - 1 do 138 | begin 139 | Actions := EState.Terms[J]; 140 | if Assigned(Actions) then 141 | ExceptList.Add(Pointer(J)); 142 | end; 143 | ExceptError(Token); 144 | end; 145 | end; 146 | 147 | end. 148 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/RangeLexer.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parse/RangeLexer.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parse::RangeLexer; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | our @ISA = qw(Parse::Easy::Parse::RecursiveDescentLexer); 19 | use Parse::Easy::Parse::RecursiveDescentLexer; 20 | use Unicode::UCD qw(prop_invlist); 21 | use Set::IntSpan; 22 | use Parse::Easy::Wildcard; 23 | 24 | sub invertedListToSet { 25 | my ($ref) = @_; 26 | my $set = Set::IntSpan->new(); 27 | for ( my $i = 0 ; $i < @$ref ; $i += 2 ) { 28 | my $from = $ref->[$i]; 29 | my $to = 30 | ( $i + 1 ) < @$ref 31 | ? $ref->[ $i + 1 ] - 1 32 | : $Unicode::UCD::MAX_CP; 33 | $from == 0x110000 and last; 34 | $set->U("$from-$to"); 35 | } 36 | $set; 37 | } 38 | 39 | sub new { 40 | my ( $class, $parent ) = @_; 41 | my $self = $class->SUPER::new( $parent->YYInput() ); 42 | $self->{EXTENDED} = 0; 43 | $self->{parent} = $parent; 44 | $self; 45 | } 46 | 47 | sub error { 48 | my ( $self, $msg ) = @_; 49 | $self->{ERROR}->( $self->{parent}, $msg ); 50 | } 51 | 52 | sub expect { 53 | my ( $self, $expected, $curtok, $curval ) = @_; 54 | $self->{EXPECT}->( $self->{parent}, $expected, $curtok, $curval ); 55 | } 56 | 57 | sub next { 58 | my ($self) = @_; 59 | my %escape = ( 60 | 'n' => ord "\n", 61 | 't' => ord "\t", 62 | 'r' => ord "\r", 63 | '.' => ord ".", 64 | '\'' => ord '\'', 65 | '\\' => ord '\\', 66 | ); 67 | for ( ${ $self->{input} } ) { 68 | $self->{EXTENDED} && /\G(\s+)/gc; 69 | 70 | /\G(\[)/gc and return ( 'LBRACK', ord $1 ); 71 | /\G(\])/gc and return ( 'RBRACK', ord $1 ); 72 | /\G(\()/gc and return ( 'LPAREN', ord $1 ); 73 | /\G(\))/gc and return ( 'RPAREN', ord $1 ); 74 | 75 | /\G(\^)/gc and return ( 'CIRCUMFLEX', ord $1 ); 76 | /\G(\!)/gc and return ( 'BANG', ord $1 ); 77 | 78 | /\G(-)/gc and return ( 'MINUS', ord $1 ); 79 | /\G(\+)/gc and return ( 'PLUS', ord $1 ); 80 | /\G(\|)/gc and return ( 'BAR', ord $1 ); 81 | /\G(&)/gc and return ( 'AND', ord $1 ); 82 | /\G(\.)/gc and return ( 'CODEPOINTS', Set::IntSpan->new( sprintf "%s-%s", 0, oct "0xffff" ) ); 83 | 84 | if (/\G(\\)/gc) { 85 | /\G(.)/gc or $self->error('unexpected end of file'); 86 | my $next = $1; 87 | exists $escape{$next} && return ( 'CODEPOINT', $escape{$next} ); 88 | if ( $next eq 'X' ) { 89 | $self->{EXTENDED} = 1; 90 | return ( 'EXTENDED', 0 ); 91 | } 92 | if ( $next eq 'p' || ( $next eq 'P' and my $negate = 1 ) ) { 93 | my $propname = ''; 94 | if (/\G([a-zA-Z][a-z_A-Z0-9]*)/gc) { 95 | $propname = $1; 96 | } 97 | else { 98 | /\G(.)/gc && $1 eq '{' or $self->expect( ['LBRACE'], $1, $1 ); 99 | /\G([^}\]\n]+)/gc and $propname = $1; 100 | /\G(.)/gc && $1 eq '}' or $self->expect( ['RBRACE'], $1, $1 ); 101 | } 102 | $propname or $self->error('empty property found.'); 103 | my @invlist = prop_invlist($propname); 104 | my $set = invertedListToSet( \@invlist ); 105 | $set->empty() and $self->error( sprintf "unable to find property '%s'", $propname ); 106 | if ($negate) { 107 | my $wildcard = Parse::Easy::Wildcard::wildcard(); 108 | $wildcard->D($set); 109 | $set = $wildcard; 110 | } 111 | return ( 'CODEPOINTS', $set ); 112 | } 113 | if ( $next eq 'u' ) { 114 | /\G([a-fA-F0-9]{4})/gc || /\G({[a-fA-F0-9]{1,4}})/gc or $self->error("invalid escape \\u format."); 115 | return ( 'CODEPOINT', oct "0x$1" ); 116 | } 117 | return ( 'CODEPOINT', ord $next ); 118 | } 119 | 120 | /\G(.)/gc and return ( 'CODEPOINT', ord $1 ); 121 | return ( 'EOF', '' ); 122 | } 123 | } 124 | 125 | 126 | 127 | 1; 128 | -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Parser.CustomParser.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Parser.CustomParser; 6 | 7 | interface 8 | 9 | uses 10 | System.SysUtils, 11 | System.Classes, 12 | Parse.Easy.StackPtr, 13 | Parse.Easy.Lexer.CustomLexer, 14 | Parse.Easy.Lexer.Token, 15 | Parse.Easy.Parser.Deserializer; 16 | 17 | type 18 | TValue = record 19 | case Integer of 20 | 0: (AsUByte: Byte); 21 | 1: (AsUWord: Word); 22 | 2: (AsULong: Cardinal); 23 | 3: (AsObject: Pointer); 24 | 4: (AsClass: TClass); 25 | 5: (AsShortInt: ShortInt); 26 | 6: (AsSmallInt: SmallInt); 27 | 7: (AsInteger: Integer); 28 | 8: (AsSingle: Single); 29 | 9: (AsDouble: Double); 30 | 10: (AsExtended: Extended); 31 | 11: (AsComp: Comp); 32 | 12: (AsCurrency: Currency); 33 | 13: (AsUInt64: UInt64); 34 | 14: (AsSInt64: Int64); 35 | 15: (AsMethod: TMethod); 36 | 16: (AsPointer: Pointer); 37 | 17: (AsToken: TToken); 38 | 18: (AsList: TList); 39 | 19: (AsPChar: PChar); 40 | end; 41 | 42 | PValue = ^TValue; 43 | 44 | TCustomParser = class(TDeserializer) 45 | private 46 | FReturnValue: PValue; 47 | FValues: TStackPtr; 48 | FExceptList: TList; 49 | FInternalObjectHolderList: TList; 50 | FValueList: TList; 51 | protected 52 | procedure ExceptError(Token: TToken); 53 | procedure UserAction(Index: Integer); virtual; abstract; 54 | function CreateNewList(): TList; 55 | function NewValue(): PValue; 56 | public 57 | function Parse: Boolean; virtual; abstract; 58 | constructor Create(ALexer: TCustomLexer); override; 59 | destructor Destroy(); override; 60 | { properties } 61 | property Values: TStackPtr read FValues; 62 | property ReturnValue: PValue read FReturnValue write FReturnValue; 63 | property ExceptList: TList read FExceptList; 64 | end; 65 | 66 | implementation 67 | 68 | { TCustomParser } 69 | 70 | constructor TCustomParser.Create(ALexer: TCustomLexer); 71 | begin 72 | inherited; 73 | FInternalObjectHolderList := TList.Create(); 74 | FValueList := TList.Create(); 75 | FExceptList := TList.Create(); 76 | FValues := TStackPtr.Create(); 77 | FReturnValue := nil; 78 | end; 79 | 80 | function TCustomParser.CreateNewList(): TList; 81 | begin 82 | Result := TList.Create(); 83 | FInternalObjectHolderList.Add(Result); 84 | end; 85 | 86 | destructor TCustomParser.Destroy(); 87 | var 88 | I: Integer; 89 | begin 90 | FExceptList.Free(); 91 | FValues.Free(); 92 | for I := 0 to FValueList.Count - 1 do 93 | if Assigned(FValueList[I]) then 94 | FreeMemory(FValueList[I]); 95 | FValueList.Free(); 96 | 97 | for I := 0 to FInternalObjectHolderList.Count - 1 do 98 | if Assigned(FInternalObjectHolderList[I]) then 99 | TObject(FInternalObjectHolderList[I]).Free(); 100 | FInternalObjectHolderList.Free(); 101 | inherited; 102 | end; 103 | 104 | procedure TCustomParser.ExceptError(Token: TToken); 105 | var 106 | StrList: TStringList; 107 | S: string; 108 | I: Integer; 109 | LNear: string; 110 | begin 111 | LNear := EmptyStr; 112 | S := EmptyStr; 113 | if (Assigned(Token)) then 114 | LNear := Lexer.GetTokenName(Token.TokenType); 115 | StrList := TStringList.Create(); 116 | try 117 | for I := 0 to ExceptList.Count - 1 do 118 | StrList.Add(Lexer.GetTokenName(Integer(ExceptList[I]))); 119 | StrList.Delimiter := ','; 120 | S := StrList.DelimitedText; 121 | finally 122 | StrList.Free(); 123 | end; 124 | raise Exception.CreateFmt('Neer %s ... Expecting one of this: [%s]', [LNear, S]); 125 | end; 126 | 127 | function TCustomParser.NewValue: PValue; 128 | begin 129 | Result := GetMemory(SizeOf(TValue)); 130 | FValueList.Add(Result); 131 | end; 132 | 133 | end. 134 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Rule.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Rule.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Rule; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::NoTerm; 19 | use Readonly; 20 | our @ISA = qw(Parse::Easy::NoTerm); 21 | use Parse::Easy::Utils qw(sameItems); 22 | 23 | $Parse::Easy::Rule::EmptyString = '/*empty*/'; 24 | 25 | Readonly my $RF_NONE => 0; 26 | Readonly my $RF_ACCEPT => 1; 27 | Readonly my $RF_USER => 2; 28 | Readonly my $RF_FRAGMENT => 4; 29 | Readonly my $RF_INTERNAL => 8; 30 | 31 | my @flagsToString = ( 32 | 'ACCEPT' => $RF_ACCEPT, 33 | 'USER' => $RF_USER, 34 | 'FRAGMENT' => $RF_FRAGMENT, 35 | 'INTERNAL' => $RF_INTERNAL, 36 | ); 37 | 38 | sub new { 39 | my ( $class, $name, $rhss ) = @_; 40 | my $self = $class->SUPER::new($name); 41 | %$self = ( 42 | %$self, 43 | ( 44 | items => $rhss, 45 | index => undef, 46 | id => undef, 47 | flags => $RF_NONE, 48 | start => 0, 49 | end => 0, 50 | axiom => 0, 51 | returnType => undef, 52 | ) 53 | ); 54 | $self; 55 | } 56 | 57 | sub returnType { 58 | my ( $self, $value ) = @_; 59 | $self->{returnType} = $value // $self->{returnType}; 60 | } 61 | 62 | sub axiom { 63 | my ( $self, $value ) = @_; 64 | $self->{axiom} = $value // $self->{axiom}; 65 | } 66 | 67 | sub start { 68 | my ( $self, $value ) = @_; 69 | $self->{start} = $value // $self->{start}; 70 | } 71 | 72 | sub end { 73 | my ( $self, $value ) = @_; 74 | $self->{end} = $value // $self->{end}; 75 | } 76 | 77 | sub accept { 78 | my ( $self, $value ) = @_; 79 | defined $value and $value 80 | ? ( $self->{flags} |= $RF_ACCEPT ) 81 | : ( $self->{flags} &= ~$RF_ACCEPT ); 82 | $self->{flags} & $RF_ACCEPT; 83 | } 84 | 85 | sub internal { 86 | my ( $self, $value ) = @_; 87 | defined $value and $value 88 | ? ( $self->{flags} |= $RF_INTERNAL ) 89 | : ( $self->{flags} &= ~$RF_INTERNAL ); 90 | $self->{flags} & $RF_INTERNAL; 91 | } 92 | 93 | sub fragment { 94 | my ( $self, $value ) = @_; 95 | defined $value and $value 96 | ? ( $self->{flags} |= $RF_FRAGMENT ) 97 | : ( $self->{flags} &= ~$RF_FRAGMENT ); 98 | $self->{flags} & $RF_FRAGMENT; 99 | } 100 | 101 | sub user { 102 | my ( $self, $value ) = @_; 103 | defined $value and $value 104 | ? ( $self->{flags} |= $RF_USER ) 105 | : ( $self->{flags} &= ~$RF_USER ); 106 | $self->{flags} & $RF_USER; 107 | } 108 | 109 | sub index { 110 | my ( $self, $value ) = @_; 111 | $self->{index} = $value // $self->{index}; 112 | } 113 | 114 | sub id { 115 | my ( $self, $value ) = @_; 116 | $self->{id} = $value // $self->{id}; 117 | } 118 | 119 | sub items { 120 | my ($self) = @_; 121 | my @clone = @{ $self->{items} }; 122 | wantarray ? @clone : \@clone; 123 | } 124 | 125 | sub itemCount { 126 | my ($self) = @_; 127 | scalar @{ $self->{items} }; 128 | } 129 | 130 | sub empty { 131 | my ($self) = @_; 132 | $self->itemCount(); 133 | } 134 | 135 | sub same { 136 | my ( $self, $that ) = @_; 137 | $self == $that 138 | || $self->type() eq $that->type() && sameItems( $self->{items}, $that->{items}, 1 ); 139 | } 140 | 141 | sub clone { 142 | my ($self) = @_; 143 | my @items = @{ $self->{items} }; 144 | my $clone = Parse::Easy::Rule->new( $self->{name}, \@items ); 145 | $clone->{index} = $self->{index}; 146 | $clone->{flags} = $self->{flags}; 147 | $clone; 148 | } 149 | 150 | sub flagsToString { 151 | my ($self) = @_; 152 | $self->{flags} or goto end; 153 | my @data = (); 154 | for ( my $i = 0 ; $i < $#flagsToString ; ) { 155 | my ( $name, $flag ) = ( $flagsToString[ $i++ ], $flagsToString[ $i++ ] ); 156 | $flag & $self->{flags} and push @data, $name; 157 | } 158 | end: 159 | join( ', ', @data ); 160 | } 161 | 162 | sub toString { 163 | my ($self) = @_; 164 | my @data = (); 165 | push @data, $_->toString() foreach ( @{ $self->{items} } ); 166 | my $data = join( ' ', @data ); 167 | $data or $data = $Parse::Easy::Rule::EmptyString; 168 | sprintf "%s -> %s", $self->{name}, $data; 169 | } 170 | 171 | 1; 172 | -------------------------------------------------------------------------------- /scripts/insns2pascal.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module insns2pascal.pl Copyright (C) 2018 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | use strict; 14 | use warnings; 15 | use Parse::Easy::Lexer::OpCodes qw(instructions); 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Storable qw(dclone); 19 | use List::Util qw(min max); 20 | 21 | my $tmp = instructions(); 22 | my $db = []; 23 | foreach my $insn (@$tmp) { 24 | $insn->{mnem} =~ /^(label|db|dw|dd|dq)$/ and next; 25 | $insn->{alias} and next; 26 | push @$db, dclone $insn; 27 | } 28 | 29 | my $maxPatternCount = 0; 30 | my $maxArgCount = 0; 31 | my %valids = (); 32 | my @IID = (); 33 | my @PATTERNS = (); 34 | my @ARGS = (); 35 | 36 | sub registerType { 37 | my ( $types, $value, $prefix ) = @_; 38 | foreach my $item (@$types) { 39 | $item->{value} eq $value and return $item->{id}; 40 | } 41 | push @$types, 42 | my $item = { 43 | value => $value, 44 | id => sprintf( "%s_%s", $prefix, uc $value ), 45 | index => scalar @$types, 46 | }; 47 | $item->{id}; 48 | } 49 | registerType( \@IID, 'invalid', 'INSN' ); 50 | registerType( \@ARGS, 'NONE', 'ARG' ); 51 | registerType( \@PATTERNS, 'NONE', 'PAT' ); 52 | 53 | foreach my $insn (@$db) { 54 | $insn->{iid} = registerType( \@IID, $insn->{mnem}, 'INSN' ); 55 | 56 | my @patterns = @{ $insn->{patterns} }; 57 | my $opcode = oct shift @patterns; 58 | $insn->{opcode} = $opcode; 59 | $valids{$opcode} = $insn; 60 | 61 | # patterns: 62 | my @newPatterns = (); 63 | push @newPatterns, registerType( \@PATTERNS, $_, 'PAT' ) foreach (@patterns); 64 | $insn->{patterns} = \@newPatterns; 65 | $maxPatternCount = max( $maxPatternCount, scalar @newPatterns ); 66 | 67 | # arguments: 68 | my @newArgs = (); 69 | push @newArgs, registerType( \@ARGS, $_, 'ARG' ) foreach ( @{ $insn->{args} } ); 70 | $insn->{args} = \@newArgs; 71 | $maxArgCount = max( $maxArgCount, scalar @newArgs ); 72 | } 73 | 74 | my @instructions = (); 75 | for my $i ( 0 .. 0xff ) { 76 | my $valid = $valids{$i}; 77 | if ($valid) { 78 | push @instructions, $valid; 79 | next; 80 | } 81 | push @instructions, 82 | { 83 | iid => 'INSN_INVALID', 84 | opcode => $i, 85 | args => [], 86 | patterns => [], 87 | }; 88 | } 89 | my $file = $ARGV[0] // 'insns.inc'; 90 | 91 | open my $fh, '>', $file; 92 | print $fh <<"EON"; 93 | 94 | // ################################################# 95 | // # automatically generated file. do not edit !!! # 96 | // ################################################# 97 | 98 | EON 99 | 100 | printf $fh "const\n"; 101 | printf $fh " %-20s = %d;\n", 'MAX_ARG_COUNT', $maxArgCount; 102 | printf $fh " %-20s = %d;\n", 'MAX_PATTERN_COUNT', $maxPatternCount; 103 | printf $fh "\n"; 104 | printf $fh " { instructions }\n"; 105 | printf $fh " %-14s = %02d;\n", $_->{id}, $_->{index} foreach (@IID); 106 | printf $fh " { arguments }\n"; 107 | printf $fh " %-10s = %02d;\n", $_->{id}, $_->{index} foreach (@ARGS); 108 | printf $fh " { patterns }\n"; 109 | printf $fh " %-10s = %02d;\n", $_->{id}, $_->{index} foreach (@PATTERNS); 110 | printf $fh "\n"; 111 | 112 | print $fh <<"EOR"; 113 | type 114 | TInstructionDscrp = record 115 | IID : Integer; 116 | Args : array [ 0 .. MAX_ARG_COUNT -1 ] of Integer; 117 | Patterns : array [ 0 .. MAX_PATTERN_COUNT -1 ] of Integer; 118 | end; 119 | PInstructionDscrp = ^TInstructionDscrp; 120 | 121 | EOR 122 | printf $fh "const instructions : array [ 0 .. %d - 1 ] of TInstructionDscrp = (\n", scalar @instructions; 123 | 124 | foreach my $i ( 0 .. @instructions - 1 ) { 125 | my $insn = $instructions[$i]; 126 | my @args = @{ $insn->{args} }; 127 | push @args, "ARG_NONE" while ( scalar @args < $maxArgCount ); 128 | my $args = join( ', ', @args ); 129 | 130 | my @patterns = @{ $insn->{patterns} }; 131 | push @patterns, "PAT_NONE" while ( scalar @patterns < $maxPatternCount ); 132 | my $patterns = join( ', ', @patterns ); 133 | 134 | my $iid = $insn->{iid}; 135 | my $opcode = $insn->{opcode}; 136 | my $comma = $i == @instructions - 1 ? '' : ','; 137 | printf $fh " {%02d} (IID: %-12s; Args: (%-20s); Patterns: (%s))%s\n", $opcode, $iid, $args, $patterns, $comma; 138 | } 139 | printf $fh ");\n"; 140 | 141 | close $fh; 142 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/insns2pascal.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/insns2pascal.pl Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | use strict; 14 | use warnings; 15 | use Parse::Easy::Lexer::OpCodes qw(instructions); 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Storable qw(dclone); 19 | use List::Util qw(min max); 20 | 21 | my $tmp = instructions(); 22 | my $db = []; 23 | foreach my $insn (@$tmp) { 24 | $insn->{mnem} =~ /^(label|db|dw|dd|dq)$/ and next; 25 | $insn->{alias} and next; 26 | push @$db, dclone $insn; 27 | } 28 | 29 | my $maxPatternCount = 0; 30 | my $maxArgCount = 0; 31 | my %valids = (); 32 | my @IID = (); 33 | my @PATTERNS = (); 34 | my @ARGS = (); 35 | 36 | sub registerType { 37 | my ( $types, $value, $prefix ) = @_; 38 | foreach my $item (@$types) { 39 | $item->{value} eq $value and return $item->{id}; 40 | } 41 | push @$types, 42 | my $item = { 43 | value => $value, 44 | id => sprintf( "%s_%s", $prefix, uc $value ), 45 | index => scalar @$types, 46 | }; 47 | $item->{id}; 48 | } 49 | registerType( \@IID, 'invalid', 'INSN' ); 50 | registerType( \@ARGS, 'NONE', 'ARG' ); 51 | registerType( \@PATTERNS, 'NONE', 'PAT' ); 52 | 53 | foreach my $insn (@$db) { 54 | $insn->{iid} = registerType( \@IID, $insn->{mnem}, 'INSN' ); 55 | 56 | my @patterns = @{ $insn->{patterns} }; 57 | my $opcode = oct shift @patterns; 58 | $insn->{opcode} = $opcode; 59 | $valids{$opcode} = $insn; 60 | 61 | # patterns: 62 | my @newPatterns = (); 63 | push @newPatterns, registerType( \@PATTERNS, $_, 'PAT' ) foreach (@patterns); 64 | $insn->{patterns} = \@newPatterns; 65 | $maxPatternCount = max( $maxPatternCount, scalar @newPatterns ); 66 | 67 | # arguments: 68 | my @newArgs = (); 69 | push @newArgs, registerType( \@ARGS, $_, 'ARG' ) foreach ( @{ $insn->{args} } ); 70 | $insn->{args} = \@newArgs; 71 | $maxArgCount = max( $maxArgCount, scalar @newArgs ); 72 | } 73 | 74 | my @instructions = (); 75 | for my $i ( 0 .. 0xff ) { 76 | my $valid = $valids{$i}; 77 | if ($valid) { 78 | push @instructions, $valid; 79 | next; 80 | } 81 | push @instructions, 82 | { 83 | iid => 'INSN_INVALID', 84 | opcode => $i, 85 | args => [], 86 | patterns => [], 87 | }; 88 | } 89 | my $file = $ARGV[0] // 'insns.inc'; 90 | 91 | open my $fh, '>', $file; 92 | print $fh <<"EON"; 93 | 94 | // ################################################# 95 | // # automatically generated file. do not edit !!! # 96 | // ################################################# 97 | 98 | // see $0. 99 | 100 | EON 101 | 102 | printf $fh "const\n"; 103 | printf $fh " %-20s = %d;\n", 'MAX_ARG_COUNT', $maxArgCount; 104 | printf $fh " %-20s = %d;\n", 'MAX_PATTERN_COUNT', $maxPatternCount; 105 | printf $fh "\n"; 106 | printf $fh " { instructions }\n"; 107 | printf $fh " %-14s = %02d;\n", $_->{id}, $_->{index} foreach (@IID); 108 | printf $fh " { arguments }\n"; 109 | printf $fh " %-10s = %02d;\n", $_->{id}, $_->{index} foreach (@ARGS); 110 | printf $fh " { patterns }\n"; 111 | printf $fh " %-10s = %02d;\n", $_->{id}, $_->{index} foreach (@PATTERNS); 112 | printf $fh "\n"; 113 | 114 | print $fh <<"EOR"; 115 | type 116 | TInstructionDscrp = record 117 | IID : Integer; 118 | Args : array [ 0 .. MAX_ARG_COUNT -1 ] of Integer; 119 | Patterns : array [ 0 .. MAX_PATTERN_COUNT -1 ] of Integer; 120 | end; 121 | PInstructionDscrp = ^TInstructionDscrp; 122 | 123 | EOR 124 | printf $fh "const instructions : array [ 0 .. %d - 1 ] of TInstructionDscrp = (\n", scalar @instructions; 125 | 126 | foreach my $i ( 0 .. @instructions - 1 ) { 127 | my $insn = $instructions[$i]; 128 | my @args = @{ $insn->{args} }; 129 | push @args, "ARG_NONE" while ( scalar @args < $maxArgCount ); 130 | my $args = join( ', ', @args ); 131 | 132 | my @patterns = @{ $insn->{patterns} }; 133 | push @patterns, "PAT_NONE" while ( scalar @patterns < $maxPatternCount ); 134 | my $patterns = join( ', ', @patterns ); 135 | 136 | my $iid = $insn->{iid}; 137 | my $opcode = $insn->{opcode}; 138 | my $comma = $i == @instructions - 1 ? '' : ','; 139 | printf $fh " {%02d} (IID: %-12s; Args: (%-20s); Patterns: (%s))%s\n", $opcode, $iid, $args, $patterns, $comma; 140 | } 141 | printf $fh ");\n"; 142 | 143 | close $fh; 144 | -------------------------------------------------------------------------------- /demos/Delphi/Expression/Expression.g: -------------------------------------------------------------------------------- 1 | grammar Expression; 2 | 3 | use Parser::Units ('ExpressionBase', 'System.Math'); 4 | use Parser::BaseClass qw/TExpressionBase/; 5 | 6 | // Lexer rules: 7 | // ------------ 8 | 9 | fragment A : 'a' | 'A'; 10 | fragment B : 'b' | 'B'; 11 | fragment C : 'c' | 'C'; 12 | fragment D : 'd' | 'D'; 13 | fragment E : 'e' | 'E'; 14 | fragment F : 'f' | 'F'; 15 | fragment G : 'g' | 'G'; 16 | fragment H : 'h' | 'H'; 17 | fragment I : 'i' | 'I'; 18 | fragment J : 'j' | 'J'; 19 | fragment K : 'k' | 'K'; 20 | fragment L : 'l' | 'L'; 21 | fragment M : 'm' | 'M'; 22 | fragment N : 'n' | 'N'; 23 | fragment O : 'o' | 'O'; 24 | fragment P : 'p' | 'P'; 25 | fragment Q : 'q' | 'Q'; 26 | fragment R : 'r' | 'R'; 27 | fragment S : 's' | 'S'; 28 | fragment T : 't' | 'T'; 29 | fragment U : 'u' | 'U'; 30 | fragment V : 'v' | 'V'; 31 | fragment W : 'w' | 'W'; 32 | fragment X : 'x' | 'X'; 33 | fragment Y : 'y' | 'Y'; 34 | fragment Z : 'z' | 'Z'; 35 | 36 | fragment SQUOTE : "'"; // single quote '. 37 | fragment DQUOTE : '"'; // double quote ". 38 | fragment BACKSLASH: "\\"; 39 | 40 | fragment DEC : [0-9]+; 41 | 42 | LPAREN : '('; 43 | RPAREN : ')'; 44 | PLUS : '+'; 45 | MINUS : '-'; 46 | STAR : '*'; 47 | SLASH : '/'; 48 | PERCENT : '%'; 49 | COMMA : ','; 50 | EQUAL : '='; 51 | SEMICOLON : ';'; 52 | 53 | // reserved keywords: 54 | COS : C O S; 55 | SIN : S I N; 56 | TAN : T A N; 57 | MIN : M I N; 58 | MAX : M A X; 59 | TK_VAR : V A R; 60 | CLEAR : C L E A R; 61 | ECHO : E C H O; 62 | 63 | // strings: 64 | SQ_STRING : SQUOTE ( SQUOTE SQUOTE | [^'\n] )* SQUOTE; //' 65 | DQ_STRING : DQUOTE ( BACKSLASH DQUOTE | [^"\n] )* DQUOTE; 66 | 67 | // numbers: 68 | DIGIT : DEC; 69 | FLOAT : DEC '.' DEC; 70 | HEX : ('0x' | '$') [\pHex]+; 71 | 72 | // identifier: 73 | // this should be the last one after all reserved keywords. 74 | ID : '&'? [_\p{Letter}][\p{Letter}_0-9]*; 75 | 76 | // comments: 77 | fragment COMMENT1 : '//' [^\n]* [\n]; // single line comment //. 78 | fragment COMMENT2 : '{' [^\}]* '}'; // multi line comment {}. 79 | fragment COMMENT3 : '(*' ( [^\*] | '*' [^\)] )* '*)' ; // multi line comment (**). 80 | COMMENT : (COMMENT1 | COMMENT2 | COMMENT3) {skip}; 81 | 82 | // whitespace and newline: 83 | WS : [ \t\n\r]+ {skip}; 84 | 85 | // Parser rules: 86 | // ------------- 87 | 88 | topLevel 89 | : statements 90 | ; 91 | 92 | statements 93 | : statements statement 94 | | statement 95 | ; 96 | 97 | statement 98 | : assignment SEMICOLON 99 | | CLEAR SEMICOLON { DoClear() } 100 | | ECHO string SEMICOLON { DoEcho($2)} 101 | ; 102 | 103 | string as PChar 104 | : SQ_STRING { $$ := SQString($1.Text) } 105 | | DQ_STRING { $$ := DQString($1.Text) } 106 | ; 107 | 108 | assignment 109 | : TK_VAR? ID EQUAL expression 110 | { 111 | DoAssignment(Assigned($1), $2.Text, $4); 112 | } 113 | ; 114 | 115 | expression as Double 116 | : addSubExpression; 117 | 118 | addSubExpression as Double 119 | : addSubExpression PLUS mulDivExpression { $$ := $1 + $3 } 120 | | addSubExpression MINUS mulDivExpression { $$ := $1 - $3 } 121 | | mulDivExpression 122 | ; 123 | 124 | mulDivExpression as Double 125 | : mulDivExpression STAR unaryExpression { $$ := $1 * $3 } 126 | | mulDivExpression SLASH unaryExpression { $$ := $1 / $3 } 127 | | mulDivExpression PERCENT unaryExpression { $$ := Fmod($1, $3) } 128 | | unaryExpression 129 | ; 130 | 131 | unaryExpression as Double 132 | : PLUS primaryExpression { $$ := +$2 } 133 | | MINUS primaryExpression { $$ := -$2 } 134 | | primaryExpression 135 | ; 136 | 137 | primaryExpression as Double 138 | : LPAREN expression RPAREN { $$ := $2 } 139 | | ID { $$ := GetVarValue($1.Text) } 140 | | integer { $$ := $1 } 141 | | FLOAT { $$ := StrToFloat($1.Text) } 142 | | COS LPAREN expression RPAREN { $$ := Cos($3) } 143 | | SIN LPAREN expression RPAREN { $$ := Sin($3) } 144 | | TAN LPAREN expression RPAREN { $$ := Tangent($3) } 145 | | MIN argumentList { $$ := DoMin($2) } 146 | | MAX argumentList { $$ := DoMax($2) } 147 | ; 148 | 149 | integer as Double 150 | : DIGIT { $$ := StrToFloat($1.Text) } 151 | | HEX { $$ := HexToFloat($1.Text) } 152 | ; 153 | 154 | argumentList as TList 155 | : LPAREN expressionList RPAREN { $$ := $2 } 156 | ; 157 | 158 | expressionList as TList 159 | : expressionList COMMA expression { $$ := $1; $$.Add(@$3) } 160 | | expression { $$ := CreateNewList() } 161 | ; -------------------------------------------------------------------------------- /demos/Delphi/Expression/Expression/ExpressionParser.pas: -------------------------------------------------------------------------------- 1 | 2 | // ------------------------------------------------------- 3 | // 4 | // This file was generated using Parse::Easy v1.0 alpha. 5 | // 6 | // https://github.com/MahdiSafsafi/Parse-Easy 7 | // 8 | // DO NOT EDIT !!! ANY CHANGE MADE HERE WILL BE LOST !!! 9 | // 10 | // ------------------------------------------------------- 11 | 12 | unit ExpressionParser; 13 | 14 | interface 15 | 16 | uses System.SysUtils, System.Classes, WinApi.Windows, 17 | ExpressionBase, 18 | System.Math, 19 | Parse.Easy.Lexer.Token, 20 | Parse.Easy.Parser.LR1, 21 | Parse.Easy.Parser.CustomParser; 22 | 23 | type TExpressionParser = class(TExpressionBase) 24 | protected 25 | procedure UserAction(Index: Integer); override; 26 | public 27 | class constructor Create; 28 | end; 29 | 30 | implementation 31 | 32 | {$R 'ExpressionParser.res'} 33 | 34 | { TExpressionParser } 35 | 36 | class constructor TExpressionParser.Create; 37 | begin 38 | Deserialize('EXPRESSIONPARSER'); 39 | end; 40 | 41 | procedure TExpressionParser.UserAction(Index: Integer); 42 | begin 43 | case Index of 44 | 0002: 45 | begin 46 | DoClear() 47 | end; 48 | 0003: 49 | begin 50 | DoEcho(PValue(Values[Values.Count - 1 - 1])^.AsPChar) 51 | end; 52 | 0004: 53 | begin 54 | ReturnValue^.AsPChar := SQString(PValue(Values[Values.Count - 1 - 0])^.AsToken.Text) 55 | end; 56 | 0005: 57 | begin 58 | ReturnValue^.AsPChar := DQString(PValue(Values[Values.Count - 1 - 0])^.AsToken.Text) 59 | end; 60 | 0000: 61 | begin 62 | ReturnValue^.AsList := CreateNewList(); ReturnValue^.AsList.Add(PValue(Values[Values.Count - 1 - 0])^.AsToken); 63 | end; 64 | 0001: 65 | begin 66 | ReturnValue^.AsList := nil; 67 | end; 68 | 0006: 69 | begin 70 | 71 | DoAssignment(Assigned(PValue(Values[Values.Count - 1 - 3])^.AsList), PValue(Values[Values.Count - 1 - 2])^.AsToken.Text, PValue(Values[Values.Count - 1 - 0])^.AsDouble); 72 | 73 | end; 74 | 0007: 75 | begin 76 | ReturnValue^.AsDouble := PValue(Values[Values.Count - 1 - 2])^.AsDouble + PValue(Values[Values.Count - 1 - 0])^.AsDouble 77 | end; 78 | 0008: 79 | begin 80 | ReturnValue^.AsDouble := PValue(Values[Values.Count - 1 - 2])^.AsDouble - PValue(Values[Values.Count - 1 - 0])^.AsDouble 81 | end; 82 | 0009: 83 | begin 84 | ReturnValue^.AsDouble := PValue(Values[Values.Count - 1 - 2])^.AsDouble * PValue(Values[Values.Count - 1 - 0])^.AsDouble 85 | end; 86 | 0010: 87 | begin 88 | ReturnValue^.AsDouble := PValue(Values[Values.Count - 1 - 2])^.AsDouble / PValue(Values[Values.Count - 1 - 0])^.AsDouble 89 | end; 90 | 0011: 91 | begin 92 | ReturnValue^.AsDouble := Fmod(PValue(Values[Values.Count - 1 - 2])^.AsDouble, PValue(Values[Values.Count - 1 - 0])^.AsDouble) 93 | end; 94 | 0012: 95 | begin 96 | ReturnValue^.AsDouble := +PValue(Values[Values.Count - 1 - 0])^.AsDouble 97 | end; 98 | 0013: 99 | begin 100 | ReturnValue^.AsDouble := -PValue(Values[Values.Count - 1 - 0])^.AsDouble 101 | end; 102 | 0014: 103 | begin 104 | ReturnValue^.AsDouble := PValue(Values[Values.Count - 1 - 1])^.AsDouble 105 | end; 106 | 0015: 107 | begin 108 | ReturnValue^.AsDouble := GetVarValue(PValue(Values[Values.Count - 1 - 0])^.AsToken.Text) 109 | end; 110 | 0016: 111 | begin 112 | ReturnValue^.AsDouble := PValue(Values[Values.Count - 1 - 0])^.AsDouble 113 | end; 114 | 0017: 115 | begin 116 | ReturnValue^.AsDouble := StrToFloat(PValue(Values[Values.Count - 1 - 0])^.AsToken.Text) 117 | end; 118 | 0018: 119 | begin 120 | ReturnValue^.AsDouble := Cos(PValue(Values[Values.Count - 1 - 1])^.AsDouble) 121 | end; 122 | 0019: 123 | begin 124 | ReturnValue^.AsDouble := Sin(PValue(Values[Values.Count - 1 - 1])^.AsDouble) 125 | end; 126 | 0020: 127 | begin 128 | ReturnValue^.AsDouble := Tangent(PValue(Values[Values.Count - 1 - 1])^.AsDouble) 129 | end; 130 | 0021: 131 | begin 132 | ReturnValue^.AsDouble := DoMin(PValue(Values[Values.Count - 1 - 0])^.AsList) 133 | end; 134 | 0022: 135 | begin 136 | ReturnValue^.AsDouble := DoMax(PValue(Values[Values.Count - 1 - 0])^.AsList) 137 | end; 138 | 0023: 139 | begin 140 | ReturnValue^.AsDouble := StrToFloat(PValue(Values[Values.Count - 1 - 0])^.AsToken.Text) 141 | end; 142 | 0024: 143 | begin 144 | ReturnValue^.AsDouble := HexToFloat(PValue(Values[Values.Count - 1 - 0])^.AsToken.Text) 145 | end; 146 | 0025: 147 | begin 148 | ReturnValue^.AsList := PValue(Values[Values.Count - 1 - 1])^.AsList 149 | end; 150 | 0026: 151 | begin 152 | ReturnValue^.AsList := PValue(Values[Values.Count - 1 - 2])^.AsList; ReturnValue^.AsList.Add(@PValue(Values[Values.Count - 1 - 0])^.AsDouble) 153 | end; 154 | 0027: 155 | begin 156 | ReturnValue^.AsList := CreateNewList() 157 | end; 158 | end; 159 | end; 160 | 161 | end. 162 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/Disasm.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/Disasm.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Lexer::Disasm; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Parse::Easy::Lexer::OpCodes qw(instructions); 19 | my $db = instructions(); 20 | my @tables = map { { opcode => $_, entries => undef } } 0x00 .. 0xff; 21 | foreach my $insn (@$db) { 22 | my @patterns = @{ $insn->{patterns} }; 23 | my $first = shift @patterns // next; 24 | $first =~ /^0x[a-f0-9]{2}$/i or next; 25 | my $op = oct $first; 26 | push @{ $tables[$op]->{entries} }, $insn; 27 | } 28 | 29 | my %char2size = ( 30 | b => 8, 31 | w => 16, 32 | d => 32, 33 | ); 34 | 35 | no warnings 'portable'; 36 | 37 | sub readInteger { 38 | my ( $bytes, $index, $size, $signExtend ) = @_; 39 | my @bytes = (); 40 | push @bytes, $bytes->[$_] for ( $index .. ( $index + $size ) - 1 ); 41 | my $value = 0; 42 | @bytes = reverse @bytes; 43 | foreach (@bytes) { 44 | $value <<= 8; 45 | $value |= $_; 46 | } 47 | if ($signExtend) { 48 | my $pos = 1 << $size * 8 - 1; 49 | if ( $value & $pos ) { 50 | my $mask = { 1 => 0xff, 2 => 0xffff, 4 => 0xffffffff, 8 => 0xffffffffffffffff }->{$size}; 51 | $value = ( -1 & ~$mask ) | $value; 52 | $value = unpack 's', pack 'S', $value; 53 | } 54 | } 55 | $value; 56 | } 57 | 58 | sub decodePattern { 59 | my ( $bytes, $offset, $template, $out ) = @_; 60 | my @encoding = (); 61 | my $pc = $offset; 62 | foreach my $pattern (@$template) { 63 | if ( $pattern =~ /^0x[a-f0-9]{2}$/i ) { 64 | my $opcode = oct $pattern; 65 | my $value = $bytes->[$offset] // return 0; 66 | $opcode != $value and return 0; 67 | $offset++; 68 | } 69 | elsif ( $pattern =~ /^([ui])(\d+)$/ ) { 70 | my $size = $2 / 8; 71 | my $signExtend = ( $1 eq 'i' ); 72 | my $imm = readInteger( $bytes, $offset, $size, $signExtend ); 73 | push @encoding, { pattern => $pattern, value => $imm }; 74 | $offset += $size; 75 | } 76 | elsif ( $pattern =~ /^[o]([bwd])$/ ) { 77 | my $size = $char2size{$1} / 8; 78 | my $imm = readInteger( $bytes, $offset, $size, 1 ); 79 | push @encoding, { pattern => $pattern, value => $imm }; 80 | $offset += $size; 81 | } 82 | elsif ( $pattern eq 'of' ) { 83 | my $value = $bytes->[$offset]; 84 | $offset++; 85 | my $imm = 0; 86 | if ($value) { 87 | my $size = { 0 => 0, 1 => 1, 2 => 2, 3 => 4 }->{ $value & 3 }; 88 | my $power = $value >> 2; 89 | $imm = readInteger( $bytes, $offset, $size ); 90 | $offset += $size; 91 | } 92 | push @encoding, { pattern => $pattern, value => $imm }; 93 | } 94 | else { 95 | die "unkown pattern '$pattern'"; 96 | } 97 | } 98 | $out and @$out = @encoding; 99 | $offset - $pc; 100 | } 101 | 102 | sub stringify { 103 | my ( $insn, $addresses ) = @_; 104 | my @args = (); 105 | my @encoding = @{ $insn->{encoding} }; 106 | my $find = sub { 107 | my ($expression) = @_; 108 | foreach my $item (@encoding) { 109 | $item->{taken} and next; 110 | if ( $item->{pattern} =~ $expression ) { 111 | $item->{taken} = 1; 112 | return $item->{value}; 113 | } 114 | die "unable to find expression '$expression'"; 115 | } 116 | }; 117 | my @comment = (); 118 | foreach my $arg ( @{ $insn->{entry}->{args} } ) { 119 | local $_ = $arg; 120 | if (/^r(\d+)$/) { 121 | push @args, $_; 122 | } 123 | elsif (/^[u]*imm(\d+)$/) { 124 | my $imm = $find->(qr/^[ui]\d+$/); 125 | push @args, $imm; 126 | } 127 | elsif (/^rel(\d+)$/) { 128 | my $rel = $find->(qr/^o[bwd]$/); 129 | push @args, $rel; 130 | my $target = $insn->{address} + $rel; 131 | my $comment = sprintf "0x%08x", $target; 132 | !exists $addresses->{$target} and $comment .= ' ??'; 133 | push @comment, $comment; 134 | } 135 | elsif (/^offset$/) { 136 | my $offset = $find->(qr/^of$/); 137 | push @args, $offset; 138 | } 139 | else { 140 | die "unable to handle argument '$_'"; 141 | } 142 | } 143 | my $args = join( ', ', @args ); 144 | my $string = $insn->{entry}->{mnem}; 145 | if ( $args ne '' ) { 146 | $string .= ' ' . $args; 147 | } 148 | my $comment = join( ' ; ', @comment ); 149 | $comment ne '' and $comment = "// $comment"; 150 | $insn->{comment} = $comment; 151 | $insn->{syntax} = $string; 152 | } 153 | 154 | sub disasm { 155 | my ($bytes) = @_; 156 | my $i = 0; 157 | my @insns = (); 158 | my %addresses = (); 159 | while (1) { 160 | my $address = $i; 161 | my $opcode = $bytes->[$i] // last; 162 | my $entries = $tables[$opcode]->{entries}; 163 | defined $entries or die "undefined instruction"; 164 | my $encoding = []; 165 | my $matched = undef; 166 | my $size = 0; 167 | foreach my $entry ( @{$entries} ) { 168 | $size = 0; 169 | $encoding = []; 170 | $size = decodePattern( $bytes, $i, $entry->{patterns}, $encoding ) or next; 171 | $matched = $entry; 172 | last; 173 | } 174 | $i += $size; 175 | $matched or die "undefined instruction"; 176 | my @bytecode = (); 177 | push @bytecode, $bytes->[$_] for ( $address .. $i - 1 ); 178 | @bytecode = map { sprintf "%02x", $_ } @bytecode; 179 | my $bytecode = join( ' ', @bytecode ); 180 | my $insn = { address => $address, bytecode => $bytecode, entry => $matched, encoding => $encoding }; 181 | $addresses{$address}++; 182 | push @insns, $insn; 183 | } 184 | foreach (@insns) { 185 | stringify( $_, \%addresses ); 186 | my $comment = $_->{comment}; 187 | printf "0x%08x %-15s %s %s\n", $_->{address}, $_->{bytecode}, $_->{syntax}, $comment; 188 | } 189 | } 190 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The "Artistic License" 2 | 3 | Preamble 4 | 5 | The intent of this document is to state the conditions under which a 6 | Package may be copied, such that the Copyright Holder maintains some 7 | semblance of artistic control over the development of the package, 8 | while giving the users of the package the right to use and distribute 9 | the Package in a more-or-less customary fashion, plus the right to make 10 | reasonable modifications. 11 | 12 | Definitions: 13 | 14 | "Package" refers to the collection of files distributed by the 15 | Copyright Holder, and derivatives of that collection of files 16 | created through textual modification. 17 | 18 | "Standard Version" refers to such a Package if it has not been 19 | modified, or has been modified in accordance with the wishes 20 | of the Copyright Holder as specified below. 21 | 22 | "Copyright Holder" is whoever is named in the copyright or 23 | copyrights for the package. 24 | 25 | "You" is you, if you're thinking about copying or distributing 26 | this Package. 27 | 28 | "Reasonable copying fee" is whatever you can justify on the 29 | basis of media cost, duplication charges, time of people involved, 30 | and so on. (You will not be required to justify it to the 31 | Copyright Holder, but only to the computing community at large 32 | as a market that must bear the fee.) 33 | 34 | "Freely Available" means that no fee is charged for the item 35 | itself, though there may be fees involved in handling the item. 36 | It also means that recipients of the item may redistribute it 37 | under the same conditions they received it. 38 | 39 | 1. You may make and give away verbatim copies of the source form of the 40 | Standard Version of this Package without restriction, provided that you 41 | duplicate all of the original copyright notices and associated disclaimers. 42 | 43 | 2. You may apply bug fixes, portability fixes and other modifications 44 | derived from the Public Domain or from the Copyright Holder. A Package 45 | modified in such a way shall still be considered the Standard Version. 46 | 47 | 3. You may otherwise modify your copy of this Package in any way, provided 48 | that you insert a prominent notice in each changed file stating how and 49 | when you changed that file, and provided that you do at least ONE of the 50 | following: 51 | 52 | a) place your modifications in the Public Domain or otherwise make them 53 | Freely Available, such as by posting said modifications to Usenet or 54 | an equivalent medium, or placing the modifications on a major archive 55 | site such as uunet.uu.net, or by allowing the Copyright Holder to include 56 | your modifications in the Standard Version of the Package. 57 | 58 | b) use the modified Package only within your corporation or organization. 59 | 60 | c) rename any non-standard executables so the names do not conflict 61 | with standard executables, which must also be provided, and provide 62 | a separate manual page for each non-standard executable that clearly 63 | documents how it differs from the Standard Version. 64 | 65 | d) make other distribution arrangements with the Copyright Holder. 66 | 67 | 4. You may distribute the programs of this Package in object code or 68 | executable form, provided that you do at least ONE of the following: 69 | 70 | a) distribute a Standard Version of the executables and library files, 71 | together with instructions (in the manual page or equivalent) on where 72 | to get the Standard Version. 73 | 74 | b) accompany the distribution with the machine-readable source of 75 | the Package with your modifications. 76 | 77 | c) give non-standard executables non-standard names, and clearly 78 | document the differences in manual pages (or equivalent), together 79 | with instructions on where to get the Standard Version. 80 | 81 | d) make other distribution arrangements with the Copyright Holder. 82 | 83 | 5. You may charge a reasonable copying fee for any distribution of this 84 | Package. You may charge any fee you choose for support of this 85 | Package. You may not charge a fee for this Package itself. However, 86 | you may distribute this Package in aggregate with other (possibly 87 | commercial) programs as part of a larger (possibly commercial) software 88 | distribution provided that you do not advertise this Package as a 89 | product of your own. You may embed this Package's interpreter within 90 | an executable of yours (by linking); this shall be construed as a mere 91 | form of aggregation, provided that the complete Standard Version of the 92 | interpreter is so embedded. 93 | 94 | 6. The scripts and library files supplied as input to or produced as 95 | output from the programs of this Package do not automatically fall 96 | under the copyright of this Package, but belong to whoever generated 97 | them, and may be sold commercially, and may be aggregated with this 98 | Package. If such scripts or library files are aggregated with this 99 | Package via the so-called "undump" or "unexec" methods of producing a 100 | binary executable image, then distribution of such an image shall 101 | neither be construed as a distribution of this Package nor shall it 102 | fall under the restrictions of Paragraphs 3 and 4, provided that you do 103 | not represent such an executable image as a Standard Version of this 104 | Package. 105 | 106 | 7. C subroutines (or comparably compiled subroutines in other 107 | languages) supplied by you and linked into this Package in order to 108 | emulate subroutines and variables of the language defined by this 109 | Package shall not be considered part of this Package, but are the 110 | equivalent of input as in Paragraph 6, provided these subroutines do 111 | not change the language in any way that would cause it to fail the 112 | regression tests for the language. 113 | 114 | 8. Aggregation of this Package with a commercial distribution is always 115 | permitted provided that the use of this Package is embedded; that is, 116 | when no overt attempt is made to make this Package's interfaces visible 117 | to the end user of the commercial distribution. Such use shall not be 118 | construed as a distribution of this Package. 119 | 120 | 9. The name of the Copyright Holder may not be used to endorse or promote 121 | products derived from this software without specific prior written permission. 122 | 123 | 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR 124 | IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 125 | WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 126 | 127 | The End -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/RangeParser.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parse/RangeParser.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Parse::RangeParser; 14 | use strict; 15 | use warnings; 16 | use Parse::Easy::Parse::RangeLexer; 17 | our @ISA = qw(Parse::Easy::Parse::RecursiveDescentParser); 18 | use Parse::Easy::Parse::RecursiveDescentParser; 19 | use feature qw(say); 20 | use Data::Dump qw(pp); 21 | use Parse::Easy::Wildcard; 22 | 23 | sub new { 24 | my ( $class, $lexer ) = @_; 25 | my $self = $class->SUPER::new($lexer); 26 | $self; 27 | } 28 | 29 | sub atom { 30 | my ($self) = @_; 31 | 32 | # atom : '(' expression ')' 33 | # | '[' range ']' 34 | # | CODEPOINTS 35 | # ; 36 | 37 | my $lexer = $self->{lexer}; 38 | my $token = $lexer->peek(); 39 | if ( $token->{type} eq 'LPAREN' ) { 40 | $lexer->advance(); 41 | my $expression = $self->expression(); 42 | $lexer->skip( ['RPAREN'] ); 43 | return $expression; 44 | } 45 | elsif ( $token->{type} eq 'LBRACK' ) { 46 | $lexer->advance(); 47 | my $expression = $self->range(); 48 | $lexer->skip( ['RBRACK'] ); 49 | return $expression; 50 | } 51 | elsif ( $token->{type} eq 'CODEPOINTS' ) { 52 | $lexer->advance(); 53 | return $token->{value}; 54 | } 55 | else { 56 | $lexer->expect( ['CODEPOINTS'], $token->{type}, $token->{type} ); 57 | } 58 | } 59 | 60 | sub unaryExpression { 61 | my ($self) = @_; 62 | 63 | # unaryExpression : NOT atom 64 | # | atom 65 | # ; 66 | 67 | my $lexer = $self->{lexer}; 68 | my $negate = $lexer->match( ['BANG'] ); 69 | my $expression = $self->atom(); 70 | if ($negate) { 71 | my $wildcard = Parse::Easy::Wildcard::wildcard(); 72 | $wildcard->D($expression); 73 | return $wildcard; 74 | } 75 | $expression; 76 | } 77 | 78 | sub addSubExpression { 79 | my ($self) = @_; 80 | 81 | # addSubExpression : addSubExpression (ADD|SUB) unaryExpression 82 | # | unaryExpression 83 | # ; 84 | 85 | my $lexer = $self->{lexer}; 86 | my $expression = $self->unaryExpression(); 87 | while ( $lexer->match( [ 'PLUS', 'MINUS' ] ) ) { 88 | my $minus = $lexer->matched() eq 'MINUS'; 89 | my $right = $self->unaryExpression(); 90 | if ($minus) { 91 | $expression->D($right); 92 | } 93 | else { 94 | $expression->U($right); 95 | } 96 | } 97 | $expression; 98 | } 99 | 100 | sub andExpression { 101 | my ($self) = @_; 102 | 103 | # andExpression : andExpression AND addSubExpression 104 | # | addSubExpression 105 | # ; 106 | 107 | my $lexer = $self->{lexer}; 108 | my $expression = $self->addSubExpression(); 109 | while ( $lexer->match( ['AND'] ) ) { 110 | my $right = $self->addSubExpression(); 111 | $expression->I($right); 112 | } 113 | $expression; 114 | } 115 | 116 | sub orExpression { 117 | my ($self) = @_; 118 | 119 | # orExpression : orExpression (OR|XOR) andExpression 120 | # | andExpression 121 | # ; 122 | 123 | my $lexer = $self->{lexer}; 124 | my $expression = $self->andExpression(); 125 | while ( $lexer->match( [ 'BAR', 'CIRCUMFLEX' ] ) ) { 126 | my $or = $lexer->matched() eq 'BAR'; 127 | my $right = $self->andExpression(); 128 | if ($or) { 129 | $expression->U($right); 130 | } 131 | else { 132 | $expression->X($right); 133 | } 134 | } 135 | $expression; 136 | } 137 | 138 | sub expression { 139 | my ($self) = @_; 140 | 141 | # expression : orExpression ; 142 | $self->orExpression(); 143 | } 144 | 145 | sub element { 146 | my ($self) = @_; 147 | 148 | # element : CODEPOINTS 149 | # | CODEPOINT 150 | # ; 151 | my %accept = map { $_ => 1 } qw/AND BAR BANG PLUS MINUS CIRCUMFLEX LPAREN RPAREN/; 152 | my $set = undef; 153 | my $lexer = $self->{lexer}; 154 | my $from = $lexer->peek(); 155 | if ( $from->{type} eq 'CODEPOINT' ) { 156 | $lexer->advance(); 157 | my $minus = $lexer->peek(); 158 | if ( $minus->{type} eq 'MINUS' ) { 159 | $lexer->advance(); 160 | my $to = $lexer->peek(); 161 | if ( $to->{type} eq 'CODEPOINT' ) { 162 | $lexer->advance(); 163 | $set = Set::IntSpan->new("$from->{value}-$to->{value}"); 164 | } 165 | else { 166 | $set = Set::IntSpan->new(); 167 | $set->U( $from->{value} ); 168 | $set->U( $minus->{value} ); 169 | } 170 | } 171 | else { 172 | $set = Set::IntSpan->new( $from->{value} ); 173 | } 174 | } 175 | elsif ( $from->{type} eq 'CODEPOINTS' ) { 176 | $lexer->advance(); 177 | return $from->{value}; 178 | } 179 | elsif ( exists $accept{ $from->{type} } ) { 180 | $lexer->advance(); 181 | $set = Set::IntSpan->new( $from->{value} ); 182 | } 183 | else { 184 | $lexer->expect( [ 'CHAR', 'CODEPOINTS' ], $from->{type}, $from->{type} ); 185 | } 186 | $set; 187 | } 188 | 189 | sub elements { 190 | my ($self) = @_; 191 | 192 | # elements : elements element 193 | # | element 194 | # ; 195 | my $lexer = $self->{lexer}; 196 | my $set = Set::IntSpan->new(); 197 | while (1) { 198 | my $token = $lexer->peek(); 199 | $token->{type} eq 'RBRACK' || $token->{type} eq 'EOF' and last; 200 | my $element = $self->element(); 201 | $set->U($element); 202 | } 203 | $set; 204 | } 205 | 206 | sub unary { 207 | my ($self) = @_; 208 | my $token = $self->{lexer}->peek(); 209 | my $negate = 0; 210 | $token->{type} eq 'CIRCUMFLEX' && $self->{lexer}->advance() && ++$negate; 211 | my $result = $self->elements(); 212 | if ($negate) { 213 | my $wildcard = Parse::Easy::Wildcard::wildcard(); 214 | $wildcard->D($result); 215 | return $wildcard; 216 | } 217 | $result; 218 | } 219 | 220 | sub range { 221 | my ($self) = @_; 222 | my $lexer = $self->{lexer}; 223 | my $expression = $self->unary(); 224 | } 225 | 226 | sub extendedExpression { 227 | my ($self) = @_; 228 | my $lexer = $self->{lexer}; 229 | my $expression = undef; 230 | if ( $lexer->match( ['EXTENDED'] ) ) { 231 | $expression = $self->expression(); 232 | } 233 | else { 234 | $expression = $self->range(); 235 | } 236 | $expression; 237 | } 238 | 239 | sub parse { 240 | my ($self) = @_; 241 | my $lexer = $self->{lexer}; 242 | $lexer->advance(); 243 | $lexer->skip( ['LBRACK'] ); 244 | my $expression = $self->extendedExpression(); 245 | my $rbrack = $lexer->peek(); 246 | $rbrack->{type} eq 'RBRACK' or $lexer->expect( ['RBRACK'] ); 247 | $self->{set} = $expression; 248 | } 249 | 1; 250 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/Instruction.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/Instruction.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Lexer::Instruction; 14 | use strict; 15 | use warnings; 16 | use Readonly; 17 | use feature qw(say); 18 | use Data::Dump qw(pp); 19 | use List::Util qw(min max); 20 | use Parse::Easy::Lexer::Compiler::Utils qw(sizeOfInteger); 21 | use Parse::Easy::Endian qw(unpackInteger); 22 | 23 | my %char2size = ( 24 | b => 8, 25 | w => 16, 26 | d => 32, 27 | ); 28 | 29 | sub new { 30 | my ( $class, $compiler, $name ) = @_; 31 | my $entries = $compiler->{isa}->{$name}; 32 | $entries or die sprintf "unkown instruction '%s'", $name; 33 | my ( $maxsize, $maybeRelative ) = ( 0, 0 ); 34 | foreach my $entry (@$entries) { 35 | $maxsize = max( $maxsize, $entry->{maxsize} ); 36 | $maybeRelative |= $entry->{relative}; 37 | } 38 | my $self = { 39 | compiler => $compiler, 40 | endian => $compiler->{endian}, 41 | name => $name, 42 | index => undef, 43 | encoding => undef, 44 | address => undef, 45 | entry => undef, 46 | maxsize => $maxsize, 47 | size => undef, 48 | entries => $entries, 49 | maybeRelative => $maybeRelative, 50 | isLabel => $name eq 'label', 51 | operands => [], 52 | of => 0, 53 | }; 54 | bless $self, $class; 55 | $self; 56 | } 57 | sub maybeRelative { $_[0]->{maybeRelative} } 58 | sub isLabel { $_[0]->{isLabel} } 59 | sub maxSize { $_[0]->{maxsize} } 60 | sub size { $_[0]->{size} } 61 | sub clear { $_[0]->{encoding} = undef } 62 | 63 | sub address { 64 | my ( $self, $value ) = @_; 65 | $self->{address} = $value // $self->{address}; 66 | } 67 | 68 | sub entry { 69 | my ( $self, $value ) = @_; 70 | $self->{entry} = $value // $self->{entry}; 71 | } 72 | 73 | sub index { 74 | my ( $self, $value ) = @_; 75 | $self->{index} = $value // $self->{index}; 76 | } 77 | 78 | sub addOperand { 79 | my ( $self, $value ) = @_; 80 | push @{ $self->{operands} }, $value; 81 | } 82 | 83 | sub normalize { 84 | my ( $self, $operand, $template ) = @_; 85 | my $endian = $self->{endian}; 86 | if ( $template =~ /^rel(\d+)$/ ) { 87 | my $dsz = $1; 88 | my $from = $self->address(); 89 | my $to = $operand->address(); 90 | my $offset = $to - $from; 91 | my $asz = sizeOfInteger( $offset, 1 ); 92 | $asz > $dsz and return 0; 93 | my @bytes = unpackInteger( $offset, $dsz / 8, 1, $endian ); 94 | $self->{$template} = \@bytes; 95 | } 96 | elsif ( $template =~ /^imm(\d+)$/ ) { 97 | my $dsz = $1; 98 | my $asz = sizeOfInteger( $operand, 1 ); 99 | $asz > $dsz and return 0; 100 | my @bytes = unpackInteger( $operand, $dsz / 8, 1, $endian ); 101 | $self->{$template} = \@bytes; 102 | } 103 | elsif ( $template =~ /^uimm(\d+)$/ ) { 104 | $operand < 0 and return 0; 105 | my $dsz = $1; 106 | my $asz = sizeOfInteger( $operand, 0 ); 107 | $asz > $dsz and return 0; 108 | my @bytes = unpackInteger( $operand, $dsz / 8, 0, $endian ); 109 | $self->{$template} = \@bytes; 110 | } 111 | elsif ( $template =~ /^r(\d+)$/ ) { 112 | return $operand eq $template; 113 | } 114 | elsif ( $template =~ /^rr$/ ) { 115 | $operand =~ /^r(\d+)$/ or return 0; 116 | $1 < 7 or return 0; 117 | $self->{mr} |= $1 << 5; 118 | } 119 | elsif ( $template =~ /^rm$/ ) { 120 | $operand =~ /^r(\d+)$/ or return 0; 121 | $1 < 7 or return 0; 122 | $self->{mr} |= $1; 123 | } 124 | elsif ( $template =~ /^offset$/ ) { 125 | my $mr = $self->{mr}; 126 | if ($operand) { 127 | my $value = $operand; 128 | my $power = 8; 129 | for my $i (qw/64 32 16 8 4 2 1/) { 130 | $power--; 131 | unless ( $value % $i ) { 132 | $value /= $i; 133 | last; 134 | } 135 | } 136 | $power < 8 or die "invalid power"; 137 | my $asz = sizeOfInteger( $value, 0 ); 138 | $mr |= { 8 => 0, 16 => 1, 32 => 2, 64 => 3 }->{$asz}; 139 | $mr |= $power << 2; 140 | my @bytes = unpackInteger( $value, $asz / 8, 0, $endian ); 141 | $self->{offset} = \@bytes; 142 | $self->{mr} = $mr; 143 | } 144 | else { 145 | $self->{offset} = []; 146 | } 147 | } 148 | else { 149 | die "unhandled '$template'"; 150 | } 151 | 1; 152 | } 153 | 154 | sub encodeEntry { 155 | my ( $self, $entry ) = @_; 156 | $self->{mr} = 0; 157 | $self->{offset} = undef; 158 | my @templates = @{ $entry->{args} }; 159 | my @patterns = @{ $entry->{patterns} }; 160 | my @operands = @{ $self->{operands} }; 161 | @operands != @templates and return undef; 162 | 163 | for my $i ( 0 .. @templates - 1 ) { 164 | my $operand = $operands[$i]; 165 | my $template = $templates[$i]; 166 | my $result = $self->normalize( $operand, $template ); 167 | $result or return undef; 168 | } 169 | my @encoding = (); 170 | for my $i ( 0 .. @patterns - 1 ) { 171 | local $_ = $patterns[$i]; 172 | if (/^0x[0-9a-f]{2}/i) { 173 | push @encoding, oct $_; 174 | } 175 | elsif (/^o([bwd])$/) { 176 | my %rels = ( ob => 'rel8', ow => 'rel16', od => 'rel32' ); 177 | my $rel = $rels{$_}; 178 | push @encoding, @{ $self->{$rel} }; 179 | } 180 | elsif (/^[iu](\d+)$/) { 181 | my %imms = ( 182 | i8 => 'imm8', 183 | i16 => 'imm16', 184 | i32 => 'imm32', 185 | u8 => 'imm8', 186 | u16 => 'uimm16', 187 | u32 => 'uimm32' 188 | ); 189 | my $imm = $imms{$_}; 190 | push @encoding, @{ $self->{$imm} }; 191 | } 192 | elsif (/^mr$/) { 193 | push @encoding, $self->{mr}; 194 | } 195 | elsif (/^mf$/) { 196 | push @encoding, $self->{mr}; 197 | $self->{offset} and push @encoding, @{ $self->{offset} }; 198 | } 199 | else { 200 | die "unable to handle pattern '$_'"; 201 | } 202 | } 203 | \@encoding; 204 | } 205 | 206 | sub doEncode { 207 | my ($self) = @_; 208 | my $encoding = undef; 209 | for my $i ( 0 .. scalar @{ $self->{entries} } - 1 ) { 210 | my $entry = $self->{entries}->[$i]; 211 | $encoding = $self->encodeEntry($entry); 212 | defined $encoding and $self->entry($entry) and last; 213 | } 214 | $encoding or die sprintf "unable to encode instruction '%s'", $self->{name}; 215 | $encoding; 216 | } 217 | 218 | sub encoding { 219 | my ( $self, $value ) = @_; 220 | if ( defined $value ) { 221 | $self->{encoding} = $value; 222 | $self->{size} = scalar @$value; 223 | } 224 | $self->{encoding}; 225 | } 226 | 227 | sub encode { 228 | my ($self) = @_; 229 | $self->encoding( $self->doEncode() ); 230 | } 231 | 232 | 1; 233 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/Parser.eyp: -------------------------------------------------------------------------------- 1 | %token LPAREN RPAREN LBRACK RBRACK LBRACE RBRACE BAR DOT COLON COLONCOLON COMMA SEMICOLON 2 | %token LT GT SLASH 3 | %token MINUS PLUS STAR QUESTION 4 | %token CIRCUMFLEX DOLLAR 5 | %token RANGE 6 | %token FRAGMENT GRAMMAR SECTION QW QWCLOSE USE AS 7 | %token TERM NOTERM UNDERSCORE PACKAGE_NAME 8 | %token SQ_LITERAL DQ_LITERAL ACTION 9 | %token SQRAWSTR DQRAWSTR 10 | 11 | %{ 12 | 13 | use Parse::Easy::Grammar; 14 | use Parse::Easy::Rule; 15 | use Parse::Easy::Term; 16 | use Parse::Easy::NoTerm; 17 | use Parse::Easy::CharacterSet; 18 | use Parse::Easy::Wildcard; 19 | use Parse::Easy::Control; 20 | 21 | my $grammar = Parse::Easy::Grammar->new(); 22 | my $lexer = $grammar->{lexer}; 23 | my $parser = $grammar->{parser}; 24 | 25 | %} 26 | 27 | %start start 28 | %strict 29 | 30 | %% 31 | start 32 | : program 33 | ; 34 | 35 | program 36 | : GRAMMAR id SEMICOLON optionalBody 37 | { 38 | $grammar->{name} = $_[2]; 39 | $grammar; 40 | } 41 | ; 42 | 43 | optionalBody 44 | : 45 | | body 46 | ; 47 | 48 | body 49 | : body spec 50 | | spec 51 | ; 52 | 53 | spec 54 | : rule 55 | | section 56 | | use 57 | ; 58 | 59 | use 60 | : USE PACKAGE_NAME array? SEMICOLON 61 | { 62 | my $array = $_[3][0] // []; 63 | $grammar->processUse($_[2], $array); 64 | } 65 | ; 66 | 67 | array 68 | : lazyArray 69 | | legacyArray 70 | ; 71 | 72 | lazyArray 73 | : QW qwOpen optLazyItems qwClose { $_[3] // [] } 74 | ; 75 | 76 | qwOpen 77 | : LPAREN 78 | | SLASH 79 | | LT 80 | ; 81 | 82 | qwClose 83 | : QWCLOSE 84 | ; 85 | 86 | optLazyItems 87 | : #empty 88 | | lazyItems 89 | ; 90 | 91 | lazyItems 92 | : lazyItems lazyItem { push @{$_[1]}, $_[2]; $_[1] } 93 | | lazyItem { [$_[1]] } 94 | ; 95 | 96 | lazyItem 97 | : id 98 | ; 99 | 100 | legacyArray 101 | : LPAREN optItems RPAREN { $_[2] // [] } 102 | ; 103 | 104 | optItems 105 | : #empty 106 | | items 107 | ; 108 | 109 | items 110 | : items COMMA item { push @{$_[1]}, $_[3]; $_[1] } 111 | | item { [$_[1]] } 112 | ; 113 | 114 | item 115 | : id 116 | | rawStr 117 | ; 118 | 119 | rawStr 120 | : SQRAWSTR 121 | | DQRAWSTR 122 | ; 123 | 124 | section 125 | : SECTION sectionNames SEMICOLON 126 | { $lexer->currentSections($_[2]) } 127 | ; 128 | 129 | sectionNames 130 | : sectionName { [$_[1]] } 131 | | LPAREN STAR RPAREN { $lexer->{sections} } 132 | | LPAREN sectionNameSequence RPAREN { $_[2] } 133 | ; 134 | 135 | sectionName 136 | : TERM 137 | ; 138 | 139 | sectionNameSequence 140 | : sectionNameSequence COMMA sectionName { push @{$_[1]}, $_[3]; $_[1] } 141 | | sectionName { [$_[1]] } 142 | ; 143 | 144 | rule 145 | : lexerRule 146 | | parserRule 147 | ; 148 | 149 | lexerRule 150 | : FRAGMENT? TERM COLON lexerRhss SEMICOLON 151 | { 152 | my $name = $_[2]; 153 | my $fragment = defined $_[1][0]; 154 | exists $lexer->{names}->{$name} || exists $parser->{names}->{$name} 155 | and die sprintf "rule '%s' already declared.", $name; 156 | foreach my $rhs(@{ $_[4] }){ 157 | my $rule = Parse::Easy::Rule->new($name, $rhs); 158 | $fragment and $rule->fragment(1); 159 | $lexer->addRule($rule); 160 | } 161 | } 162 | ; 163 | 164 | lexerRhss 165 | : lexerRhss BAR lexerRhs { push @{$_[1]}, $_[3]; $_[1] } 166 | | lexerRhs { [$_[1]] } 167 | ; 168 | 169 | lexerRhs 170 | : #empty 171 | | CIRCUMFLEX? lexerElements DOLLAR? 172 | { 173 | if (!( defined $_[1][0] || defined $_[3][0] ) ) { 174 | $_[2]; 175 | } 176 | else { 177 | my @elements = (); 178 | defined $_[1][0] and push @elements, Parse::Easy::Control->new('START'); 179 | push @elements, @{ $_[2] }; 180 | defined $_[3][0] and push @elements, Parse::Easy::Control->new('END'); 181 | \@elements; 182 | } 183 | } 184 | ; 185 | 186 | lexerElements 187 | : lexerElements lexerElement { push @{$_[1]}, $_[2]; $_[1] } 188 | | lexerElement { [ $_[1] ] } 189 | ; 190 | 191 | lexerElement 192 | : lexerAtom ebnfSuffix? 193 | { 194 | my $ebnf = $_[2][0]; 195 | if($ebnf){ 196 | $lexer->ebnf($_[1], $ebnf); 197 | }else{ 198 | $_[1]; 199 | } 200 | } 201 | | ACTION 202 | ; 203 | 204 | lexerAtom 205 | : LPAREN lexerRhss RPAREN { $lexer->parenthesis($_[2]) } 206 | | RANGE { Parse::Easy::CharacterSet->new($_[1])} 207 | | TERM { Parse::Easy::NoTerm->new($_[1]) } 208 | | DOT { Parse::Easy::CharacterSet->new( 209 | Parse::Easy::Wildcard::wildcard()) } 210 | | SQ_LITERAL 211 | | DQ_LITERAL 212 | ; 213 | 214 | ebnfSuffix 215 | : PLUS QUESTION? { 0x01 | ( defined $_[2][0] ? 0x10 : 0x00 ) } 216 | | STAR QUESTION? { 0x02 | ( defined $_[2][0] ? 0x10 : 0x00 ) } 217 | | QUESTION { 0x04 } 218 | ; 219 | 220 | # parser rule: 221 | # ------------ 222 | 223 | parserRule 224 | : NOTERM parserRuleType COLON parserRhss SEMICOLON 225 | { 226 | my $name = $_[1]; 227 | exists $lexer->{names}->{$name} || exists $parser->{names}->{$name} 228 | and die sprintf "rule '%s' already declared.", $name; 229 | foreach my $rhs(@{ $_[4] }){ 230 | my $rule = Parse::Easy::Rule->new($name, $rhs); 231 | $rule->returnType($_[2]); 232 | $parser->addRule($rule); 233 | } 234 | } 235 | ; 236 | 237 | parserRuleType 238 | : { undef } 239 | | AS id { $_[2] } 240 | ; 241 | 242 | parserRhss 243 | : parserRhss BAR parserRhs { push @{$_[1]}, $_[3]; $_[1] } 244 | | parserRhs { [$_[1]] } 245 | ; 246 | 247 | parserRhs 248 | : { [] } #empty 249 | | parserElements 250 | ; 251 | 252 | parserElements 253 | : parserElements parserElement { push @{$_[1]}, $_[2]; $_[1] } 254 | | parserElement { [ $_[1] ] } 255 | ; 256 | 257 | parserElement 258 | : parserAtom ebnfSuffix? 259 | { 260 | my $ebnf = $_[2][0]; 261 | if($ebnf){ 262 | $parser->ebnf($_[1], $ebnf); 263 | }else{ 264 | $_[1]; 265 | } 266 | } 267 | | ACTION 268 | ; 269 | 270 | parserAtom 271 | : LPAREN parserRhss RPAREN { $parser->parenthesis($_[2]) } 272 | | TERM { Parse::Easy::Term->new($_[1]) } 273 | | NOTERM { Parse::Easy::NoTerm->new($_[1]) } 274 | ; 275 | 276 | 277 | id 278 | : TERM 279 | | NOTERM 280 | | UNDERSCORE 281 | ; 282 | 283 | %% 284 | 285 | require 'Parse/Easy/Parse/Lexer.pl'; 286 | __PACKAGE__->lexer(\&__LEXER); 287 | __PACKAGE__->error(\&__EXPECT); -------------------------------------------------------------------------------- /runtime/Pascal/Parse.Easy.Parser.Deserializer.pas: -------------------------------------------------------------------------------- 1 | // ----------- Parse::Easy::Runtime ----------- 2 | // https://github.com/MahdiSafsafi/Parse-Easy 3 | // -------------------------------------------- 4 | 5 | unit Parse.Easy.Parser.Deserializer; 6 | 7 | interface 8 | 9 | uses 10 | System.SysUtils, 11 | System.Classes, 12 | System.Types, 13 | Parse.Easy.Lexer.CustomLexer, 14 | Parse.Easy.Parser.State, 15 | Parse.Easy.Parser.Rule, 16 | Parse.Easy.Parser.Action; 17 | 18 | type 19 | TDeserializer = class(TObject) 20 | strict private 21 | class var 22 | CResourceStream: TResourceStream; 23 | CRules: TList; 24 | CStates: TList; 25 | private 26 | FRules: TList; 27 | FStates: TList; 28 | FLexer: TCustomLexer; 29 | protected 30 | class procedure Deserialize(const Name: string); 31 | public 32 | class constructor Create(); 33 | class destructor Destroy(); 34 | constructor Create(ALexer: TCustomLexer); virtual; 35 | { properties } 36 | property Rules: TList read FRules; 37 | property States: TList read FStates; 38 | property Lexer: TCustomLexer read FLexer; 39 | end; 40 | 41 | implementation 42 | 43 | type 44 | THeader = packed record 45 | MajorVersion: Integer; 46 | MinorVersion: Integer; 47 | NumberOfStates: Integer; 48 | NumberOfRules: Integer; 49 | NumberOfTokens: Integer; 50 | end; 51 | 52 | PHeader = ^THeader; 53 | 54 | { TDeserializer } 55 | 56 | class constructor TDeserializer.Create(); 57 | begin 58 | CRules := nil; 59 | CStates := nil; 60 | CResourceStream := nil; 61 | end; 62 | 63 | class destructor TDeserializer.Destroy(); 64 | procedure DestroyTermsOrNoTerms(List: TList); 65 | var 66 | I: Integer; 67 | J: Integer; 68 | Actions: TList; 69 | Action: TAction; 70 | begin 71 | if not Assigned(List) then 72 | exit(); 73 | for I := 0 to List.Count - 1 do 74 | begin 75 | Actions := List[I]; 76 | if Assigned(Actions) then 77 | begin 78 | for J := 0 to Actions.Count - 1 do 79 | begin 80 | Action := Actions[J]; 81 | if Assigned(Action) then 82 | Action.Free(); 83 | end; 84 | end; 85 | end; 86 | end; 87 | 88 | var 89 | I: Integer; 90 | State: TState; 91 | begin 92 | if Assigned(CRules) then 93 | begin 94 | for I := 0 to CRules.Count - 1 do 95 | if Assigned(CRules[I]) then 96 | TRule(CRules[I]).Free(); 97 | CRules.Free(); 98 | end; 99 | if Assigned(CStates) then 100 | begin 101 | for I := 0 to CStates.Count - 1 do 102 | begin 103 | State := CStates[I]; 104 | if Assigned(State) then 105 | begin 106 | DestroyTermsOrNoTerms(State.Terms); 107 | DestroyTermsOrNoTerms(State.NoTerms); 108 | TState(CStates[I]).Free(); 109 | end; 110 | end; 111 | CStates.Free(); 112 | end; 113 | if Assigned(CResourceStream) then 114 | CResourceStream.Free(); 115 | end; 116 | 117 | constructor TDeserializer.Create(ALexer: TCustomLexer); 118 | begin 119 | FRules := CRules; 120 | FStates := CStates; 121 | FLexer := ALexer; 122 | end; 123 | 124 | class procedure TDeserializer.Deserialize(const Name: string); 125 | var 126 | Header: THeader; 127 | procedure ReadRules(); 128 | function Raw2RuleFlags(Value: Integer): TRuleFlags; 129 | begin 130 | Result := []; 131 | if (Value and 1) <> 0 then 132 | Include(Result, rfAccept); 133 | end; 134 | 135 | var 136 | I: Integer; 137 | Rule: TRule; 138 | Value: Integer; 139 | begin 140 | CRules := TList.Create; 141 | for I := 0 to Header.NumberOfRules - 1 do 142 | begin 143 | Rule := TRule.Create; 144 | CRules.Add(Rule); 145 | Rule.Index := I; 146 | 147 | CResourceStream.Read(Value, SizeOf(Value)); 148 | Rule.Id := Value; 149 | 150 | CResourceStream.Read(Value, SizeOf(Value)); 151 | Rule.Flags := Raw2RuleFlags(Value); 152 | 153 | CResourceStream.Read(Value, SizeOf(Value)); 154 | Rule.NumberOfItems := Value; 155 | 156 | CResourceStream.Read(Value, SizeOf(Value)); 157 | Rule.ActionIndex := Value; 158 | end; 159 | end; 160 | procedure ReadStates(); 161 | var 162 | I, J, K: Integer; 163 | State: TState; 164 | Index: Integer; 165 | NumberOfTerms: Integer; 166 | NumberOfNoTerms: Integer; 167 | NumberOfActions: Integer; 168 | ActionType: TActionType; 169 | ActionValue: Integer; 170 | Tmp: Integer; 171 | Action: TAction; 172 | Actions: TList; 173 | TermOrNoTerm: TList; 174 | NumberOfTermOrNoTerm: Integer; 175 | label ReadGotos; 176 | begin 177 | CStates := TList.Create(); 178 | for I := 0 to Header.NumberOfStates - 1 do 179 | begin 180 | State := TState.Create(); 181 | CStates.Add(State); 182 | end; 183 | for I := 0 to Header.NumberOfStates - 1 do 184 | begin 185 | CResourceStream.Read(Index, SizeOf(Index)); // index. 186 | State := CStates[Index]; 187 | State.Index := Index; 188 | State.NumberOfTerms := Header.NumberOfTokens; 189 | State.NumberOfNoTerms := Header.NumberOfRules; 190 | CResourceStream.Read(NumberOfTerms, SizeOf(NumberOfTerms)); 191 | CResourceStream.Read(NumberOfNoTerms, SizeOf(NumberOfNoTerms)); 192 | 193 | { read goto table } 194 | TermOrNoTerm := State.Terms; 195 | NumberOfTermOrNoTerm := NumberOfTerms; 196 | 197 | ReadGotos: 198 | for J := 0 to NumberOfTermOrNoTerm - 1 do 199 | begin 200 | CResourceStream.Read(Index, SizeOf(Index)); // token. 201 | CResourceStream.Read(NumberOfActions, SizeOf(NumberOfActions)); // NumberOfActions. 202 | Actions := TList.Create(); 203 | TermOrNoTerm[Index] := Actions; 204 | for K := 0 to NumberOfActions - 1 do 205 | begin 206 | CResourceStream.Read(Tmp, SizeOf(Tmp)); 207 | CResourceStream.Read(ActionValue, SizeOf(ActionValue)); 208 | case Tmp of 209 | 1: ActionType := atShift; 210 | 2: ActionType := atReduce; 211 | 3: ActionType := atJump; 212 | else 213 | raise Exception.Create('encoding error: Invalid action type.'); 214 | end; 215 | Action := TAction.Create(ActionType, ActionValue); 216 | Actions.Add(Action); 217 | end; 218 | end; 219 | if TermOrNoTerm = State.Terms then 220 | begin 221 | TermOrNoTerm := State.NoTerms; 222 | NumberOfTermOrNoTerm := NumberOfNoTerms; 223 | goto ReadGotos; 224 | end; 225 | end; 226 | end; 227 | 228 | begin 229 | CResourceStream := TResourceStream.Create(HInstance, Name, RT_RCDATA); 230 | try 231 | CResourceStream.Read(Header, SizeOf(THeader)); 232 | ReadRules(); 233 | ReadStates(); 234 | except 235 | RaiseLastOSError(); 236 | end; 237 | end; 238 | 239 | end. 240 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/OpCodes.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/OpCodes.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | ################################################# 14 | # automatically generated file. do not edit !!! # 15 | ################################################# 16 | 17 | package Parse::Easy::Lexer::OpCodes; 18 | use strict; 19 | use warnings; 20 | use base qw(Exporter); 21 | our @EXPORT_OK = qw(instructions); 22 | 23 | my @instructions = ( 24 | { 25 | args => ["uimm8"], 26 | immediate => 0, 27 | maxsize => 1, 28 | mnem => "db", 29 | patterns => ["u8"], 30 | relative => 0, 31 | }, 32 | { 33 | args => ["uimm16"], 34 | immediate => 0, 35 | maxsize => 2, 36 | mnem => "dw", 37 | patterns => ["u16"], 38 | relative => 0, 39 | }, 40 | { 41 | args => ["uimm32"], 42 | immediate => 0, 43 | maxsize => 4, 44 | mnem => "dd", 45 | patterns => ["u32"], 46 | relative => 0, 47 | }, 48 | { 49 | args => [], 50 | immediate => 0, 51 | maxsize => 0, 52 | mnem => "label", 53 | patterns => [], 54 | relative => 0, 55 | }, 56 | { 57 | args => [], 58 | immediate => 0, 59 | maxsize => 1, 60 | mnem => "vmstart", 61 | patterns => ["0x00"], 62 | relative => 0, 63 | }, 64 | { 65 | args => [], 66 | immediate => 0, 67 | maxsize => 1, 68 | mnem => "vmend", 69 | patterns => ["0x01"], 70 | relative => 0, 71 | }, 72 | { 73 | args => ["rel8"], 74 | immediate => 0, 75 | maxsize => 2, 76 | mnem => "call", 77 | patterns => ["0x02", "ob"], 78 | relative => 1, 79 | }, 80 | { 81 | args => ["rel16"], 82 | immediate => 0, 83 | maxsize => 3, 84 | mnem => "call", 85 | patterns => ["0x03", "ow"], 86 | relative => 1, 87 | }, 88 | { 89 | args => ["rel32"], 90 | immediate => 0, 91 | maxsize => 5, 92 | mnem => "call", 93 | patterns => ["0x04", "od"], 94 | relative => 1, 95 | }, 96 | { 97 | args => ["rel8"], 98 | immediate => 0, 99 | maxsize => 2, 100 | mnem => "b", 101 | patterns => ["0x05", "ob"], 102 | relative => 1, 103 | }, 104 | { 105 | args => ["rel16"], 106 | immediate => 0, 107 | maxsize => 3, 108 | mnem => "b", 109 | patterns => ["0x06", "ow"], 110 | relative => 1, 111 | }, 112 | { 113 | args => ["rel32"], 114 | immediate => 0, 115 | maxsize => 5, 116 | mnem => "b", 117 | patterns => ["0x07", "od"], 118 | relative => 1, 119 | }, 120 | { 121 | args => ["rel8"], 122 | immediate => 0, 123 | maxsize => 2, 124 | mnem => "beq", 125 | patterns => ["0x08", "ob"], 126 | relative => 1, 127 | }, 128 | { 129 | args => ["rel16"], 130 | immediate => 0, 131 | maxsize => 3, 132 | mnem => "beq", 133 | patterns => ["0x09", "ow"], 134 | relative => 1, 135 | }, 136 | { 137 | args => ["rel32"], 138 | immediate => 0, 139 | maxsize => 5, 140 | mnem => "beq", 141 | patterns => ["0x0a", "od"], 142 | relative => 1, 143 | }, 144 | { 145 | args => ["rel8"], 146 | immediate => 0, 147 | maxsize => 2, 148 | mnem => "bneq", 149 | patterns => ["0x0b", "ob"], 150 | relative => 1, 151 | }, 152 | { 153 | args => ["rel16"], 154 | immediate => 0, 155 | maxsize => 3, 156 | mnem => "bneq", 157 | patterns => ["0x0c", "ow"], 158 | relative => 1, 159 | }, 160 | { 161 | args => ["rel32"], 162 | immediate => 0, 163 | maxsize => 5, 164 | mnem => "bneq", 165 | patterns => ["0x0d", "od"], 166 | relative => 1, 167 | }, 168 | { 169 | args => ["rel8"], 170 | immediate => 0, 171 | maxsize => 2, 172 | mnem => "bgt", 173 | patterns => ["0x0e", "ob"], 174 | relative => 1, 175 | }, 176 | { 177 | args => ["rel16"], 178 | immediate => 0, 179 | maxsize => 3, 180 | mnem => "bgt", 181 | patterns => ["0x0f", "ow"], 182 | relative => 1, 183 | }, 184 | { 185 | args => ["rel32"], 186 | immediate => 0, 187 | maxsize => 5, 188 | mnem => "bgt", 189 | patterns => ["0x10", "od"], 190 | relative => 1, 191 | }, 192 | { 193 | args => ["rel8"], 194 | immediate => 0, 195 | maxsize => 2, 196 | mnem => "bge", 197 | patterns => ["0x11", "ob"], 198 | relative => 1, 199 | }, 200 | { 201 | args => ["rel16"], 202 | immediate => 0, 203 | maxsize => 3, 204 | mnem => "bge", 205 | patterns => ["0x12", "ow"], 206 | relative => 1, 207 | }, 208 | { 209 | args => ["rel32"], 210 | immediate => 0, 211 | maxsize => 5, 212 | mnem => "bge", 213 | patterns => ["0x13", "od"], 214 | relative => 1, 215 | }, 216 | { 217 | args => ["rel8"], 218 | immediate => 0, 219 | maxsize => 2, 220 | mnem => "blt", 221 | patterns => ["0x14", "ob"], 222 | relative => 1, 223 | }, 224 | { 225 | args => ["rel16"], 226 | immediate => 0, 227 | maxsize => 3, 228 | mnem => "blt", 229 | patterns => ["0x15", "ow"], 230 | relative => 1, 231 | }, 232 | { 233 | args => ["rel32"], 234 | immediate => 0, 235 | maxsize => 5, 236 | mnem => "blt", 237 | patterns => ["0x16", "od"], 238 | relative => 1, 239 | }, 240 | { 241 | args => ["rel8"], 242 | immediate => 0, 243 | maxsize => 2, 244 | mnem => "ble", 245 | patterns => ["0x17", "ob"], 246 | relative => 1, 247 | }, 248 | { 249 | args => ["rel16"], 250 | immediate => 0, 251 | maxsize => 3, 252 | mnem => "ble", 253 | patterns => ["0x18", "ow"], 254 | relative => 1, 255 | }, 256 | { 257 | args => ["rel32"], 258 | immediate => 0, 259 | maxsize => 5, 260 | mnem => "ble", 261 | patterns => ["0x19", "od"], 262 | relative => 1, 263 | }, 264 | { 265 | args => [], 266 | immediate => 0, 267 | maxsize => 1, 268 | mnem => "nop", 269 | patterns => ["0x1a"], 270 | relative => 0, 271 | }, 272 | { 273 | args => [], 274 | immediate => 0, 275 | maxsize => 1, 276 | mnem => "peek", 277 | patterns => ["0x1b"], 278 | relative => 0, 279 | }, 280 | { 281 | args => [], 282 | immediate => 0, 283 | maxsize => 1, 284 | mnem => "advance", 285 | patterns => ["0x1c"], 286 | relative => 0, 287 | }, 288 | { 289 | args => [], 290 | immediate => 0, 291 | maxsize => 1, 292 | mnem => "forget", 293 | patterns => ["0x1d"], 294 | relative => 0, 295 | }, 296 | { 297 | args => [], 298 | immediate => 0, 299 | maxsize => 1, 300 | mnem => "ret", 301 | patterns => ["0x1e"], 302 | relative => 0, 303 | }, 304 | { 305 | args => ["uimm32"], 306 | immediate => 0, 307 | maxsize => 5, 308 | mnem => "setstate", 309 | patterns => ["0x23", "u32"], 310 | relative => 0, 311 | }, 312 | { 313 | args => ["imm8"], 314 | immediate => 1, 315 | maxsize => 2, 316 | mnem => "mark", 317 | patterns => ["0x24", "i8"], 318 | relative => 0, 319 | }, 320 | { 321 | args => ["imm16"], 322 | immediate => 1, 323 | maxsize => 3, 324 | mnem => "mark", 325 | patterns => ["0x25", "i16"], 326 | relative => 0, 327 | }, 328 | { 329 | args => ["imm32"], 330 | immediate => 1, 331 | maxsize => 5, 332 | mnem => "mark", 333 | patterns => ["0x26", "i32"], 334 | relative => 0, 335 | }, 336 | { 337 | args => ["r0", "uimm8"], 338 | immediate => 0, 339 | maxsize => 2, 340 | mnem => "cmp", 341 | patterns => ["0x27", "u8"], 342 | relative => 0, 343 | }, 344 | { 345 | args => ["r0", "uimm16"], 346 | immediate => 0, 347 | maxsize => 3, 348 | mnem => "cmp", 349 | patterns => ["0x28", "u16"], 350 | relative => 0, 351 | }, 352 | { 353 | args => ["r0", "uimm32"], 354 | immediate => 0, 355 | maxsize => 5, 356 | mnem => "cmp", 357 | patterns => ["0x29", "u32"], 358 | relative => 0, 359 | }, 360 | { 361 | args => ["rr", "offset"], 362 | immediate => 0, 363 | maxsize => 6, 364 | mnem => "inrange", 365 | patterns => ["0x2a", "mf"], 366 | relative => 0, 367 | }, 368 | { 369 | args => ["imm8"], 370 | immediate => 1, 371 | maxsize => 2, 372 | mnem => "isatx", 373 | patterns => ["0x2b", "i8"], 374 | relative => 0, 375 | }, 376 | { 377 | alias => 1, 378 | args => [], 379 | immediate => 0, 380 | maxsize => 2, 381 | mnem => "ststart", 382 | patterns => ["0x30", "0x00"], 383 | relative => 0, 384 | }, 385 | { 386 | alias => 1, 387 | args => [], 388 | immediate => 0, 389 | maxsize => 2, 390 | mnem => "stend", 391 | patterns => ["0x30", "0x01"], 392 | relative => 0, 393 | }, 394 | { 395 | args => ["uimm8"], 396 | immediate => 0, 397 | maxsize => 2, 398 | mnem => "hint", 399 | patterns => ["0x30", "u8"], 400 | relative => 0, 401 | }, 402 | ); 403 | 404 | sub instructions { \@instructions } 405 | 406 | 1; 407 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Lexer/Compiler.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Lexer/Compiler.pm Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | package Parse::Easy::Lexer::Compiler; 14 | use strict; 15 | use warnings; 16 | use feature qw(say); 17 | use Data::Dump qw(pp); 18 | use Storable qw(freeze); 19 | use Digest::MD5 qw(md5_hex); 20 | use List::Util qw(min max); 21 | use Parse::Easy::Lexer::OpCodes qw(instructions); 22 | use Parse::Easy::Lexer::Instruction; 23 | use Parse::Easy::Lexer::Compiler::Utils qw(sizeOfInteger); 24 | use Parse::Easy::Lexer::Disasm; 25 | use Parse::Easy::StreamWriter; 26 | use Parse::Easy::Target::Pascal::Utils qw/generateRes/; 27 | use Compress::Zlib qw(memGzip memGunzip); 28 | use Parse::Easy::Version; 29 | 30 | # load vm instructions: 31 | my %instructions = (); 32 | my $db = instructions(); 33 | push @{ $instructions{ $_->{mnem} } }, $_ foreach (@$db); 34 | 35 | # lazy access: 36 | my $INSTRUCTION_CLASS = 'Parse::Easy::Lexer::Instruction'; 37 | my $STREAM_WRITER_CLASS = 'Parse::Easy::StreamWriter'; 38 | 39 | sub new { 40 | my ( $class, $lexer ) = @_; 41 | my $self = { 42 | lexer => $lexer, 43 | insns => [], 44 | endian => 0, 45 | bytecode => $STREAM_WRITER_CLASS->new(0), 46 | memory => $STREAM_WRITER_CLASS->new(0), 47 | isa => \%instructions, 48 | ruleinfo => undef, 49 | }; 50 | bless $self, $class; 51 | $self; 52 | } 53 | 54 | sub labelOfState { 55 | my ( $self, $state ) = @_; 56 | $state->{label} = $state->{label} // $self->newInsn( 'label', [], 0 ); 57 | } 58 | 59 | sub getSetsElementSize { 60 | my ( $self, $sets ) = @_; 61 | my $size = 0; 62 | for my $i ( 0 .. @$sets - 1 ) { 63 | my $set = $sets->[$i]; 64 | my ( $min, $max ) = ( $set->min(), $set->max() ); 65 | my $diff = $max - $min; 66 | $size = max( $size, sizeOfInteger( $min, 0 ), sizeOfInteger( $diff, 0 ) ); 67 | } 68 | $size / 8; 69 | } 70 | 71 | sub registerSets { 72 | my ( $self, $sets ) = @_; 73 | my $checksum = md5_hex( freeze($sets) ); 74 | my $memory = $self->{memory}; 75 | exists $self->{memoryCheckSums}->{$checksum} 76 | and return $self->{memoryCheckSums}->{$checksum}; 77 | 78 | $memory->write32( scalar @$sets ); 79 | my $pos = $memory->pos(); 80 | 81 | for my $i ( 0 .. @$sets - 1 ) { 82 | my $set = $sets->[$i]; 83 | $memory->writeInteger( $set->min(), 4, 1 ); 84 | $memory->writeInteger( $set->max(), 4, 1 ); 85 | } 86 | $self->{memoryCheckSums}->{$checksum} = $pos; 87 | $pos; 88 | } 89 | 90 | sub compileState { 91 | my ( $self, $state ) = @_; 92 | $self->addInsn( $self->labelOfState($state) ); 93 | $self->newInsn( 'ststart', [], 1 ); 94 | $self->newInsn( 'setstate', [ $state->{index} ], 1 ); 95 | if ( $state->{accepts} && @{ $state->{accepts} } ) { 96 | $self->newInsn( 'forget', [], 1 ); 97 | foreach my $accept ( @{ $state->{accepts} } ) { 98 | my $ruleIndex = $accept->{index}; 99 | my $next = $self->newInsn( 'label', [], 0 ); 100 | if ( $accept->start() ) { 101 | $self->newInsn( 'isatx', [0], 1 ); 102 | $self->newInsn( 'bneq', [$next], 1 ); 103 | } 104 | unless ( $accept->{anysection} ) { 105 | my $sections = $accept->{sections}; 106 | my @sets = $sections->sets(); 107 | my $setIndex = $self->registerSets( \@sets ); 108 | 109 | $self->newInsn( 'inrange', [ 'r1', $setIndex ], 1 ); 110 | $self->newInsn( 'bneq', [$next], 1 ); 111 | } 112 | if ( $accept->end() ) { 113 | $self->newInsn( 'isatx', [1], 1 ); 114 | $self->newInsn( 'bneq', [$next], 1 ); 115 | } 116 | 117 | $self->newInsn( 'mark', [$ruleIndex], 1 ); 118 | $self->addInsn($next); 119 | } 120 | } 121 | if ( @{ $state->{gotos} } ) { 122 | $self->newInsn( 'peek', [], 1 ); 123 | foreach my $goto ( @{ $state->{gotos} } ) { 124 | my $next = $self->newInsn( 'label', [], 0 ); 125 | my $key = $goto->{key}; 126 | my $target = $goto->{target}; 127 | my @sets = $key->sets(); 128 | my $setIndex = $self->registerSets( \@sets ); 129 | $self->newInsn( 'inrange', [ 'r0', $setIndex ], 1 ); 130 | $self->newInsn( 'bneq', [$next], 1 ); 131 | $self->newInsn( 'advance', [], 1 ); 132 | $self->newInsn( 'call', [ $self->labelOfState($target) ], 1 ); 133 | $self->newInsn( 'ret', [], 1 ); 134 | $self->addInsn($next); 135 | } 136 | } 137 | $self->newInsn( 'ret', [], 1 ); 138 | $self->newInsn( 'stend', [], 1 ); 139 | } 140 | 141 | sub emit { 142 | my ( $self, $bytes ) = @_; 143 | my $bytecode = $self->{bytecode}; 144 | $bytecode->writeBytes(@$bytes); 145 | } 146 | 147 | sub newInsn { 148 | my ( $self, $name, $operands, $add ) = @_; 149 | my $insn = $INSTRUCTION_CLASS->new( $self, $name ); 150 | $operands and $insn->addOperand($_) foreach (@$operands); 151 | $add and $self->addInsn($insn); 152 | $insn; 153 | } 154 | 155 | sub addInsn { 156 | my ( $self, $insn ) = @_; 157 | $insn->index( scalar @{ $self->{insns} } ); 158 | push @{ $self->{insns} }, $insn; 159 | $insn; 160 | } 161 | 162 | sub translate { 163 | my ($self) = @_; 164 | 165 | # first give all instructions a probability address. 166 | my $address = 0; 167 | my @relatives = (); 168 | foreach my $insn ( @{ $self->{insns} } ) { 169 | $insn->address($address); 170 | 171 | # for no-relative instructions, the encoder engine 172 | # is smart enough to choose the best and shortest 173 | # instruction's length. 174 | # however, relative instructions depend on encoding 175 | # of others instructions, so the encoder engine 176 | # is unable to decide which instruction to use (8-bit/16-bit/32-bit). 177 | # so in order to generate shortest instruction's lenght for relative-instructions, 178 | # we need to encode them later (after encoding all no relative-instructions). 179 | if ( $insn->maybeRelative() ) { 180 | 181 | $address += $insn->maxSize(); 182 | push @relatives, $insn; 183 | } 184 | else { 185 | $insn->encode(); 186 | $address += $insn->size(); 187 | } 188 | } 189 | 190 | # now we encode relative instructions 191 | # the bellow algorithm will generate the shortest 192 | # relative instruction's length. 193 | my ( $depth, $notDone ) = (0); 194 | encodeRelatives: 195 | $depth++; 196 | $notDone = 0; # assume everything is good. 197 | foreach my $insn (@relatives) { 198 | my $maxSize = $insn->size() // $insn->maxSize(); 199 | $insn->encode(); 200 | my $size = $insn->size(); 201 | my $diff = $maxSize - $size; 202 | $diff or next; # diff = 0 => no need to fix instruction address. 203 | $diff < 0 and die "diff < 0 => this can't be happen !!!"; 204 | $notDone++; 205 | my $i = $insn->{index}; 206 | 207 | # fix address for all instruction that come after a relative-instruction. 208 | for my $j ( $i + 1 .. @{ $self->{insns} } - 1 ) { 209 | my $next = $self->{insns}->[$j]; 210 | $next->address( $next->address() - $diff ); 211 | } 212 | } 213 | $notDone and goto encodeRelatives; 214 | 215 | foreach my $insn ( @{ $self->{insns} } ) { 216 | my $encoding = $insn->encoding(); 217 | $self->emit($encoding); 218 | } 219 | 220 | # my @bytes = unpack "C*", $self->{bytecode}; 221 | # Parse::Easy::Lexer::Disasm::disasm( \@bytes ); 222 | } 223 | 224 | sub verbosity { 225 | my ($self) = @_; 226 | printf "\n\n\n\n"; 227 | foreach my $insn ( @{ $self->{insns} } ) { 228 | my $name = $insn->{name}; 229 | my @args = (); 230 | if ( $name =~ /^(call|bneq)$/ ) { 231 | push @args, $insn->{operands}->[0]->{address}; 232 | my $offset = $insn->{operands}->[0]->address() - $insn->address(); 233 | 234 | push @args, $insn->address() + $offset; 235 | push @args, $offset; 236 | } 237 | my $args = join( ', ', @args ); 238 | my @encoding = map { sprintf "0x%02x", $_ } @{ $insn->{encoding} }; 239 | my $encoding = join( ' ', @encoding ); 240 | printf "%04d 0x%08x %-15s %-8s %s\n", $insn->index(), $insn->address(), $encoding, $name, $args; 241 | } 242 | 243 | } 244 | 245 | sub generateBinary { 246 | my ($self) = @_; 247 | my ( $memory, $bytecode ) = ( $self->{memory}, $self->{bytecode} ); 248 | my $program = $STREAM_WRITER_CLASS->new( $self->{endian} ); 249 | 250 | $program->write32($Parse::Easy::Version::Major); 251 | $program->write32($Parse::Easy::Version::Minor); 252 | $program->write32( $memory->size() ); 253 | $program->write32( $bytecode->size() ); 254 | $program->write32( scalar @{ $self->{lexer}->{rules} } ); 255 | $program->write32( $self->{ruleinfo} ); 256 | $program->writeBytes( $memory->bytes() ); 257 | $program->writeBytes( $bytecode->bytes() ); 258 | my @bytes = $program->bytes(); 259 | my $file = $self->{lexer}->{binfile}; 260 | open my $fh, '>:raw', $file; 261 | print $fh pack "C", $_ foreach (@bytes); 262 | close $fh; 263 | } 264 | 265 | 266 | sub outputRules { 267 | my ($self) = @_; 268 | my $lexer = $self->{lexer}; 269 | my $memory = $self->{memory}; 270 | my $pos = $memory->pos(); 271 | for my $i ( 0 .. @{ $lexer->{rules} } - 1 ) { 272 | my $rule = $lexer->{rules}->[$i]; 273 | my $name = $rule->name; 274 | my $index = $rule->index; 275 | $i == $index or die "invalid index."; 276 | my $id = $rule->id; 277 | my $actionIndex = -1; 278 | $rule->{action} and $actionIndex = $rule->{action}->index(); 279 | $memory->writeInteger( $id, 4, 1 ); 280 | $memory->writeInteger( $actionIndex, 4, 1 ); 281 | } 282 | $self->{ruleinfo} = $pos; 283 | } 284 | 285 | sub compile { 286 | my ($self) = @_; 287 | my $lexer = $self->{lexer}; 288 | printf " - initializing vm instructions...\n"; 289 | $self->newInsn( 'vmstart', [], 1 ); 290 | my $s0 = $self->newInsn( 'label', [], 0 ); 291 | $self->newInsn( 'call', [$s0], 1 ); 292 | $self->newInsn( 'vmend', [], 1 ); 293 | $self->addInsn($s0); 294 | printf " - compiling vm states...\n"; 295 | $self->compileState($_) foreach ( @{ $lexer->{states} } ); 296 | printf " - translating instructions...\n"; 297 | $self->translate(); 298 | printf " - outputing rules data...\n"; 299 | $self->outputRules(); 300 | printf " - generating binary file...\n"; 301 | $self->generateBinary(); 302 | printf " - generating resource file...\n"; 303 | generateRes($lexer->{name},$lexer->{rcfile},$lexer->{resfile}, $lexer->{binfile}); 304 | } 305 | 306 | 1; 307 | -------------------------------------------------------------------------------- /lib/Parse/Easy/Parse/Lexer.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | #BEGIN_HEADER 4 | # 5 | # Module Parse/Easy/Parse/Lexer.pl Copyright (C) 2018-2019 Mahdi Safsafi. 6 | # 7 | # https://github.com/MahdiSafsafi/Parse-Easy 8 | # 9 | # See licence file 'LICENCE' for use and distribution rights. 10 | # 11 | #END_HEADER 12 | 13 | use strict; 14 | use warnings; 15 | use Data::Dump qw/pp/; 16 | use feature qw/say/; 17 | use Carp; 18 | use Readonly; 19 | use Parse::Easy::Parse::RangeLexer; 20 | use Parse::Easy::Parse::RangeParser; 21 | use Parse::Easy::Literal; 22 | use Parse::Easy::Code; 23 | use Parse::Easy::Wildcard; 24 | use Unicode::UCD qw/casefold charinfo casespec/; 25 | use Set::IntSpan; 26 | 27 | Readonly my $SECTION_DEFAULT => 0; 28 | Readonly my $SECTION_USE => 1; 29 | 30 | Readonly my $ERROR_LITERAL_EXPLICIT_NEWLINE => "literal can't have explicit newline."; 31 | Readonly my $ERROR_LITERAL_EMPTY => "literal can't be empty."; 32 | Readonly my $ERROR_INVALID_UNICODE_CODEPOINT => "invalid unicode codepoint."; 33 | Readonly my $FERROR_CHAR_SURPRISE => "char '%s' came to me as a complete surprise."; 34 | 35 | # ----------------------- helper for parser ----------------------- 36 | sub curpos { 37 | 38 | # return current pos of input. 39 | pos( ${ $_[0]->YYInput } ); 40 | } 41 | 42 | sub skipLine { 43 | 44 | # skip line and remember cursor position 45 | # this position can be used later to determine column. 46 | my ($parser) = @_; 47 | $parser->line( $parser->line + 1 ); 48 | $parser->YYData->{linepos} = curpos($parser); 49 | } 50 | 51 | sub column { 52 | 53 | # return column position based on linepos. 54 | # column is relative to linepos. 55 | curpos( $_[0] ) - $_[0]->YYData->{linepos}; 56 | } 57 | 58 | # --------------------------------------------------------------------- 59 | 60 | sub DQLITERAL { 61 | 62 | # single quoted literal. 63 | my ($parser) = @_; 64 | my @codepoints = (); 65 | my $flags = 0; 66 | use constant F_CASE_INSENSITIVE => 1; 67 | my @stack = (); 68 | my $addcp = sub { 69 | my ($codepoint) = @_; 70 | my $set = Set::IntSpan->new($codepoint); 71 | if ( $flags & F_CASE_INSENSITIVE ) { 72 | my $casefold = casefold($codepoint); 73 | $casefold or die $codepoint; 74 | $set->U( $casefold->{simple} ); 75 | } 76 | push @codepoints, $set; 77 | }; 78 | 79 | my $valid = 0; 80 | my $lastChar = ''; 81 | my %escape = ( 82 | 'n' => ord "\n", 83 | 't' => ord "\t", 84 | 'r' => ord "\r", 85 | '"' => ord '"', 86 | '\\' => ord '\\', 87 | ); 88 | for ( ${ $parser->YYInput } ) { 89 | while (/\G(.)/gc) { 90 | my $char = $lastChar = $1; 91 | $char eq '"' && ++$valid and last; 92 | if ( $char eq '\\' ) { 93 | /\G(.)/gc or last; 94 | my $next = $lastChar = $1; 95 | $next eq 'u' && ( /\G([a-fA-F0-9]{4})/gc || /\G({[a-fA-F0-9]{1,4}})/gc or __ERROR( $parser, $ERROR_INVALID_UNICODE_CODEPOINT ) ) 96 | and $addcp->( oct "0x$1" ) 97 | and next; 98 | exists $escape{$next} and $addcp->( $escape{$next} ) and next; 99 | uselessEscape( $parser, $next ); 100 | $addcp->( ord $next ); 101 | next; 102 | } 103 | $addcp->( ord $char ); 104 | } 105 | } 106 | $valid or __EXPECT( $parser, ['"'], $lastChar, $lastChar ); 107 | @codepoints or __ERROR( $parser, $ERROR_LITERAL_EMPTY ); 108 | my $literal = Parse::Easy::Literal->new( \@codepoints ); 109 | return ( 'DQ_LITERAL', $literal ); 110 | } 111 | 112 | sub SQLITERAL { 113 | 114 | # single quoted literal. 115 | my ($parser) = @_; 116 | my $valid = 0; 117 | my $lastChar = ''; 118 | my @codepoints = (); 119 | 120 | my $addcp = sub { 121 | my ($codepoint) = @_; 122 | my $set = Set::IntSpan->new($codepoint); 123 | push @codepoints, $set; 124 | }; 125 | 126 | for ( ${ $parser->YYInput } ) { 127 | while (/\G(.)/gc) { 128 | my $char = $lastChar = $1; 129 | $char eq "'" and ++$valid and last; 130 | if ( $char eq '\\' && /\G(')/gc ) { 131 | $addcp->( ord $1 ); 132 | next; 133 | } 134 | $addcp->( ord $char ); 135 | } 136 | } 137 | $valid or __EXPECT( $parser, ['\''], $lastChar, $lastChar ); 138 | @codepoints or __ERROR( $parser, $ERROR_LITERAL_EMPTY ); 139 | my $literal = Parse::Easy::Literal->new( \@codepoints ); 140 | return ( 'SQ_LITERAL', $literal ); 141 | } 142 | 143 | sub ACTION { 144 | my ($parser) = @_; 145 | return PascalCode($parser); 146 | } 147 | 148 | sub PascalCode { 149 | my ($parser) = @_; 150 | ${ $parser->YYInput } =~ m< 151 | \G( 152 | \{ 153 | ( 154 | ( 155 | # skip comments (* *): 156 | \(\* ( [^\*]* | \* [^\)\*]* )* \*\) 157 | # skip comments {}: 158 | | \{ [^\}]* \} 159 | # skip comments // : 160 | | \/\/ [^\n]* 161 | # skip literal: 162 | | \' ( [^\n\'] | \'\' )* \' 163 | # skip any char that is not in ['{', '/', '(', "'"]: 164 | | [^\{\'\/\(]* 165 | # char is either '(' or '/': 166 | | ( 167 | # skip it if it's not a comment opening '(*' or '(}' 168 | \( [^\*\}]? 169 | # skip it if it's not '//' or '/}' 170 | | \/ [^\/\}]? 171 | ) 172 | )* 173 | ) 174 | \} 175 | ) 176 | >xsgc or __ERROR( $parser, 'Unable to read action' ); 177 | return ( 'ACTION', Parse::Easy::Code->new($2) ); 178 | } 179 | 180 | sub RANGE { 181 | my ($parser) = @_; 182 | my $lexer = Parse::Easy::Parse::RangeLexer->new($parser); 183 | $lexer->{ERROR} = \&__ERROR; 184 | $lexer->{EXPECT} = \&__EXPECT; 185 | my $rangeParser = Parse::Easy::Parse::RangeParser->new($lexer); 186 | my $ast = $rangeParser->parse(); 187 | ( 'RANGE', $ast ); 188 | } 189 | 190 | sub __PARSE { 191 | my ($parser) = @_; 192 | unless ( $parser->YYData->{init}++ ) { 193 | $parser->YYData->{linepos}++; 194 | $parser->YYData->{lastToken} = ''; 195 | $parser->YYData->{qwclose} = ''; 196 | pushSection( $parser, $SECTION_DEFAULT ); 197 | } 198 | my $lastToken = $parser->YYData->{lastToken}; 199 | my $section = section($parser); 200 | for ( ${ $parser->YYInput } ) { 201 | my $n = 0; 202 | m{ 203 | \G( 204 | ( 205 | \h # any white space. 206 | | \/\/(.*) # comments. 207 | | \n (?{$n++}) # newline. 208 | )+ 209 | ) 210 | }xgc; 211 | skipLine($parser) while ( $n-- ); 212 | 213 | /\G(\()/gc and return ( 'LPAREN', $1 ); 214 | /\G(\))/gc and return ( 'RPAREN', $1 ); 215 | 216 | /\G(\.)/gc and return ( 'DOT', $1 ); 217 | /\G(\|)/gc and return ( 'BAR', $1 ); 218 | /\G(\::)/gc and return ( 'COLONCOLON', $1 ); 219 | /\G(\:)/gc and return ( 'COLON', $1 ); 220 | /\G(\,)/gc and return ( 'COMMA', $1 ); 221 | /\G(\;)/gc and return ( 'SEMICOLON', $1 ); 222 | /\G(\-)/gc and return ( 'MINUS', $1 ); 223 | /\G(\+)/gc and return ( 'PLUS', $1 ); 224 | /\G(\*)/gc and return ( 'STAR', $1 ); 225 | /\G(\?)/gc and return ( 'QUESTION', $1 ); 226 | /\G(\^)/gc and return ( 'CIRCUMFLEX', $1 ); 227 | /\G(\$)/gc and return ( 'DOLLAR', $1 ); 228 | /\G(\<)/gc and return ( 'LT', $1 ); 229 | /\G(\>)/gc and return ( 'GT', $1 ); 230 | /\G(\/)/gc and return ( 'SLASH', $1 ); 231 | 232 | # Literal: 233 | if ( $section == $SECTION_USE ) { 234 | /\G('(.*?)')/gc and return ( 'SQRAWSTR', $2 ); 235 | /\G("(.*?)")/gc and return ( 'DQRAWSTR', $2 ); 236 | } 237 | m/\G(')/gc and return SQLITERAL($parser); 238 | /\G(")/gc and return DQLITERAL($parser); 239 | 240 | # 241 | /\G(\{)/ and return ACTION($parser); 242 | /\G(\[)/ and return RANGE($parser); 243 | 244 | # reserved keywords: 245 | /\G(grammar)\b/gc and return ( 'GRAMMAR', $1 ); 246 | /\G(fragment)\b/gc and return ( 'FRAGMENT', $1 ); 247 | /\G(section)\b/gc and return ( 'SECTION', $1 ); 248 | /\G(use)\b/gc and return ( 'USE', $1 ); 249 | /\G(qw)\b/gc and return ( 'QW', $1 ); 250 | /\G(as)\b/gc and return ( 'AS', $1 ); 251 | 252 | if ( $lastToken eq 'USE' ) { 253 | /\G([a-z_A-Z0-9:]+)/gc; 254 | return ( 'PACKAGE_NAME', $1 ); 255 | } 256 | m/\G([a-z][a-z_A-Z0-9]*)/gc and return ( 'NOTERM', $1 ); 257 | /\G([A-Z][a-z_A-Z0-9]*)/gc and return ( 'TERM', $1 ); 258 | /\G(_+[a-zA-Z0-9]+)/gc and return ( 'UNDERSCORE', $1 ); 259 | /\G(.)/gc and return ( $1, $1 ); 260 | return ( '', undef ); 261 | } 262 | } 263 | 264 | sub section { $_[0]->YYData->{sections}->[-1] } 265 | sub pushSection { push @{ $_[0]->YYData->{sections} }, $_[1] } 266 | sub popSection { pop @{ $_[0]->YYData->{sections} } } 267 | 268 | sub __LEXER { 269 | my ($parser) = @_; 270 | my @result = __PARSE($parser); 271 | my $token = $result[0]; 272 | my %qwpair = ( 273 | LPAREN => 'RPAREN', 274 | SLASH => 'SLASH', 275 | LT => 'GT', 276 | ); 277 | if ( $token eq 'USE' ) { 278 | pushSection( $parser, $SECTION_USE ); 279 | } 280 | elsif ( $token eq 'SEMICOLON' ) { 281 | my $section = section($parser); 282 | $section == $SECTION_USE and popSection($parser); 283 | } 284 | if ( $token ne '' && $parser->YYData->{qwclose} eq $token ) { 285 | $result[0] = 'QWCLOSE'; 286 | $parser->YYData->{qwclose} = ''; 287 | } 288 | if ( $parser->YYData->{lastToken} eq 'QW' && exists $qwpair{$token} ) { 289 | $parser->YYData->{qwclose} = $qwpair{$token}; 290 | } 291 | $parser->YYData->{lastToken} = $token; 292 | @result; 293 | } 294 | 295 | sub __ERROR { 296 | my ( $self, $msg ) = @_; 297 | my ( $line, $column ) = ( $self->line, column($self) ); 298 | die sprintf "error in file '%s' line %d column %d: %s", #filename.line.column:msg 299 | $self->YYFilename(), $line, $column, $msg; 300 | } 301 | 302 | sub uselessEscape { 303 | my ( $self, $char ) = @_; 304 | my ( $line, $column ) = ( $self->line, column($self) ); 305 | warn sprintf <<'EOW' 306 | warn in file '%s' line %d column %d: 307 | useless escape character '\%s'. I will assume that you mean character '%s'. 308 | note that using unrecognized escaped character may break your parser for future releases. 309 | EOW 310 | , $self->YYFilename(), $line, $column, $char, $char; 311 | } 312 | 313 | sub __EXPECT { 314 | my ($self) = shift; 315 | my @expect = (); 316 | my ( $expect, $curtok, $curval ) = @_; 317 | @expect = $expect ? @$expect : $self->YYExpect(); 318 | $curtok = $curtok // $self->YYCurtok() // 'EOF'; 319 | $curval = $curval // $self->YYCurval() // 'EOF'; 320 | $expect = join( ', ', @expect ); 321 | my ( $line, $column ) = ( $self->line, column($self) ); 322 | 323 | die sprintf <<'EOE' 324 | error in file '%s' line %d column %d: 325 | near terminal %s '%s'. 326 | expecting one of the following terminal [%s]. 327 | EOE 328 | , $self->YYFilename(), $line, $column, # filename.line.column 329 | $curtok, $curval, $expect; 330 | } 331 | 332 | 1; 333 | --------------------------------------------------------------------------------