Calculator in Nimrod with RDP

pcalc.nim

#pCalc - Nimrod version7
import strutils, math, tables, logging
type
  EProgramError = object of E_Base
  EStackError = object of EProgramError
  EStackUnderflowError = object of EStackError
  ESyntaxError = object of EProgramError
  ERuntimeError = object of EProgramError
  EDivisionByZeroError = object of ERuntimeError
  TSymbol = enum
    sNone, sSymbol, sNumber, sVariable, sAdd, sSub, sMul, sDiv, sMod,
    sPow, sLeftParen, sRightParen, sAssign, sComma, sSemicolon
  TToken = tuple[
    symbol: TSymbol,
    index_start: int,
    index_end: int]
  TCharSet = set[char]
  TVersionPhase = enum
    versionPreAlpha, versionAlpha, versionBeta, versionReleaseCandidate
  TVersion = tuple[
    major, minor, release: int,
    phase: TVersionPhase]
  TNumber = distinct float64
const
  Debugging: bool = false
  Testing: bool = true
  ProgramName: string = "pCalc"
  ProgramVersion: TVersion = (0, 4, 13, versionAlpha)
  NilToken: TToken = (symbol: sNone, index_start: -1, index_end: -1)
  alpha_set: TCharSet =
    {'a'..'z', 'A'..'Z', '_'}
  numbers_set: TCharSet =
    {'0'..'9', '.'}
  symbols_set: TCharSet =
    {'+', '-', '*', '/', '%', '^', '(', ')', '=', ',', ';'}
var
  Logger = newConsoleLogger(lvlDebug)
  interpreter_running: bool = true
  string_buffer: string
  parser_index: int
  token_stream: seq[TToken] = @[]
  prev_token, token: TToken
  variables: TTable[string, Tnumber] = initTable[string, TNumber]()
  stack: seq[TNumber] = @[]

proc `$`(self: TNumber): string =
  let value: float64 = self.float64
  if value == value.trunc():
    result = $value.toInt()
  else:
    result = $value

proc `+`(a, b: TNumber): TNumber = (a.float64 + b.float64).TNumber
proc `-`(a, b: TNumber): TNumber = (a.float64 - b.float64).TNumber
proc `-`(a: TNumber): TNumber = (-a.float64).TNumber
proc `*`(a, b: TNumber): TNumber = (a.float64 * b.float64).TNumber
proc `/`(a, b: TNumber): TNumber = (a.float64 / b.float64).TNumber
proc `mod`(a, b: TNumber): TNumber = (a.float64 mod b.float64).TNumber
proc `==`(a, b: TNumber): bool = a.float64 == b.float64
proc `==`(a: TNumber, b: float): bool = a.float64 == b.float64
proc `==`(a: TNumber, b: int): bool = a.float64 == b.float64

proc payload(token: TToken): string =
  result = string_buffer[token.index_start..token.index_end]

proc `$`(token: TToken): string =
  result = "<'"
  result.add(token.payload())
  result.add("'@(")
  result.add($token.index_start)
  result.add(":")
  result.add($token.index_end)
  result.add(")-")
  result.add($token.symbol)
  result.add(">")

proc `$`(phase: TVersionPhase): string =
  case phase
  of versionPreAlpha: "-pre-alpha"
  of versionAlpha: "-alpha"
  of versionBeta: "-beta"
  else: ""

proc `$`(version: TVersion): string =
  result = $version.major & "." &
           $version.minor & "." &
           $version.release &
           $version.phase

proc prompt(): string =
  write(stdout, ">>> ")
  result = stdin.readline().strip()

