source: to-imperative/trunk/library/Debug/refal/Debug.rf @ 2036

// $Id: Debug.rf 2036 2006-07-27 12:42:36Z orlov $

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

$table Break-Funcs Breakpoints Ops;

$box Break-Depth Break? Last-Depth;

Stop? e.point = \{
  <? &Break?> : \{
    ALL = /*yes, stop*/;
    NO = $fail;
  };
  <"<=" (<Depth>) (<? &Break-Depth>)>;
  <In-Table? &Breakpoints e.point>;
  <In-Table? &Break-Funcs <Name <Func <"-" <Depth> 1>>>>,
    <">" (<Depth>) (<? &Last-Depth>)>;
  <Store &Last-Depth <Depth>> = $fail;
},
  <Store &Break? /*empty*/>,
  <Store &Break-Depth 0>,
  <Store &Last-Depth <Depth>>,
  <Print "Stopped at "> <WriteLN e.point <"RF_Stack" 2 1>>;

Debug env = {
  $iter \{
    <Read-Line> : 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 &Break? NO>,
      $fail;
  };

$func? Step e (env) = ;

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

$func? Next e (env) = ;

Next e.arg (env) =
  e.arg : {
    Help = <PrintLN " steps program, proceeding through function calls">;
    e =
      <Store &Break-Depth <"-" <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 '.'> <Write e.name> <Print ' : '> <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 <To-Int e.line> <To-Int 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">;
    e.fname' 'e.line' 'e.column,
      <Unbind &Breakpoints e.fname <To-Int e.line> <To-Int e.column>>,
      $fail;
    e = <PrintLN "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 (<To-Word v.fname>) ()>,
      $fail;
    e = <Print "Break at functions: "> <WriteLN <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 <To-Word v.fname>>,
      $fail;
    e = <Print "Break at functions: "> <WriteLN <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)>;