ASParser.pas

unit ASParser;

{ **************************************************************************** }
{ Rejbrand AlgoSim Parser                                                      }
{ Copyright © 2019 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}
{$M 16384,2097152}

interface

uses
  SysUtils, Types, Classes, Generics.Defaults, Generics.Collections,
  ASKernelDefs, ASTree, ASExpression, ASObjects, ASTokenizer;

type
  // Correct but with scary time complexity. Good enough for now.
  TParser = record
  strict private
  type
    TOpPrec = record
      Index: Integer;
      Precedence: TPrecGroup;
      constructor Create(AIndex: Integer; const APrecedence: TPrecGroup);
    end;
    TOpPrecList = TList<TOpPrec>;
  var
    Tokens: TList<TToken>;
    Expression: TASExpression;
    procedure ParsePart(AFirstToken, ALastToken: Integer;
      AParentNode: TASExprNode; ARecLevel: Integer);
    function AddNode(AParentNode: TASExprNode;
      AExprNodeClass: TASExprNodeClass; ATag: Integer = 0): TASExprNode; overload;
    function AddNode(AParentNode: TASExprNode;
      ALiteral: TAlgosimObject): TASExprNode; overload;
    function AddNode(AParentNode: TASExprNode;
      const ASymbol: string): TASExprNode; overload;
  public
    class function Parse(ATokens: TList<TToken>): TASExpression; static;
  end;

implementation

uses
  ASFcnMgr, ASFunctions;

{ TParser }

function TParser.AddNode(AParentNode: TASExprNode;
  AExprNodeClass: TASExprNodeClass; ATag: Integer): TASExprNode;
begin
  if Assigned(AParentNode) then
    Result := AParentNode.AddChild(AExprNodeClass)
  else if Expression = nil then
  begin
    Expression := TASExpression.Create(AExprNodeClass);
    Result := Expression.Root;
  end
  else
    raise EParseException.Create('TParser.AddNode: Parent node not specified.');
  Result.Tag := ATag;
end;

function TParser.AddNode(AParentNode: TASExprNode; ALiteral: TAlgosimObject): TASExprNode;
begin
  if Assigned(AParentNode) then
    Result := AParentNode.AddChild(ALiteral)
  else if Expression = nil then
  begin
    Expression := TASExpression.Create(ALiteral);
    Result := Expression.Root;
  end
  else
  begin
    ALiteral.Free;
    raise EParseException.Create('TParser.AddNode: Parent node not specified.');
  end;
end;

function TParser.AddNode(AParentNode: TASExprNode; const ASymbol: string): TASExprNode;
begin
  if Assigned(AParentNode) then
    Result := AParentNode.AddChild(ASymbol)
  else if Expression = nil then
  begin
    Expression := TASExpression.Create(ASymbol);
    Result := Expression.Root;
  end
  else
    raise EParseException.Create('TParser.AddNode: Parent node not specified.');
end;

class function TParser.Parse(ATokens: TList<TToken>): TASExpression;
var
  Parser: TParser;
begin

  Parser.Tokens := ATokens;
  Parser.Expression := nil;
  try
    Parser.ParsePart(0, ATokens.Count - 1, nil, 0);
  except
    Parser.Expression.Free;
    raise;
  end;
  Result := Parser.Expression;
  if Result = nil then
    raise EParseException.Create('No expression created.');

end;

procedure TParser.ParsePart(AFirstToken, ALastToken: Integer;
  AParentNode: TASExprNode; ARecLevel: Integer);
var
  i: Integer;
  OpPrecList: TOpPrecList;
  Token: TToken;
  Node: TASExprNode;
  FcnClass: TASFunctionClass;
