program calculator;
{
    Copyright (c) 2012 Christopher Winward

    Licensed under the Apache License, Version 2.0 (the "License"); you may not
    use this file except in compliance with the License, as described at
    http://www.apache.org/licenses/ and http://www.pp4s.co.uk/licenses/
}
{$mode objfpc}{$H+}
{$Apptype Console}
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,  math, sysUtils;

type
  tTokenNames = (TOKEN_NONE, TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
                 TOKEN_LBRACK, TOKEN_RBRACK, TOKEN_POWER, TOKEN_NUMBER, TOKEN_END, TOKEN_INVALID);
  tToken = class
  public
    eType : tTokenNames; //The eType describes the token type, such as TOKEN_ADD or TOKEN_NUMBER
    eValue : double; //The numerical value of the token, only used if eType is TOKEN_NUMBER
    constructor Create(xType : tTokenNames; xValue : double = 0);
  end;
  tTokenList = class(tList) //We're just expanding upon the tList class to add our own methods.
  public                       //A tList is like an advanced array of pointers
    //Returns a typecasted object -> tToken from the list at a given position
    function at(position : integer) : tToken;

    //Returns the last tToken in the list
    function getLast : tToken;

    function getSecondLast : tToken;
    function getFirst : tToken;

    //Removes the last tToken from the list, and returns it
    function popData : tToken;

    //Returns FALSE if a TOKEN_INVALID is found anywhere in it, otherwise TRUE
    function isValid : boolean;

    //Print all the data in the list straight out to the console
    procedure dumpData;
  end;

constructor tToken.Create(xType : tTokenNames; xValue : double = 0);
begin
  eType := xType;
  eValue := xValue;
end;

function tTokenList.at(position : integer) : tToken;
begin
  //Typecast a pointer to a tToken pointer and return it
  exit(tToken(self.Get(position)));
end;

function tTokenList.getLast : tToken;
begin
  exit(tToken(self.last));
end;

function tTokenList.getSecondLast : tToken;
begin
  exit(self.at(self.Count - 2));
end;

function tTokenList.getFirst : tToken;
begin
  exit(tToken(self.first));
end;

function tTokenList.isValid : boolean;
var
  tCount : integer;
begin
  for tCount := 0 to self.Count - 1 do
  //Simply check all the tokens and return false if any are TOKEN_INVALID
  begin
    if self.at(tCount).eType = TOKEN_INVALID then
      exit(false);
  end;
  exit(true);
end;

//Dump out the data in a tokenList, mostly for debugging purposes
procedure tTokenList.dumpData;
var
  i : integer;
begin
  for i:= 0 to self.count - 1 do
    begin
      writeln(i, ': ', self.at(i).eType,' ', self.at(i).eValue);
    end;
  writeln;
end;

function tTokenList.popData : tToken;
begin
  result := self.getLast;
  self.Remove(self.Last);
end;

//Look at a string, and convert it into a tTokenList of tTokens
function stringToTokens(inputString : string) : tTokenList;

  //We nest a few functions in here as they aren't needed elsewhere
  function checkStringNumber(inputString : string) : boolean;
  var
    charCount, decCount : integer;
  begin
    //Just check that we have a valid number with only one decimal place
    decCount := 0;
    for charCount := 1 to length(inputString) do
      begin
        if (inputString[charCount] = '.') then
          begin
            inc(decCount);
            if (decCount = 2) then //We've found a second decimal place, so it's not valid
              exit(false);
      end;
    end;
    exit(true);
  end;

  procedure exitFail;
  begin
    result.Add(tToken.Create(TOKEN_INVALID));
    result.Add(tToken.Create(TOKEN_END));
  end;

var
  charCount, tokenCount : integer;
  tempChar : char;
  strTempNumber : string = '';
  dblTempNumber : double;
  lBrackCount, rBrackCount : integer; //For counting left and right brackets
