// $Id$

$use Apply Arithm Box Compare Convert List "RF_Stack" Static StdIO Table;

$table Break_Funcs Breakpoints Ops;

$box Break_Depth IsBreak Last_Depth;

ShouldStop e.point = \{
  <Get &IsBreak> : \{
    ALL = /*yes, stop*/;
    NO = $fail;
  };
  <Le (<Depth>) (<Get &Break_Depth>)>;
  <IsInTable &Breakpoints e.point>;
  <IsInTable &Break_Funcs <Name <Func <Arithm.Sub <Depth> 1>>>>,
    <Gt (<Depth>) (<Get &Last_Depth>)>;
  <Store &Last_Depth <Depth>> = $fail;
},
  <Store &IsBreak /*empty*/>,
  <Store &Break_Depth 0>,
  <Store &Last_Depth <Depth>>,
  <Print "Stopped at "> <WriteLn e.point <RF_Stack 2 1>>;

Debug env = {
  $iter \{
    <ReadLine> : s1 e2,
      <Lookup &Ops s1> : s.op =
      <Apply s.op e2 (env)> : e;
    <Entries &Ops> : e ((e.key) (s.op)) e,
      <Print e.key> <Apply s.op Help ()> : e,
      $fail;;
  },
    $fail;;
};

$func? Cont e (env) = ;

Cont e.arg (env) =
  e.arg : {
    Help = <PrintLn " continues execution (stop at the next breakpoint)">;
    e = $fail;
  };

$func? Run e (env) = ;

Run e.arg (env) =
  e.arg : {
    Help = <PrintLn " runs the program to the end without stopping">;
    e =
      <Store &IsBreak NO>,
      $fail;
  };

$func? Step e (env) = ;

Step e.arg (env) =
  e.arg : {
    Help = <PrintLn " does one step">;
    e =
      <Store &IsBreak ALL>,
      $fail;
  };

$func? Next e (env) = ;

Next e.arg (env) =
  e.arg : {
    Help = <PrintLn " steps program, proceeding through function calls">;
    e =
      <Store &Break_Depth <Arithm.Sub <Depth> 2>>,
      $fail;
  };

$func Var e (env) = ;

Var e.arg (env) =
  e.arg : {
    Help = <PrintLn "[var-name | /*empty*/] prints value of `var-name` | all variables">;
    v.name = {
      env : e (v.name (e.value)) e = <WriteLn e.value>;
      <PrintLn "No variable with name "v.name>;
    };
    /*empty*/ = {
      env : e (e.name (e.value)) e,
        <Print '.'e.name' : '> <WriteLn e.value>,
        $fail;;
    };
  };

$func Set_Break e (env) = ;

Set_Break e.arg (env) =
  e.arg : {
    Help = <PrintLn "[file-name line column] sets breakpoint at specified position">;
    $r e.fname' 'e.line' 'e.column,
      <Bind &Breakpoints (e.fname <ToInt e.line> <ToInt e.column>) ()>,
      $fail;
    e = <Print "Breakpoints: "> <WriteLn <Domain &Breakpoints>>;
  };

$func Clear_Break e (env) = ;

Clear_Break e.arg (env) =
  e.arg : {
    Help = <PrintLn "[file-name line column] removes breakpoint from specified position">;
    $r e.fname' 'e.line' 'e.column,
      <Unbind &Breakpoints e.fname <ToInt e.line> <ToInt e.column>>,
      $fail;
    e = <Print "Breakpoints: "> <WriteLn <Domain &Breakpoints>>;
  };

$func Set_Func e (env) = ;

Set_Func e.arg (env) =
  e.arg : {
    Help = <PrintLn "[func-name] sets breakpoint just after entering function `func-name`">;
    v.fname,
      <Bind &Break_Funcs (<ToWord v.fname>) ()>,
      $fail;
    e = <Print "Break at functions: "> <WriteLn <Concat <Domain &Break_Funcs>>>;
  };


$func Clear_Func e (env) = ;

Clear_Func e.arg (env) =
  e.arg : {
    Help = <PrintLn "[func-name] clears breakpoint at function `func-name`">;
    v.fname,
      <Unbind &Break_Funcs <ToWord v.fname>>,
      $fail;
    e = <Print "Break at functions: "> <WriteLn <Concat <Domain &Break_Funcs>>>;
  };

$func Init = ;

Init =
  <Store &Break_Depth 0>,
  <Bind &Ops ('c') (&Cont)>,
  <Bind &Ops ('s') (&Step)>,
  <Bind &Ops ('n') (&Next)>,
  <Bind &Ops ('r') (&Run)>,
  <Bind &Ops ('.') (&Var)>,
  <Bind &Ops ('+') (&Set_Break)>,
  <Bind &Ops ('-') (&Clear_Break)>,
  <Bind &Ops ('&') (&Set_Func)>,
  <Bind &Ops ('*') (&Clear_Func)>;