proc tokenize(buffer: string): seq[TToken] =
  type
    TState = enum
      stateDefault, stateSymbol, stateNumber, stateAlpha
  var
    token: TToken
    state: TState
    current: char
    index: int = 0
  result = @[]
  if buffer.len == 0:
    return
  while(index < buffer.len):
    current = buffer[index]
    #echo(index, " ", state)
    case state
    of stateDefault:
      if token.symbol != sNone:
        #echo("NotNONE")
        #token.payload = buffer[token.index_start .. token.index_end]
        when Debugging:
          debug($token)
        result.add(token)
        token = (sNone, -1, -1)
        inc(index)
      elif current in alpha_set:
        state = stateAlpha
      elif current in numbers_set:
        state = stateNumber
      elif current in symbols_set:
        state = stateSymbol
      elif current == ' ':
        inc(index)
      else:
        raise newException(ESyntaxError, "Unknown symbol '$1'.{$2}" % [$current, $(index + 1)])
        # This should throw an exception, too - as in,
        #  what the hell am I getting here? Slow down
        #  with all those sigils, buddy, before someone
        #  gets hurt.
    of stateSymbol:
      token.symbol =
        case current
        of '+': sAdd
        of '-': sSub
        of '*': sMul
        of '/': sDiv
        of '%': sMod
        of '^': sPow
        of '(': sLeftParen
        of ')': sRightParen
        of '=': sAssign
        of ',': sComma
        of ';': sSemicolon
        else: sSymbol
      token.index_start = index
      token.index_end = index # Yay for 1-character symbols!
                              # Seriously, though, I should extend this.
      state = stateDefault
    of stateNumber:
      token.symbol = sNumber
      token.index_start = index
      while(current in numbers_set):
        inc(index)
        current = buffer[index]
      dec(index)
      token.index_end = index
      state = stateDefault
    of stateAlpha:
      token.symbol = sVariable
      token.index_start = index
      while(current in alpha_set):
        inc(index)
        current = buffer[index]
      dec(index)
      token.index_end = index
      state = stateDefault

proc get_next_token() =
  prev_token = token
  if parser_index <= token_stream.high:
    token = token_stream[parser_index]
  else:
    token = NilToken
  inc(parser_index)
  when Debugging:
    debug("NEXTTOK " & $token)

proc backtrack(i: int) =
  parser_index = parser_index - (i + 1)
  #token = prev_token
  when false:
    if parser_index - 1 >= token_stream.low:
      prev_token = token_stream[parser_index - 1]
      when Debugging:
        debug("BACKTRACK PT: " & $prev_token)
  get_next_token()
  when Debugging:
    debug("BACKTRACK " & $token & " @ " & $parser_index)

proc accept(symbol: TSymbol): bool =
  if token.symbol == symbol:
    get_next_token()
    when Debugging:
      debug("ACCEPT " & $symbol)
    return true
  when Debugging:
    debug("NOT ACCEPT " & $symbol & " GOT " & $token.symbol & " INSTEAD")
  return false

proc expect(symbol: TSymbol): bool =
  if accept(symbol):
    return true
  raise new_exception(ESyntaxError, "Unexpected token $1 - $2 expected.{$3}" %
                      [$token.symbol, $symbol, $(prev_token.index_end + 1)])

proc view_stack(): string =
  result = "["
  result.add($stack.len)
  result.add("]")
  for item in stack:
    result.add(" ")
    result.add($item)

proc my_push(n: TNumber) =
  when Debugging:
    debug("PUSH (" & $n & ") --> " & $stack.len)
    debug(view_stack())
  stack.add(n)

proc my_pop(): TNumber =
  if stack.len > 0:
    result = stack.pop()
    when Debugging:
      debug("POP  (" & $stack.high & ") --> " & $result)
      debug(view_stack())
  else:
    my_push(NaN.TNumber)
    result = my_pop()

proc peek(): TNumber =
  return stack[stack.high]

proc swap() =
  if stack.len <= 1:
    discard
  else:
    let top = my_pop()
    let bottom = my_pop()
    my_push(top)
    my_push(bottom)

proc assignment()
#proc expression()

proc atom() =
  when Debugging:
    debug("    ATOM")
  if accept(sNumber):
    let number = parseFloat(prev_token.payload())
    when Debugging:
      debug("    ** NUM " & $number)
    my_push(number.TNumber)
  elif accept(sVariable):
    let variable = prev_token.payload()
    if accept(sAssign):
      when Debugging:
        debug("GOTCHA Assignment")
      backtrack(2)
      #backtrack()
      #backtrack()
      assignment()
    else:
      let value = variables[variable]
      when Debugging:
        debug("    ** VAR " & variable & " := " & $value)
      my_push(value)
  elif accept(sLeftParen):
    assignment()
    #expression()
    discard expect(sRightParen)
  else:
    get_next_token()

proc power() =
  when Debugging:
    debug("   POWER")
  atom()
  while accept(sPow):
    power()
    let exp = my_pop().float64
    let base = my_pop().float64
    let result = pow(base, exp)
    my_push(result.TNumber)

proc term() =
  when Debugging:
    debug("  TERM")
  power()
  while accept(sMul) or accept(sDiv) or accept(sMod) or
        (accept(sNumber) or accept(sVariable) or accept(sLeftParen)):
    var operator: TSymbol = prev_token.symbol
    if operator in {sNumber, sVariable, sLeftParen}:
      backtrack(1)
      operator = sMul
    power()
    if operator == sMul:
      my_push(my_pop() * my_pop())
    elif operator == sDiv or operator == sMod:
      if not (peek() == 0.0.TNumber):
        swap()
        if operator == sDiv:
          my_push(my_pop() / my_pop())
        else:
          my_push(my_pop() mod my_pop())
      else:
        raise newException(EDivisionByZeroError, "Division by 0")


