#-----------------------------------------------------------------------------*
#
#  @file gtl_debugger.galgas
#
#  @section desc File description
#
#  Debugger for GTL.
#
#  @section copyright Copyright
#
#  GTL template language, part of Trampoline RTOS
#
#  Trampoline is copyright (c) CNRS, University of Nantes,
#  Ecole Centrale de Nantes
#  Trampoline is protected by the French intellectual property law.
#
#  This software is distributed under the GNU Public Licence V2.
#  Check the LICENSE file in the root directory of Trampoline
#
#  $Date$
#  $Rev$
#  $Author$
#  $URL$
#
#-----------------------------------------------------------------------------*

func signature
  ?@location loc
  ->@string result
{
  if [option gtl_options.debug value] then
    let @string signatureString =
      [[loc file] lastPathComponent]
      + ":"
      + [loc line]
    result = [signatureString md5]
  else
    result = ""
  end
}

func %once bold        ->@string bold      { bold      = "\u001B[1m"  }
func %once underline   ->@string underline { underline = "\u001B[4m"  }
func %once blink       ->@string blink     { blink     = "\u001B[5m"  }
func %once black       ->@string black     { black     = "\u001B[90m" }
func %once red         ->@string red       { red       = "\u001B[91m" }
func %once green       ->@string green     { green     = "\u001B[92m" }
func %once yellow      ->@string yellow    { yellow    = "\u001B[93m" }
func %once blue        ->@string blue      { blue      = "\u001B[94m" }
func %once magenta     ->@string magenta   { magenta   = "\u001B[95m" }
func %once cyan        ->@string cyan      { cyan      = "\u001B[96m" }
func %once darkred     ->@string red       { red       = "\u001B[31m" }
func %once darkgreen   ->@string green     { green     = "\u001B[32m" }
func %once darkyellow  ->@string yellow    { yellow    = "\u001B[33m" }
func %once darkblue    ->@string blue      { blue      = "\u001B[34m" }
func %once darkmagenta ->@string magenta   { magenta   = "\u001B[35m" }
func %once darkcyan    ->@string cyan      { cyan      = "\u001B[36m" }
func %once white       ->@string white     { white     = "\u001B[97m" }
func %once endc        ->@string endc      { endc      = "\u001B[0m"  }

#=============================================================================*
# loadCommandFile loads a command file if it exists and executes the commands
#-----------------------------------------------------------------------------*
method @string loadCommandFile
  ?!@gtlContext context
  ?!@gtlData    vars
  ?!@library    lib
{
  # Look for a .gtlinit file
  if [self fileExists] then
    message "loading file " + self + "\n"
    let @stringlist commands = [@string.stringWithContentsOfFile{ !self }
      componentsSeparatedByString !"\n"]

    @string whatInFile = ""
    for (input) in commands do
      whatInFile += [input stringByTrimmingWhiteSpaces]
    end
      
    if whatInFile != "" then
      for (input) in commands do
        if [input stringByTrimmingWhiteSpaces] != "" then
          grammar gtl_debugger_grammar on ( input, "Debugger command" )
            ?let @gtlInstruction command
          message [[context debuggerContext] instructionColor]
                + [[context debuggerContext] instructionFace]
          [command display]
          message endc()
          message "\n"
          @string result = ""
          [command execute !?context !?vars !?lib !?result]
        end
      end
    else
      message "No command in " + self + " file\n"
    end
  end 
}

#=============================================================================*
# @@debuggerContext is used to store the debugging context
#-----------------------------------------------------------------------------*
class @debuggerContext
{
  @bool                           debugActive            
  @bool                           breakOnNext            
  @bool                           loopOnCommand          
  @string                         promptColor            
  @string                         promptFace             
  @string                         instructionColor       
  @string                         instructionFace        
  @string                         outputColor            
  @string                         outputFace             
  @string                         warningColor           
  @string                         warningFace            
  @bool                           executeDebuggerCommand 
  @gtlInstructionList             doList
  @gtlBreakpointList              breakpoints
  @gtlExpressionList              watchpoints
  @uint                           nextInstructionIndex   
  @gtlInstructionList             instructionList      
  @gtlInstructionListContextStack contextStack
  @debugCommandInput              commandInput
}

#-----------------------------------------------------------------------------*
setter @debuggerContext appendInstructionToStepDo
  ?@gtlInstruction instruction
{
  doList += !instruction
}