begin
  lBrackCount := 0;
  rBrackCount := 0;
  result := tTokenList.Create; //Create a new tTokenList and set the result to it.
  if (length(inputString) = 0) then
    exitFail; //If no input is entered, fail
  for charCount := 1 to length(inputString) do //Loop through all the characters in the string.
    begin
      tempChar := inputString[charCount];
      //Add the character to a temporary number string if it's a digit or decimal point.
      if tempChar in ['0' .. '9', '.'] then
        begin
          strTempNumber += tempChar;
        end
      else
        begin //If not a digit or .
          if length(strTempNumber) <> 0 then //If there is a number string to evaluate
            begin
              if checkStringNumber(strTempNumber) then //Check it's a valid number
                dblTempNumber := StrToFloat(strTempNumber)
              else
                begin
                  dblTempNumber := 0; //If not, exit fail
                  writeln('Could not convert number properly.');
                  exitFail;
                end;
              //Add the number to the token list
              result.Add(tToken.Create(TOKEN_NUMBER, dblTempNumber));
              strTempNumber := ''; //Clear the temporary number
            end;

          case tempChar of //If it's an operator, add it to the token list
            '+' : result.Add(tToken.Create(TOKEN_ADD));
            '-' : result.Add(tToken.Create(TOKEN_SUBTRACT));
            '*' : result.Add(tToken.Create(TOKEN_MULTIPLY));
            '/' : result.Add(tToken.Create(TOKEN_DIVIDE));
            '(' : begin
                    result.Add(tToken.Create(TOKEN_LBRACK));
                    inc(lBrackCount);
                  end;
            ')' : begin
                    result.Add(tToken.Create(TOKEN_RBRACK));
                    inc(rBrackCount);
                  end;
            '^' : result.Add(tToken.Create(TOKEN_POWER));
          else
            begin
              writeln('Invalid characters used in statement.');
              exitFail;
            end;
          end;
        end;
    end;
  if rBrackCount <> lBrackCount then //Unequal numbers of left and right brackets
    begin
      writeln('Mismatched brackets');
      exitFail;
    end;
  //Check the current temporary number string one last time.
  if length(strTempNumber) <> 0 then
    begin
      if checkStringNumber(strTempNumber) then
        begin
          dblTempNumber := StrToFloat(strTempNumber);
          result.Add(tToken.Create(TOKEN_NUMBER,dblTempNumber));
        end
      else
        begin
          dblTempNumber := 0;
          writeln('Could not convert number properly.');
          exitFail;
        end;
    end;

  //Now run a syntax analysis to check that it's safe to run.
  if (result.getLast.eType <> TOKEN_NUMBER) and (result.getLast.eType <> TOKEN_RBRACK) then
    begin //The expression must end in a number or right bracket.
      exitFail;
    end;
  if (result.getFirst.eType <> TOKEN_NUMBER) and (result.getFirst.eType <> TOKEN_LBRACK) then
    begin //Check it starts with a number or left bracket.
      if (result.getFirst.eType = TOKEN_SUBTRACT) or (result.getFirst.eType = TOKEN_ADD) then
        begin
          //Add a 0 before any leading plus or minus signs.
          result.Insert(0, tToken.create(TOKEN_NUMBER, 0));
        end
      else
    begin
      writeln('Syntax error - calculation doesn''t start with a number.');
      exitFail;
    end;
  end;

  for tokenCount := 1 to result.Count - 1 do
    begin
      case result.at(tokenCount).eType of
        TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
        TOKEN_POWER :  begin
                         if not(result.Count = tokenCount) then
                           begin
                             if ((result.at(tokenCount - 1).eType <> TOKEN_NUMBER) and
                                (result.at(tokenCount - 1).eType <> TOKEN_RBRACK))
                                or
                                ((result.at(tokenCount + 1).eType <> TOKEN_NUMBER) and
                                (result.at(tokenCount + 1).eType <> TOKEN_LBRACK)) then
                                //Check that operators have numbers or appropriate brackets around them
                               begin
                                 if result.at(tokenCount-1).eType <> TOKEN_NUMBER then
                                   begin
                                     //Add a leading zero before + and -
                                     result.insert(tokenCount,tToken.create(TOKEN_NUMBER, 0));
                                   end
                                 else
                                   begin
                                     writeln('Bad tokens around ADD, SUBTRACT, MULTIPLY, DIVIDE or POWER sign');
                                     exitFail;
                                   end;
                               end;
                           end
                         else
                           begin
                             writeln('Ends with a binary operator.');
                             exitFail;
                           end;
                       end;
        TOKEN_LBRACK : begin
                       {Check that after a left bracket there is a number,
                       another left bracket, or a right bracket}
                         if (result.at(tokenCount+1).eType <> TOKEN_NUMBER) and
                            (result.at(tokenCount+1).eType <> TOKEN_LBRACK) and
                            (result.at(tokenCount+1).eType <> TOKEN_RBRACK) then
                           exitFail;
                       end;
      end;
    end;
  result.Add(tToken.Create(TOKEN_END));
end;