begin

  if ARecLevel > MAX_RECURSE_DEPTH then
    raise EParseException.Create(SExpressionTooDeep);

  if AFirstToken > ALastToken then
    Exit;

  while Tokens[AFirstToken].IsLeftNoOpBracket and (Tokens[AFirstToken].Bracket.Partner = ALastToken) and (AFirstToken < ALastToken) do
  begin
    Assert(Tokens[ALastToken].Bracket.Partner = AFirstToken, 'The second bracket''s partner must be the first bracket.');
    Assert(Tokens[ALastToken].IsRightBracket, 'The second bracket must be closing.');
    Inc(AFirstToken);
    Dec(ALastToken);
  end;

  if AFirstToken > ALastToken then
    Exit;

  if Tokens[AFirstToken].IsLeftOpBracket and (Tokens[AFirstToken].Bracket.Partner = ALastToken) then
  begin
    Assert(Tokens[ALastToken].Bracket.Partner = AFirstToken, 'The second bracket''s partner must be the first bracket.');
    Assert(Tokens[ALastToken].IsRightBracket, 'The second bracket must be closing.');
    case Tokens[AFirstToken].Bracket.ID of
      bCurly:
        Node := AddNode(AParentNode, FCN_Set);
      bVector:
        Node := AddNode(AParentNode, FCN_Vector);
      bFloor:
        Node := AddNode(AParentNode, FCN_Floor);
      bCeil:
        Node := AddNode(AParentNode, FCN_Ceil);
      bInterval:
        Node := AddNode(AParentNode, FCN_ClosedInterval);
    else
      raise EParseException.Create('Unknown circumfix operator.');
    end;
    ParsePart(AFirstToken + 1, ALastToken - 1, Node, Succ(ARecLevel));
    Exit;
  end;

  OpPrecList := TOpPrecList.Create(
    TComparer<TOpPrec>.Construct(
      function(const Left, Right: TOpPrec): Integer
      begin
        Result := Left.Precedence.Precedence - Right.Precedence.Precedence; {no risk of overflow}
        if Result = 0 then
          if Left.Precedence.Associativity = osLeft then
            Result := Left.Index - Right.Index {no risk of overflow}
          else
            Result := Right.Index - Left.Index; {no risk of overflow}
      end
    )
  );
  try

    i := AFirstToken;
    while i <= ALastToken do
    begin
      case Tokens[i].Kind of
        tkIntegerLiteral: ;
        tkFloatLiteral: ;
        tkStringLiteral: ;
        tkOperator:
          OpPrecList.Add(TOpPrec.Create(i, Tokens[i].Precedence));
        tkBracket:
          begin
            if Tokens[i].Bracket.Applying then
              OpPrecList.Add(TOpPrec.Create(i, Tokens[i].Precedence));
            if Tokens[i].Bracket.Opening then
            begin
              i := Tokens[i].Bracket.Partner + 1;
              Continue;
            end;
          end;
        tkComma:
          OpPrecList.Add(TOpPrec.Create(i, Tokens[i].Precedence));
        tkIdentifier: ;
        tkImplicitNull: ;
      else
        raise EParseException.Create('TParser.ParsePart: Unknown token kind.');
      end;
      Inc(i);
    end;

    if OpPrecList.Count > 0 then
    begin
      OpPrecList.Sort;
      Token := Tokens[OpPrecList.Last.Index];
      case Token.Kind of
        tkOperator:
          begin
            if Token.&Operator.Collapse and Assigned(AParentNode) and (Token.&Operator.&Function = AParentNode.ClassType) and (Token.BracketID = AParentNode.Tag) then
              Node := AParentNode
            else
              Node := AddNode(AParentNode, Token.&Operator.&Function, Token.BracketID);
            case Token.&Operator.Kind of
              okPrefix:
                begin
                  if OpPrecList.Last.Index + 1 > ALastToken then
                    raise EParseException.Create('TParser.ParsePart: Operand missing (prefix operator).');
                  ParsePart(OpPrecList.Last.Index + 1, ALastToken, Node, Succ(ARecLevel));
                end;
              okPostfix:
                begin
                  if AFirstToken > OpPrecList.Last.Index - 1 then
                    raise EParseException.Create('TParser.ParsePart: Operand missing (postfix operator).');
                  ParsePart(AFirstToken, OpPrecList.Last.Index - 1, Node, Succ(ARecLevel));
                end;
              okInfix:
                begin
                  if AFirstToken > OpPrecList.Last.Index - 1 then
                    raise EParseException.Create('TParser.ParsePart: Left operand missing.');
                  if OpPrecList.Last.Index + 1 > ALastToken then
                    raise EParseException.Create('TParser.ParsePart: Right operand missing.');
                  if Token.&Operator.ListLeft then
                    ParsePart(AFirstToken, OpPrecList.Last.Index - 1,
                      AddNode(Node, TASListExprNode), Succ(ARecLevel)
                    )
                  else
                    ParsePart(AFirstToken, OpPrecList.Last.Index - 1, Node, Succ(ARecLevel));
                  if Token.&Operator.ListRight then
                    ParsePart(OpPrecList.Last.Index + 1, ALastToken,
                      AddNode(Node, TASListExprNode), Succ(ARecLevel)
                    )
                  else
                    ParsePart(OpPrecList.Last.Index + 1, ALastToken, Node, Succ(ARecLevel));
                end;
            end;
          end;
        tkBracket:
          begin
            Assert(Token.Bracket.Applying, 'Bracket with precedence handling must be applying.');
            case Token.Bracket.ID of
              bRound:
                begin
                  if
                    (OpPrecList.Last.Index = AFirstToken + 1) and
                    (Tokens[AFirstToken].Kind = tkIdentifier) and
                    TFunctionMgr.Functions.TryGetValue(Tokens[AFirstToken].Identifier, FcnClass)
                  then
                  begin
                    Node := AddNode(AParentNode, FcnClass);
                    ParsePart(OpPrecList.Last.Index, ALastToken, Node, Succ(ARecLevel));
                  end
                  else
                  begin
                    Node := AddNode(AParentNode, FCN_Image);
                    ParsePart(AFirstToken, OpPrecList.Last.Index - 1, Node, Succ(ARecLevel));
                    ParsePart(OpPrecList.Last.Index, ALastToken, Node, Succ(ARecLevel));
                  end;
                end;
              bCurly: ;
              bSquare:
                begin
                  Node := AddNode(AParentNode, FCN_Subscript);
                  ParsePart(AFirstToken, OpPrecList.Last.Index - 1, Node, Succ(ARecLevel));
                  ParsePart(OpPrecList.Last.Index, ALastToken, Node, Succ(ARecLevel));
                end;
              bVector: ;
              bFloor: ;
              bCeil: ;
            end;
          end;
        tkComma:
          begin
            ParsePart(AFirstToken, OpPrecList.Last.Index - 1, AParentNode, Succ(ARecLevel));
            ParsePart(OpPrecList.Last.Index + 1, ALastToken, AParentNode, Succ(ARecLevel));
          end;
      end;
    end

    else if AFirstToken = ALastToken then
    begin
      Token := Tokens[AFirstToken];
      case Token.Kind of
        tkIntegerLiteral:
          AddNode(AParentNode, ASOInt(Token.Literal.Integer));
        tkFloatLiteral:
          AddNode(AParentNode, ASO(Token.Literal.Float));
        tkStringLiteral:
          AddNode(AParentNode, ASO(Token.Literal.&String));
        tkIdentifier:
          AddNode(AParentNode, Token.Identifier);
        tkImplicitNull:
          AddNode(AParentNode, ASO(null));
      end;
    end;

  finally
    OpPrecList.Free;
  end;

end;

{ TParser.TOpPrec }

constructor TParser.TOpPrec.Create(AIndex: Integer; const APrecedence: TPrecGroup);
begin
  Index := AIndex;
  Precedence := APrecedence;
end;

end.