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

Last change on this file since 2035 was 2035, checked in by orlov, 14 years ago
  • Debug library -- simple interactive debugger.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1// $Id: Debug.rf 2035 2006-07-27 12:30:27Z orlov $
2
3$use Apply Arithm Box Compare Convert "RF_Stack" Static StdIO Table;
4
5$table Breakpoints Ops;
6
7$box Break-Depth Break? Last-Depth;
8
9Stop? e.point = \{
10  <? &Break?> : \{
11    ALL = /*yes, stop*/;
12    NO = $fail;
13  };
14  <"<=" (<Depth>) (<? &Break-Depth>)>;
15  <In-Table? &Breakpoints e.point>;
16  <In-Table? &Break-Funcs <Name <Func <"-" <Depth> 1>>>>,
17    <">" (<Depth>) (<? &Last-Depth>)>;
18  <Store &Last-Depth <Depth>> = $fail;
19},
20  <Store &Break? /*empty*/>,
21  <Store &Break-Depth 0>,
22  <Store &Last-Depth <Depth>>,
23  <Print "Stopped at "> <WriteLN e.point <"RF_Stack" 2 1>>;
24
25Debug env = {
26  $iter \{
27    <Read-Line> : s1 e2,
28      <Lookup &Ops s1> : s.op =
29      <Apply s.op e2 (env)> : e;
30    <Entries &Ops> : e ((e.key) (s.op)) e,
31      <Print e.key> <Apply s.op Help ()> : e,
32      $fail;;
33  },
34    $fail;;
35};
36
37$func? Cont e (env) = ;
38
39Cont e.arg (env) =
40  e.arg : {
41    Help = <PrintLN " continues execution (stop at the next breakpoint)">;
42    e = $fail;
43  };
44
45$func? Run e (env) = ;
46
47Run e.arg (env) =
48  e.arg : {
49    Help = <PrintLN " runs the program to the end without stopping">;
50    e =
51      <Store &Break? NO>,
52      $fail;
53  };
54
55$func? Step e (env) = ;
56
57Step e.arg (env) =
58  e.arg : {
59    Help = <PrintLN " does one step">;
60    e =
61      <Store &Break? ALL>,
62      $fail;
63  };
64
65$func? Next e (env) = ;
66
67Next e.arg (env) =
68  e.arg : {
69    Help = <PrintLN " steps program, proceeding through function calls">;
70    e =
71      <Store &Break-Depth <"-" <Depth> 2>>,
72      $fail;
73  };
74
75$func Var e (env) = ;
76
77Var e.arg (env) =
78  e.arg : {
79    Help = <PrintLN "[var-name | /*empty*/] prints value of `var-name` | all variables">;
80    v.name = {
81      env : e (v.name (e.value)) e = <WriteLN e.value>;
82      <PrintLN "No variable with name "v.name>;
83    };
84    /*empty*/ = {
85      env : e (e.name (e.value)) e,
86        <Print '.'> <Write e.name> <Print ' : '> <WriteLN e.value>,
87        $fail;;
88    };
89  };
90
91$func Set-Break e (env) = ;
92
93Set-Break e.arg (env) =
94  e.arg : {
95    Help = <PrintLN "[file-name line column] sets breakpoint at specified position">;
96    $r e.fname' 'e.line' 'e.column,
97      <Bind &Breakpoints (e.fname <To-Int e.line> <To-Int e.column>) ()>,
98      $fail;
99    e = <Print "Breakpoints: "> <WriteLN <Domain &Breakpoints>>;
100  };
101
102$func Clear-Break e (env) = ;
103
104Clear-Break e.arg (env) =
105  e.arg : {
106    Help = <PrintLN "[file-name line column] removes breakpoint from specified position">;
107    e.fname' 'e.line' 'e.column,
108      <Unbind &Breakpoints e.fname <To-Int e.line> <To-Int e.column>>,
109      $fail;
110    e = <PrintLN "Breakpoints: "> <WriteLN <Domain &Breakpoints>>;
111  };
112
113$func Set-Func e (env) = ;
114
115Set-Func e.arg (env) =
116  e.arg : {
117    Help = <PrintLN "[func-name] sets breakpoint just after entering function `func-name`">;
118    v.fname,
119      <Bind &Break-Funcs (<To-Word v.fname>) ()>,
120      $fail;
121    e = <Print "Break at functions: "> <WriteLN <Domain &Break-Funcs>>;
122  };
123
124
125$func Clear-Func e (env) = ;
126
127Clear-Func e.arg (env) =
128  e.arg : {
129    Help = <PrintLN "[func-name] clears breakpoint at function `func-name`">;
130    v.fname,
131      <Unbind &Break-Funcs <To-Word v.fname>>,
132      $fail;
133    e = <Print "Break at functions: "> <WriteLN <Domain &Break-Funcs>>;
134  };
135
136$func Init = ;
137
138Init =
139  <Store &Break-Depth 0>,
140  <Bind &Ops ('c') (&Cont)>,
141  <Bind &Ops ('s') (&Step)>,
142  <Bind &Ops ('n') (&Next)>,
143  <Bind &Ops ('r') (&Run)>,
144  <Bind &Ops ('.') (&Var)>,
145  <Bind &Ops ('+') (&Set-Break)>,
146  <Bind &Ops ('-') (&Clear-Break)>,
147  <Bind &Ops ('&') (&Set-Func)>,
148  <Bind &Ops ('*') (&Clear-Func)>;
Note: See TracBrowser for help on using the repository browser.