function convertInfixToPostfix(inputList : tTokenList) : tTokenList;
{This is an implementation of the Shunting-yard algorithm that makes use of stacks to convert
infix equations into postfix. As Pascal does not have a built in stack, I just used a modified
tList to act in a similar manner.
http://en.wikipedia.org/wiki/Shunting-yard_algorithm gives a good overview of the algorithm.
I haven't commented this function as it doesn't deviate away from the algorithm much if at all,
and I will assume you have read the Wikipedia article explaining it.}
var
  tempToken : tToken;
  outputTokenList : tTokenList;
  temporaryStack : tTokenList;
  tokenCount : integer;
begin
  outputTokenList := tTokenList.create;
  temporaryStack := tTokenList.create;
  temporaryStack.add(tToken.create(TOKEN_END));
  for tokenCount := 0 to inputList.count - 1 do
    begin
      tempToken := inputList.at(tokenCount);
      case tempToken.eType of
        //These don't need any special cases, they go straight to the output.
        TOKEN_NUMBER :   outputTokenList.Add(tempToken);

        TOKEN_ADD,
        TOKEN_SUBTRACT : begin
                           if outputTokenList.Count = 0 then
                             outputTokenList.Add(tToken.create(TOKEN_NUMBER, 0));
                           while true do
                             begin
                               case temporaryStack.getLast.eType of
                                 TOKEN_ADD, TOKEN_SUBTRACT, TOKEN_MULTIPLY, TOKEN_DIVIDE,
                                 TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                               else
                                 break;
                               end;
                             end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_MULTIPLY,
        TOKEN_DIVIDE :   begin
                           case temporaryStack.getLast.eType of
                             TOKEN_MULTIPLY, TOKEN_DIVIDE,
                             TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                           end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_POWER :    begin
                           if outputTokenList.Count = 0 then
                             outputTokenList.Add(tToken.create(TOKEN_NUMBER,0));
                           while true do
                             begin
                               case temporaryStack.getLast.eType of
                                 TOKEN_POWER : outputTokenList.Add(temporaryStack.popData);
                               else
                                 break;
                               end;
                             end;
                           temporaryStack.add(tempToken);
                         end;
        TOKEN_LBRACK :   temporaryStack.Add(tempToken);
        TOKEN_RBRACK :   begin
                           while temporaryStack.getLast.eType <> TOKEN_LBRACK do
                             outputTokenList.add(temporaryStack.popData);
                           temporaryStack.popData;
                         end;
        TOKEN_END :      while temporaryStack.Count <> 0 do
                           outputTokenList.add(temporaryStack.popData);
      end;
    end;
  exit(outputTokenList);
end;

//Just push the tokens onto a stack, evaluating the operands when they appear.
function evaluateRPN(inputList : tTokenList) : double;
var
  tempToken : tToken;
  stack : tTokenList; //A temporary stack for holding values to use operators on later
  tokenCount : integer;
  tempDouble : double;
begin
  stack := tTokenList.Create;
  for tokenCount := 0 to inputList.Count - 1 do
    begin
      tempToken := inputList.at(tokenCount);
      case tempToken.eType of
        TOKEN_NUMBER :   stack.Add(tempToken);
                         //Add the top two values on the stack together.
        TOKEN_ADD :      stack.getSecondLast.eValue += stack.popData.eValue;
        TOKEN_SUBTRACT : stack.getSecondLast.eValue -= stack.popData.eValue;
        TOKEN_MULTIPLY : stack.getSecondLast.eValue *= stack.popData.eValue;
        TOKEN_DIVIDE :   stack.getSecondLast.eValue /= stack.popData.eValue;
        TOKEN_POWER :    //Raise the second last value to the power of the last value on the stack.
                         begin
                           tempDouble := stack.getSecondLast.eValue ** stack.getLast.eValue;
                           stack.popData; //Use a temporary variable so we can pop the data.
                           stack.getLast.eValue := tempDouble;
                         end;
      end;
    end;
  if (stack.Count <> 1) then
    writeln('Could not properly evaluate statement. The following result is unreliable.');
  exit(stack.at(0).eValue);
end;

var
  inputString : string;
  tokensToEvaluate, postfixTokens : tTokenList;
begin
  tokensToEvaluate := tTokenList.create;
  writeln('Please enter a standard calculation.');
  while true do
    begin
      write('>>> ');
      readln(inputString);
      if (inputString = 'exit') then
        break;
      tokensToEvaluate := stringToTokens(inputString);
      if tokensToEvaluate.isValid then //Check the strings uses valid tokens.
        begin
          postfixTokens := convertInfixToPostfix(tokensToEvaluate);
          if (postfixTokens.isValid) then //Check that after conversion, it is still valid.
            writeln(floatToStr(evaluateRPN(postfixTokens)))
          else
            writeln('Syntax error.');
        end
      else
        begin
          writeln('Syntax error.');
        end;
    end;
end.