proc expression() =
  var
    negate: bool = false
  when Debugging:
    debug(" EXPRESSION")
  if accept(sAdd) or accept(sSub):
    if prev_token.symbol == sSub:
      negate = true
  term()
  if negate:
    my_push(-my_pop())
  while accept(sAdd) or accept(sSub):
    let operator: TSymbol = prev_token.symbol
    term()
    if operator == sAdd:
      my_push(my_pop() + my_pop())
    elif operator == sSub:
      swap()
      my_push(my_pop() - my_pop())

proc assignment() =
  when Debugging:
    debug("ASSIGNMENT")
  var
    variable: string = "ans"
  if accept(sVariable):
    variable = prev_token.payload()
    try:
      if not accept(sAssign):
        variable = "ans"
        backtrack(1)
    except EInvalidIndex:
      backtrack(1)
  if variable == "ans":
    expression()
  else:
    assignment()
  variables[variable] = peek()
  when Debugging:
    debug("SET Variable '" & variable & "' := " & $variables[variable])
    debug(view_stack())

proc parse(): bool =
  parser_index = 0
  result = false
  if token_stream.len > 0:
    # Do not attempt parsing unless there are no tokens - obviously
    result = true
    get_next_token()
    assignment()
    discard my_pop() # Otherwise the stack fills up with discarded results,
                     #  and ans is already set up by assignment().
                     # It's a bit of an hack, yes, I know.

when Testing:
  proc parse_expr(expr: string): TNumber =
    token_stream = tokenize(expr)
    discard parse()
    return variables["ans"]
  ## Testing suite
  assert(parse_expr("27*(13+1)") == 378)
  assert(parse_expr("27*13+1") == 352)
  assert(parse_expr("2^3^3") == 134_217_728)
  assert(parse_expr("2^3^2") == 512)
  assert(parse_expr("a=b=5") == 5)
  assert(variables["a"] == 5)
  assert(variables["b"] == 5)
  assert(parse_expr("a=2+b=5") == 7)
  assert(variables["a"] == 7)
  assert(variables["b"] == 5)
  assert(parse_expr("a=(2+b=5)") == 7)
  assert(variables["a"] == 7)
  assert(variables["b"] == 5)
  variables["ans"] = 0.0.TNumber # Reset ans before starting up
  variables["a"] = 0.0.TNumber
  variables["b"] = 0.0.TNumber

when isMainModule:
  handlers.add(Logger)
  echo(ProgramName, " ", ProgramVersion, " (compiled on ", CompileDate, " ", CompileTime, ") [Nimrod ", NimrodVersion, "]")
  while interpreter_running:
    string_buffer = prompt()
    if string_buffer.startsWith("#"):
      # TODO: Handle metacommands here
      echo(view_stack())
      discard
    else:
      try:
        token_stream = tokenize(string_buffer)
        if parse():
          echo("--> ", variables["ans"])
          #echo(view_stack())
      except ESyntaxError:
        # What follows is horrible, horrible hackery... I shouldn't need to move around an integer
        #  value within a bloody exception message. I think I'm missing something.
        # Maybe I should write my own exception handling routines? Well, it's certainly something
        #  to consider. Obscene hackery. Fuck.
        # Aand I'm a moron. Instead of writing my own exception handling routines, I can just
        #  use a global variable that contains the index of the last syntax error, and access
        #  that, instead of making strings do things that strings aren't meant to do.
        let
          raw_msg: string = getCurrentExceptionMsg()
          index: int = parseInt(raw_msg[raw_msg.rfind("{")+1..raw_msg.high-1])
          msg: string = raw_msg[0..raw_msg.rfind("{")-1]
          r_up: int = clamp(index + 32, string_buffer.low, string_buffer.high)
          r_low: int = clamp(index - 32, string_buffer.low, string_buffer.high)
        echo("    ", string_buffer[r_low..r_up])
        echo("    ", repeatChar((index - r_low) - 1, ' '), "^")
        echo("*** Syntax Error: ", msg)
      except ERuntimeError:
        echo("*** Runtime Error: ", getCurrentExceptionMsg())
      except EProgramError:
        echo("*** Exception ", repr(getCurrentException()), ": ", getCurrentExceptionMsg())
      except:
        echo("*** Unknown Exception ", repr(getCurrentException()), ": ", getCurrentExceptionMsg())
        raise