#-----------------------------------------------------------------------------*
setter @debuggerContext deleteStepDoInstruction
  ?let @lbigint numToDelete
{
  if [numToDelete bigint] <= [@uint.max bigint] then
    let @uint numToDeleteUInt = [numToDelete uint]
    if numToDeleteUInt < [doList length] then
      [!?doList removeAtIndex ?let @gtlInstruction instruction !numToDeleteUInt]
      message "Command: "
      message instructionColor + instructionFace
      [instruction display]
      message outputColor + outputFace
      message " deleted\n"
    else
      message warningColor + warningFace
      message "no do command at this index: " + [numToDelete bigint] + "\n"
    end
  else
    message warningColor + warningFace
    message "no do command at this index: " + [numToDelete bigint] + "\n"
  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext deleteAllStepDoInstructions
{
  doList = .emptyList
}

#-----------------------------------------------------------------------------*
method @debuggerContext listStepDoInstructions
{
  if [doList length] > 0 then
    message "Step do commands:\n"
    for (instruction) in doList do (index)
      message [[index string] stringByLeftPadding !4 !' '] + ": "
      message instructionColor + instructionFace
      [instruction display]
      message "\n"
      message outputColor + outputFace
    end
  else
    message "No step do commands\n"
  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext setBreakpoint
  ?let @string fileName
  ?let @uint   lineNum
{
  let @string signature = [fileName + ":" + lineNum md5]
  @bool notThere = true
  for (bp) in breakpoints do
    if [bp signature] == signature then 
      notThere = false
    end
  end  
  if notThere then
    breakpoints += !@gtlBreakpoint.new { !fileName !lineNum !signature }
  end  
}

#-----------------------------------------------------------------------------*
method @debuggerContext listBreakpoints
{
  if [breakpoints length] > 0 then
    message "Breakpoints:\n"
    for (bp) in breakpoints do (index)
      message [[index string] stringByLeftPadding !4 !' '] + ": "
      message instructionColor + instructionFace
      message [bp fileName] + ":" + [bp lineNum]# + ":" + [bp signature]
      message "\n"
      message outputColor + outputFace
    end  
  else
    message "No breakpoint\n"
  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext deleteBreakpoint
  ?let @lbigint numToDelete
{
  if [numToDelete bigint] <= [@uint.max bigint] then
    let @uint numToDeleteUInt = [numToDelete uint]
    if numToDeleteUInt < [breakpoints length] then
      [!?breakpoints removeAtIndex ?let @gtlBreakpoint bp !numToDeleteUInt]
      message "Breakpoint: "
      message instructionColor + instructionFace
      message [bp fileName] + ":" + [bp lineNum]
      message outputColor + outputFace
      message " deleted\n"
    else
      message warningColor + warningFace
      message "no breakpoint at this index: " + [numToDelete bigint] + "\n"
    end
  else
    message warningColor + warningFace
    message "no breakpoint at this index: " + [numToDelete bigint] + "\n"
  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext deleteAllBreakpoints
{
  breakpoints = .emptyList
}

#-----------------------------------------------------------------------------*
setter @debuggerContext setWatchpoint
  ?let @gtlExpression watchExpression
{
  watchpoints += !watchExpression
}

#-----------------------------------------------------------------------------*
method @debuggerContext listWatchpoints
{
  if [watchpoints length] > 0 then
    message "Watchpoints:\n"
    for (wp) in watchpoints do (index)
      message [[index string] stringByLeftPadding !4 !' '] + ": "
      message instructionColor + instructionFace
      message [wp stringRepresentation]
      message "\n"
      message outputColor + outputFace
    end  
  else
    message "No Watchpoint\n"
  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext deleteWatchpoint
  ?let @lbigint numToDelete
{
  if [numToDelete bigint] <= [@uint.max bigint] then
    let @uint numToDeleteUInt = [numToDelete uint]
    if numToDeleteUInt < [watchpoints length] then
      [!?watchpoints removeAtIndex ?let @gtlExpression wp !numToDeleteUInt]
      message "Watchpoint: "
      message instructionColor + instructionFace
      message [wp stringRepresentation]
      message outputColor + outputFace
      message " deleted\n"
    else
      message warningColor + warningFace
      message "no watchpoint at this index: " + [numToDelete bigint] + "\n"
    end
  else
    message warningColor + warningFace
    message "no watchpoint at this index: " + [numToDelete bigint] + "\n"
  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext deleteAllWatchpoints
{
  watchpoints = .emptyList
}

#-----------------------------------------------------------------------------*
getter @debuggerContext breakOn
  ?let @gtlInstruction instruction
  ->@bool breakOn
{
  breakOn = false
  for (bp) in breakpoints do
    if [instruction signature] == [bp signature] then
      breakOn = true
    end
  end
}

#-----------------------------------------------------------------------------*
getter @debuggerContext watchOn
  ?let @gtlContext context
  ?let @gtlData    vars
  ?let @library    lib
  ->@bool watchOn
{
  watchOn = false
  for (wp) in watchpoints do
    let @gtlData watchResult = [wp eval !context !vars !lib]
    if watchResult is == @gtlBool then
      let @bool matchWatch = [watchResult as @gtlBool value]
      if matchWatch then
        message outputColor + outputFace
        message "match "
        message instructionColor + instructionFace
        message [wp stringRepresentation]
        message "\n"
        message endc()
        watchOn = true
      end
    end 
  end
}

#-----------------------------------------------------------------------------*
method @debuggerContext hereWeAre
  ?let @uint window
{
  @uint indentation = 0
  for (levelIndex levelList) in [contextStack subListFromIndex !1] do
    message @string.stringWithSequenceOfCharacters{ !' ' !indentation }
    [[levelList instructionAtIndex !levelIndex] displayWithLocation !self]
    indentation = indentation + 4
  end

  let @string identationString = .stringWithSequenceOfCharacters{ !' ' !indentation }
  let @uint startIndex
  let @uint displayLength

  if nextInstructionIndex >= window then
    startIndex = nextInstructionIndex - window
  else
    startIndex = 0
  end
  if startIndex + (window * 2) < [instructionList length] then
    displayLength = 2 * window
  else
    displayLength = [instructionList length] - startIndex
  end
  message endc()
  for (instruction) in
    [instructionList subListWithRange !@range.new { !startIndex !displayLength }]
    do (index)

    if index + startIndex == nextInstructionIndex then
      message red() + bold()
      message identationString + ">>> "
      message endc()
    else
      message identationString + "    "
    end
    [instruction displayWithLocation !self]

  end
}

#-----------------------------------------------------------------------------*
setter @debuggerContext pushInstructionList
  ?let @gtlInstructionList instructions
{
  contextStack += !nextInstructionIndex !instructionList
  nextInstructionIndex = 0
  instructionList = instructions
}

setter @debuggerContext popInstructionList
{
  [!?contextStack popLast ?nextInstructionIndex ?instructionList]
}

#-----------------------------------------------------------------------------*
setter @debuggerContext getCommand
  !@string command
{
  [!?commandInput getCommand ?command]
}

#-----------------------------------------------------------------------------*
func defaultDebugSettings
  ->@debuggerContext debugSettings
{
  debugSettings = .new {
    ![option gtl_options.debug value]
    ![option gtl_options.debug value]
    !false
    !red()
    !""
    !blue()
    !bold()
    !darkgreen()
    !""
    !darkyellow()
    !bold()
    !false
    !.emptyList
    !.emptyList
    !.emptyList
    !0
    !.emptyList
    !.emptyList
    !.new { !.emptyList }
  }
}

#-----------------------------------------------------------------------------*
setter @gtlContext setDebugger
  ?@bool debugOn
{
  [!?debuggerContext setDebugActive !debugOn]
}

#-----------------------------------------------------------------------------*
setter @gtlContext setBreakOnNext
  ?@bool break
{
  [!?debuggerContext setBreakOnNext !break]
}

#-----------------------------------------------------------------------------*
getter @gtlContext debugActive
  ->@bool debugOn
{
  debugOn = [debuggerContext debugActive]
}

#-----------------------------------------------------------------------------*
getter @gtlContext breakOnNext
  ->@bool breakOnNext
{
  breakOnNext = [debuggerContext breakOnNext]
}

#-----------------------------------------------------------------------------*
getter @gtlContext breakOn
  ?@gtlInstruction instruction
  ->@bool breakOn
{
  breakOn = [debuggerContext breakOn !instruction]
}

#-----------------------------------------------------------------------------*
getter @gtlContext watchOn
  ?let @gtlContext context
  ?let @gtlData    vars
  ?let @library    lib
  ->@bool watchOn
{
  watchOn = [debuggerContext watchOn !context !vars !lib]
}

#-----------------------------------------------------------------------------*
getter @gtlContext promptStyle
  ->@string result
{
  result = [debuggerContext promptColor] + [debuggerContext promptFace]
}

#-----------------------------------------------------------------------------*
getter @gtlContext outputStyle
  ->@string result
{
  result = [debuggerContext outputColor] + [debuggerContext outputFace]
}

#-----------------------------------------------------------------------------*
setter @gtlContext appendInstructionToStepDo
  ?@gtlInstruction instruction
{
  [!?debuggerContext appendInstructionToStepDo !instruction]
}

#-----------------------------------------------------------------------------*
setter @gtlContext deleteStepDoInstruction
  ?let @lbigint numToDelete
{
  [!?debuggerContext deleteStepDoInstruction !numToDelete]
}

#-----------------------------------------------------------------------------*
setter @gtlContext deleteAllStepDoInstructions
{
  [!?debuggerContext deleteAllStepDoInstructions]
}

#-----------------------------------------------------------------------------*
method @gtlContext listStepDoInstructions
{
  [debuggerContext listStepDoInstructions]
}

#-----------------------------------------------------------------------------*
setter @gtlContext executeStepDoList
  ?!@gtlContext context
  ?!@gtlData    vars
  ?!@library    lib
  ?!@string     outputString
{
  message [context outputStyle]
  for (instruction) in [debuggerContext doList] do
    [instruction execute !?context !?vars !?lib !?outputString]
  end 
  message endc()
}

#-----------------------------------------------------------------------------*
setter @gtlContext setBreakpoint
  ?let @string fileName
  ?let @uint   lineNum
{
  [!?debuggerContext setBreakpoint !fileName !lineNum]
}

#-----------------------------------------------------------------------------*
method @gtlContext listBreakpoints
{
  [debuggerContext listBreakpoints] 
}

#-----------------------------------------------------------------------------*
setter @gtlContext deleteBreakpoint
  ?let @lbigint numToDelete
{
  [!?debuggerContext deleteBreakpoint !numToDelete]
}

#-----------------------------------------------------------------------------*
setter @gtlContext deleteAllBreakpoints
{
  [!?debuggerContext deleteAllBreakpoints]
}

#-----------------------------------------------------------------------------*
setter @gtlContext setWatchpoint
  ?let @gtlExpression watchExpression
{
  [!?debuggerContext setWatchpoint !watchExpression]
}

#-----------------------------------------------------------------------------*
method @gtlContext listWatchpoints
{
  [debuggerContext listWatchpoints] 
}

#-----------------------------------------------------------------------------*
setter @gtlContext deleteWatchpoint
  ?let @lbigint numToDelete
{
  [!?debuggerContext deleteWatchpoint !numToDelete]
}

#-----------------------------------------------------------------------------*
setter @gtlContext deleteAllWatchpoints
{
  [!?debuggerContext deleteAllWatchpoints]
}

#-----------------------------------------------------------------------------*
setter @gtlContext setLoopOnCommand
  ?@bool loopOnCommand
{
  [!?debuggerContext setLoopOnCommand !loopOnCommand]
}

#-----------------------------------------------------------------------------*
getter @gtlContext loopOnCommand
  ->@bool loopOnCommand
{
  loopOnCommand = [debuggerContext loopOnCommand]
}

#-----------------------------------------------------------------------------*
method @gtlContext hereWeAre
  ?let @uint window
{
  [debuggerContext hereWeAre !window]
}

#-----------------------------------------------------------------------------*
setter @gtlContext pushInstructionList
  ?let @gtlInstructionList instructionList
{
  [!?debuggerContext pushInstructionList !instructionList]
}

#-----------------------------------------------------------------------------*
setter @gtlContext popInstructionList
{
  [!?debuggerContext popInstructionList]
}

#-----------------------------------------------------------------------------*
setter @gtlContext setNextInstructionIndex
  ?@uint index
{
  [!?debuggerContext setNextInstructionIndex !index]
}

#-----------------------------------------------------------------------------*
setter @gtlContext setExecuteDebuggerCommand
  ?@bool debuggerCommand
{
  [!?debuggerContext setExecuteDebuggerCommand !debuggerCommand]
}

#-----------------------------------------------------------------------------*
setter @gtlContext getCommand
  !@string command
{
  [!?debuggerContext getCommand ?command]
}

#=============================================================================*
list @gtlInstructionListContextStack
{
  @uint               nextInstructionIndex
  @gtlInstructionList instructionList
}

#=============================================================================*
class @gtlBreakpoint {
  @string fileName
  @uint   lineNum
  @string signature
}

list @gtlBreakpointList {
  @gtlBreakpoint breakpoint
}

#=============================================================================*
getter @gtlVarPath stringRepresentation
  ->@string result
{
  result = [[self itemAtIndex !0] stringRepresentation !""]
  for (item) in [self subListFromIndex !1] do
    result += [item stringRepresentation !"::"]
  end
}

#-----------------------------------------------------------------------------*
abstract getter @gtlVarItem stringRepresentation
  ?let @string concatString
  ->@string

#-----------------------------------------------------------------------------*
override getter @gtlVarItemField stringRepresentation
  ?let @string concatString
  ->@string result
{
  result = concatString + field
}

#-----------------------------------------------------------------------------*
override getter @gtlVarItemSubCollection stringRepresentation
  ?let @string unused concatString
  ->@string result
{
  result = "[" + [key stringRepresentation] + "]"
}

#-----------------------------------------------------------------------------*
override getter @gtlVarItemCollection stringRepresentation
  ?let @string concatString
  ->@string result
{
  result = concatString + field + '[' + [key stringRepresentation] + ']'
}

#=============================================================================*
abstract getter @gtlExpression stringRepresentation
  ->@string

#-----------------------------------------------------------------------------*
override getter @gtlAddExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " + " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlAndExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " & " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlDivideExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " / " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlEqualExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " == " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlGreaterOrEqualExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " >= " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlGreaterThanExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " > " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlLowerOrEqualExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " <= " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlLowerThanExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " < " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlModulusExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " mod " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlMultiplyExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " * " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlNotEqualExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " != " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlOrExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " | " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlShiftLeftExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " << " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlShiftRightExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " >> " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlSubstractExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " - " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlXorExpression stringRepresentation
  ->@string result
{
  result = [lSon stringRepresentation] + " ^ " + [rSon stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlExistsExpression stringRepresentation
  ->@string result
{
  result = "exists " + [variable stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlExistsDefaultExpression stringRepresentation
  ->@string result
{
  result = "exists "
    + [variable stringRepresentation]
    + " default ( "
    + [defaultValue stringRepresentation]
    + " )"
}

#-----------------------------------------------------------------------------*
override getter @gtlFunctionCallExpression stringRepresentation
  ->@string result
{
  result = [functionName string] + "(" + [functionArguments stringRepresentation] + ")"
}

#-----------------------------------------------------------------------------*
override getter @gtlGetterCallExpression stringRepresentation
  ->@string result
{
  result = "[" + [target stringRepresentation] + " " + getterName
  if [arguments length] > 0 then
    result = result + ": " + [arguments stringRepresentation]    
  end
  result = result + "]"
}

#-----------------------------------------------------------------------------*
override getter @gtlListOfExpression stringRepresentation
  ->@string result
{
  result = "listof " + [expression stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlLiteralListExpression stringRepresentation
  ->@string result
{
  result = "@( " + [value stringRepresentation] + " )"
}

#-----------------------------------------------------------------------------*
override getter @gtlLiteralMapExpression stringRepresentation
  ->@string result
{
  result = "@[ " + [value mapRepresentation] + " ]"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlLiteralSetExpression stringRepresentation
  ->@string result
{
  result = "@! " + [value stringRepresentation] + " !"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlLiteralStructExpression stringRepresentation
  ->@string result
{
  result = "@{ " + [value structRepresentation] + " }"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlMapOfStructExpression stringRepresentation
  ->@string result
{
  result = "mapof " + [expression stringRepresentation] + " end"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlTerminal stringRepresentation
  ->@string result
{
  result = [value stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlTypeOfExpression stringRepresentation
  ->@string result
{
  result = "typeof " + [variable stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlMinusExpression stringRepresentation
  ->@string result
{
  result = "-" + [son stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlNotExpression stringRepresentation
  ->@string result
{
  result = "not " + [son stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlParenthesizedExpression stringRepresentation
  ->@string result
{
  result = "(" + [son stringRepresentation] + ")"
}

#-----------------------------------------------------------------------------*
override getter @gtlPlusExpression stringRepresentation
  ->@string result
{
  result = "+" + [son stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlVarRef stringRepresentation
  ->@string result
{
  result = [variableName stringRepresentation]
}

#-----------------------------------------------------------------------------*
override getter @gtlAllVarsRef stringRepresentation
  ->@string result
{
  result = "__VARS__"
}

#=============================================================================*
abstract getter @gtlData stringRepresentation
  ->@string
  
#-----------------------------------------------------------------------------*
override getter @gtlBool stringRepresentation
  ->@string result
{
  result = [self string]
}
  
#-----------------------------------------------------------------------------*
override getter @gtlChar stringRepresentation
  ->@string result
{
  result = [self string]
}

#-----------------------------------------------------------------------------*
override getter @gtlEnum stringRepresentation
  ->@string result
{
  result = "$" + [self string]
}
  
#-----------------------------------------------------------------------------*
override getter @gtlFloat stringRepresentation
  ->@string result
{
  result = [self string]
}
  
#-----------------------------------------------------------------------------*
override getter @gtlInt stringRepresentation
  ->@string result
{
  result = [self string]
}
  
#-----------------------------------------------------------------------------*
override getter @gtlString stringRepresentation
  ->@string result
{
  @string literalString = [self string]
  literalString = [literalString stringByReplacingStringByString !"\n" !"\\n"] 
  literalString = [literalString stringByReplacingStringByString !"\t" !"\\t"] 
  literalString = [literalString stringByReplacingStringByString !"\f" !"\\f"] 
  literalString = [literalString stringByReplacingStringByString !"\r" !"\\r"] 
  literalString = [literalString stringByReplacingStringByString !"\v" !"\\v"] 
  literalString = [literalString stringByReplacingStringByString !"\\" !"\\\\"] 
  literalString = [literalString stringByReplacingStringByString !"\"" !"\\\""] 
  result = "\"" + literalString + "\""
}
  
#-----------------------------------------------------------------------------*
override getter @gtlUnconstructed stringRepresentation
  ->@string result
{
  result = "*UNCONSTRUCTED*"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlType stringRepresentation
  ->@string result
{
  result = "@" + [self string]
}
  
#-----------------------------------------------------------------------------*
override getter @gtlList stringRepresentation
  ->@string result
{
  result = "@( "
  for (item) in value do
    result = result + [item stringRepresentation]
  between
    result = result + ", "
  end
  result = result + " )"
}

#-----------------------------------------------------------------------------*
override getter @gtlMap stringRepresentation
  ->@string result
{
  result = "@[ "
  for (key item) in value do
    result = result + "\"" + key + "\": " + [item stringRepresentation]
  between
    result = result + ", "
  end
  result = result + " ]"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlStruct stringRepresentation
  ->@string result
{
  result = "@{ "
  for (key item) in value do
    result = result + key + ": " + [item stringRepresentation]
  between
    result = result + ", "
  end
  result = result + " }"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlSet stringRepresentation
  ->@string result
{
  result = "@! "
  for (item) in value do
    result = result + item
  between
    result = result + ", "
  end
  result = result + " !"
}
  
#-----------------------------------------------------------------------------*
override getter @gtlExpr stringRepresentation
  ->@string result
{
  result = "@? " + [value stringRepresentation] + " ?"
}
  
#=============================================================================*
getter @gtlExpressionList stringRepresentation
  ->@string result
{
  result = ""
  for (expression) in self do
    result = result + [expression stringRepresentation]
  between
    result = result + ", "
  end
}

#=============================================================================*
getter @gtlExpressionMap mapRepresentation
  ->@string result
{
  result = ""
  for (key expression) in self do
    result = result + "\"" + key + "\": " + [expression stringRepresentation]
  between
    result = result + ", "
  end
}

#-----------------------------------------------------------------------------*
getter @gtlExpressionMap structRepresentation
  ->@string result
{
  result = ""
  for (key expression) in self do
    result = result + key + ": " + [expression stringRepresentation]
  between
    result = result + ", "
  end
}

#=============================================================================*
getter @gtlArgumentList stringRepresentation
  ->@string result
{
  result = ""
  for (typed type name) in self do
    result = result + name
    if typed then
      result = result + " : @" + [type typeName]
    end  
  between
    result = result + ", "
  end
}

#=============================================================================*
getter @lsint stringRepresentation
  ->@string result
{
  result = if 0 < [self bigint] then "<" else ">" end
}

#=============================================================================*
getter @sortingKeyList stringRepresentation
  ->@string result
{
  result = ""
  for (key order) in self do
    result = result + key + " " + [order stringRepresentation]
  between
    result = ", "
  end
}

#=============================================================================*
getter @gtlInstruction shortLocation
  ->@string result
{
  result = [[where file] lastPathComponent] + ":" + [where line]
}

#-----------------------------------------------------------------------------*
method @gtlInstruction displayWithLocation
  ?let @debuggerContext context
{
  message [self shortLocation] + " > "
  message [context instructionColor] + [context instructionFace]
  [self display]
  message endc() + "\n"
}

#=============================================================================*
abstract method @gtlInstruction display
#{
#  message "[Display not available]"
#}

#-----------------------------------------------------------------------------*
override method @gtlLetUnconstructedInstruction display
{
  message "let " + [lValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " := "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetAddInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " += "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetSubstractInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " -= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetMultiplyInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " *= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetDivideInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " /= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetModuloInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " mod= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetShiftLeftInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " <<= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetShiftRightInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " >>= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetAndInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " &= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetOrInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " |= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLetXorInstruction display
{
  message "let "
    + [lValue stringRepresentation]
    + " ^= "
    + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLoopStatementInstruction display
{
  message "loop "
    + identifier
    + " from "
    + [start stringRepresentation]
    + if upDown == -1 then " down" else "" end
    + " to "
    + [stop stringRepresentation]
    + " step "
    + [step stringRepresentation]
    + " do"
}

#-----------------------------------------------------------------------------*
override method @gtlWarningStatementInstruction display
{
  message "warning "
    + if hereInstead then "here" else [identifier stringRepresentation] end
    + " : "
    + [warningMessage stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlErrorStatementInstruction display
{
  message "error "
    + if hereInstead then "here" else [identifier stringRepresentation] end
    + " : "
    + [errorMessage stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlDisplayStatementInstruction display
{
  message "display " + [variablePath stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlPrintStatementInstruction display
{
  message "print"
    + if carriageReturn then "ln " else " " end
    + [messageToPrint stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlTemplateStringInstruction display
{
  message "%" + value + "%"
}

#-----------------------------------------------------------------------------*
override method @gtlInputStatementInstruction display
{
  message "input ( " + [formalArguments stringRepresentation] + " )"
}

#-----------------------------------------------------------------------------*
override method @gtlSortStatementInstruction display
{
  message "sort "
    + [variablePath stringRepresentation] 
    + " " 
    + [order stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlSortStatementStructInstruction display
{
  message "sort "
    + [variablePath stringRepresentation] 
    + " by "
    + [sortingKey stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlTemplateInstruction display
{
  message "template "
    + if isGlobal then "" else "( " + [arguments stringRepresentation] + " ) " end
    + if ifExists then "if exists " else "" end
    + [fileName stringRepresentation]
    + if "" == prefix then " " else " in " + prefix + " " end
    + if ifExists & [instructionsIfNotFound length] > 0 then "or ..." else "" end
}

#-----------------------------------------------------------------------------*
override method @gtlEmitInstruction display
{
  message "! " + [rValue stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlIfStatementInstruction display
{
  message "if "
    + [[thenElsifList conditionAtIndex !0] stringRepresentation]
    + " then"
}

#-----------------------------------------------------------------------------*
override method @gtlForStatementInstruction display
{
  message "for "
    + identifier
    + " in "
    + [iterable stringRepresentation]
    + " do"
}

#-----------------------------------------------------------------------------*
override method @gtlForeachStatementInstruction display
{
  message "foreach "
    + if "" == keyName then "" else [keyName string] + ", " end
    + variableName
    + " (" + indexName+ ") "
    + " in "
    + [iterable stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlGetColumnInstruction display
{
  message "? " + [destVariable stringRepresentation]
}

#-----------------------------------------------------------------------------*
override method @gtlLibrariesInstruction display
{
  message "libraries"
}

#-----------------------------------------------------------------------------*
override method @gtlRepeatStatementInstruction display
{
  message "repeat "
  cast limit
  case == @gtlTerminal term:
    cast [term value]
    case == @gtlInt intLimit:
      if [[intLimit value] uint] != @uint.max then
        message " (" + [intLimit string] + ")"
      end
    end
  else
    message " (" + [limit stringRepresentation] + ")"
  end
}

#-----------------------------------------------------------------------------*
override method @gtlSetterCallInstruction display
{
  message "[!"
    + [target stringRepresentation]
    + setterName
    + if [arguments length] > 0 then
        ": " + [arguments stringRepresentation] + "]"
      else
        "]"
      end
}

#-----------------------------------------------------------------------------*
override method @gtlVariablesInstruction display
{
  message "variables"
}

#-----------------------------------------------------------------------------*
override method @gtlWriteToInstruction display
{
  message "write to "
    + if isExecutable then "executable " else "" end
    + [fileNameExpression stringRepresentation]
    + " :"
    
}

#-----------------------------------------------------------------------------*
override method @gtlTabStatementInstruction display
{
  message "tab " + [tabValue stringRepresentation]
    
}

#=============================================================================*
getter @gtlInstruction mayExecuteWithoutError
  ?let @gtlContext unused exeContext
  ?let @gtlData    unused context
  ?let @library    unused lib
  ->@bool may
{
  may = true
}

#-----------------------------------------------------------------------------*
override getter @gtlDisplayStatementInstruction mayExecuteWithoutError
  ?let @gtlContext exeContext
  ?let @gtlData    context
  ?let @library    lib
  ->@bool may
{
  may =  [variablePath exists !exeContext !context !lib]
}

#-----------------------------------------------------------------------------*
# Debugger instruction : step
#-----------------------------------------------------------------------------*
class @gtlStepInstruction : @gtlInstruction {}

override method @gtlStepInstruction execute
  ?!@gtlContext context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context setLoopOnCommand !false]
}

override method @gtlStepInstruction display
{
  message "step"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : do <instruction>
#-----------------------------------------------------------------------------*
class @gtlDoInstInstruction : @gtlInstruction
{
  @gtlInstruction instructionToDo
}

override method @gtlDoInstInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context appendInstructionToStepDo !instructionToDo]
}

override method @gtlDoInstInstruction display
{
  message "do "
  [instructionToDo display]
}

#-----------------------------------------------------------------------------*
# Debugger instruction : do not <num>
#-----------------------------------------------------------------------------*
class @gtlDoNotInstruction : @gtlInstruction
{
  @lbigint numToDelete
}

override method @gtlDoNotInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context deleteStepDoInstruction !numToDelete]
}

override method @gtlDoNotInstruction display
{
  message "do not " + [numToDelete bigint]
}

#-----------------------------------------------------------------------------*
# Debugger instruction : do not all
#-----------------------------------------------------------------------------*
class @gtlDoNotAllInstruction : @gtlInstruction
{
}

override method @gtlDoNotAllInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context deleteAllStepDoInstructions]
}

override method @gtlDoNotAllInstruction display
{
  message "do not all"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : do
#-----------------------------------------------------------------------------*
class @gtlDoInstruction : @gtlInstruction
{
}

override method @gtlDoInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [context listStepDoInstructions]
}

override method @gtlDoInstruction display
{
  message "do"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : continue
#-----------------------------------------------------------------------------*
class @gtlContinueInstruction : @gtlInstruction
{
}

override method @gtlContinueInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context setBreakOnNext !false]
  [!?context setLoopOnCommand !false]
}

override method @gtlContinueInstruction display
{
  message "cont"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : add a breakpoint
#-----------------------------------------------------------------------------*
class @gtlBreakpointInstruction : @gtlInstruction
{
  @string fileName
  @uint   lineNum
}

override method @gtlBreakpointInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  let instructionList = [[context debuggerContext] instructionList]
  @string localFileName = ""
  if [instructionList length] > 0 then
    localFileName = [
      [[[instructionList instructionAtIndex !0] location] file]
      lastPathComponent
    ]
    if fileName == localFileName | fileName == "" then
      message "Setting breakpoint at " + localFileName + ":" + lineNum + "\n"
      [!?context setBreakpoint !localFileName !lineNum]     
    else
      message "Setting breakpoint at " + fileName + ":" + lineNum + "\n"
      [!?context setBreakpoint !fileName !lineNum]
    end
  else
    message "Unable to set a breakpoint in an empty file\n"
  end
}

override method @gtlBreakpointInstruction display
{
  message "break " + fileName + ":" + lineNum
}

#-----------------------------------------------------------------------------*
# Debugger instruction : list breakpoints
#-----------------------------------------------------------------------------*
class @gtlBreakpointListInstruction : @gtlInstruction
{
}

override method @gtlBreakpointListInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [context listBreakpoints]
}

override method @gtlBreakpointListInstruction display
{
  message "break"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : delete breakpoint
#-----------------------------------------------------------------------------*
class @gtlBreakpointDeleteInstruction : @gtlInstruction
{
  @lbigint numToDelete
}

override method @gtlBreakpointDeleteInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context deleteBreakpoint !numToDelete]
}

override method @gtlBreakpointDeleteInstruction display
{
  message "break not " + [numToDelete bigint]
}

#-----------------------------------------------------------------------------*
# Debugger instruction : delete all breakpoint
#-----------------------------------------------------------------------------*
class @gtlBreakpointDeleteAllInstruction : @gtlInstruction
{
}

override method @gtlBreakpointDeleteAllInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context deleteAllBreakpoints]
}

override method @gtlBreakpointDeleteAllInstruction display
{
  message "break not all"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : add a watchpoint
#-----------------------------------------------------------------------------*
class @gtlWatchpointInstruction : @gtlInstruction
{
  @gtlExpression watchExpression
}

override method @gtlWatchpointInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context setWatchpoint !watchExpression]
}

override method @gtlWatchpointInstruction display
{
  message "watch ( " + [watchExpression stringRepresentation] + " )"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : list breakpoints
#-----------------------------------------------------------------------------*
class @gtlWatchpointListInstruction : @gtlInstruction
{
}

override method @gtlWatchpointListInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [context listWatchpoints]
}

override method @gtlWatchpointListInstruction display
{
  message "watch"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : delete breakpoint
#-----------------------------------------------------------------------------*
class @gtlWatchpointDeleteInstruction : @gtlInstruction
{
  @lbigint numToDelete
}

override method @gtlWatchpointDeleteInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context deleteWatchpoint !numToDelete]
}

override method @gtlWatchpointDeleteInstruction display
{
  message "watch not " + [numToDelete bigint]
}

#-----------------------------------------------------------------------------*
# Debugger instruction : delete all watchpoints
#-----------------------------------------------------------------------------*
class @gtlWatchpointDeleteAllInstruction : @gtlInstruction
{
}

override method @gtlWatchpointDeleteAllInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [!?context deleteAllWatchpoints]
}

override method @gtlWatchpointDeleteAllInstruction display
{
  message "watch not all"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : list
#-----------------------------------------------------------------------------*
class @gtlListInstruction : @gtlInstruction
{
  @uint window
}

override method @gtlListInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [context hereWeAre !window]
}

override method @gtlListInstruction display
{
  message "list " + window
}

#-----------------------------------------------------------------------------*
# Debugger instruction : hist
#-----------------------------------------------------------------------------*
class @gtlHistoryInstruction : @gtlInstruction
{
}

override method @gtlHistoryInstruction execute
  ?!@gtlContext        context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  [[[context debuggerContext] commandInput] listHistory]
}

override method @gtlHistoryInstruction display
{
  message "hist"
}

#-----------------------------------------------------------------------------*
# Debugger instruction : load <filename>
#-----------------------------------------------------------------------------*
class @gtlLoadInstruction : @gtlInstruction
{
  @string fileName
}

override method @gtlLoadInstruction execute
  ?!@gtlContext        context
  ?!@gtlData           vars
  ?!@library           lib
  ?!@string     unused outputString
{
  [fileName loadCommandFile !?context !?vars !?lib]
}

override method @gtlLoadInstruction display
{
  message "load \"" + fileName + "\""
}

#-----------------------------------------------------------------------------*
# Debugger instruction : help
#-----------------------------------------------------------------------------*
class @gtlHelpInstruction : @gtlInstruction
{
}

override method @gtlHelpInstruction execute
  ?!@gtlContext unused context
  ?!@gtlData    unused vars
  ?!@library    unused lib
  ?!@string     unused outputString
{
  message "Available commands:\n"
  message "  break <filename>:<line>        : set a breakpoint at <line> in file <filename>\n"
  message "  break <line>                   : set a breakpoint at <line> in the current file\n"
  message "  break                          : lists the breakpoints\n"
  message "  break not <num>                : delete breakpoint at index <num>\n"
  message "  break not all                  : delete all breakpoints\n"
  message "  cont                           : continue execution until the next breakpoint or the end\n"
  message "  display <variable>             : display variable <variable>\n"
  message "  do <command>                   : do a command each time a step is done\n"
  message "  do                             : list the do commands\n"
  message "  do not <num>                   : delete the do command at index <num>\n"
  message "  do not all                     : delete all the do commands\n"
  message "  hist                           : display the command history\n"
  message "  if <expression> then ...       : same as GTL if instruction. Must be on one line though\n"
  message "  list                           : lists instructions +/- 5 around current one\n"
  message "  list <num>                     : lists instructions +/- <num> around current one\n"
  message "  let <variable> := <expression> : compute <expression> and set <variable> to the result\n"
  message "  load <filename>                : load commands from file <filename>\n"
  message "  print <expression>             : prints the <expression>\n"
  message "  step                           : step one instruction\n"
  message "  unlet <variable>               : delete <variable>\n"
  message "  variables                      : display all variables in scope\n"
  message "  watch (<expression>)           : set a watchpoint matching the boolean <expression>\n"
  message "  watch                          : lists the watchpoints\n"
  message "  watch not <num>                : delete watchpoint at index <num>\n"
  message "  watch not all                  : delete all watchpoints\n"
  message "  <return>                       : step one instruction\n"
}

override method @gtlHelpInstruction display
{
  message "help"
}