Changeset 4548 for trunk/compiler
- Timestamp:
- 10/30/08 10:26:29 (2 months ago)
- Files:
-
- 1 modified
-
trunk/compiler/logtalk.pl (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/compiler/logtalk.pl
r4543 r4548 120 120 :- dynamic('$lgt_dbg_spying_'/4). % '$lgt_dbg_spying_'(Sender, This, Self, Goal) 121 121 :- dynamic('$lgt_dbg_leashing_'/1). % '$lgt_dbg_leashing_'(Port) 122 :- dynamic('$lgt_dbg_invocation_number_'/1). % '$lgt_dbg_invocation_number_'(N) 122 123 123 124 … … 279 280 catch('$lgt_tr_msg'(Pred, Obj, Call, user), Error, '$lgt_runtime_error_handler'(error(Error, Obj::Pred, user))), 280 281 ( '$lgt_dbg_debugging_', '$lgt_debugging_'(Obj) -> 282 '$lgt_dbg_reset_invocation_number', 281 283 '$lgt_ctx_ctx'(Ctx, _, user, user, Obj, '$lgt_bio_user_0_', [], _), 282 284 '$lgt_ctx_dbg_ctx'(Ctx, DbgCtx), … … 292 294 catch('$lgt_tr_body'(Obj<<Pred, TPred, DPred, Ctx), Error, '$lgt_runtime_error_handler'(error(Error, Obj<<Pred, user))), 293 295 ( '$lgt_dbg_debugging_', '$lgt_debugging_'(Obj) -> 296 '$lgt_dbg_reset_invocation_number', 294 297 catch(DPred, Error, '$lgt_runtime_error_handler'(Error)) 295 298 ; catch(TPred, Error, '$lgt_runtime_error_handler'(Error)) … … 3598 3601 '$lgt_dbg_nospyall', 3599 3602 '$lgt_dbg_leash'(full), 3600 '$lgt_dbg_nodebug'. 3603 '$lgt_dbg_nodebug', 3604 '$lgt_dbg_reset_invocation_number'. 3601 3605 3602 3606 … … 3606 3610 ; assertz('$lgt_dbg_debugging_'), 3607 3611 retractall('$lgt_dbg_tracing_'), 3612 '$lgt_dbg_reset_invocation_number', 3608 3613 write('Debugger switched on: showing spy points for all objects compiled in debug mode.'), nl 3609 3614 ). … … 3644 3649 retractall('$lgt_dbg_debugging_'), 3645 3650 assertz('$lgt_dbg_debugging_'), 3651 '$lgt_dbg_reset_invocation_number', 3646 3652 write('Debugger switched on: tracing everything for all objects compiled in debug mode.'), nl 3647 3653 ). … … 3864 3870 '$lgt_dbg_fact'(Fact, N, DbgCtx) :- 3865 3871 ( '$lgt_dbg_debugging_', \+ '$lgt_dbg_skipping_' -> 3866 '$lgt_dbg_port'(fact(N), Fact, _, DbgCtx, Action),3872 '$lgt_dbg_port'(fact(N), _, Fact, _, DbgCtx, Action), 3867 3873 call(Action) 3868 3874 ; true … … 3872 3878 '$lgt_dbg_head'(Head, N, DbgCtx) :- 3873 3879 ( '$lgt_dbg_debugging_', \+ '$lgt_dbg_skipping_' -> 3874 '$lgt_dbg_port'(rule(N), Head, _, DbgCtx, Action),3880 '$lgt_dbg_port'(rule(N), _, Head, _, DbgCtx, Action), 3875 3881 call(Action) 3876 3882 ; true … … 3879 3885 3880 3886 '$lgt_dbg_goal'(Goal, TGoal, DbgCtx) :- 3887 '$lgt_dbg_inc_invocation_number'(N), 3881 3888 ( '$lgt_dbg_debugging_', \+ '$lgt_dbg_skipping_' -> 3882 ( '$lgt_dbg_port'(call, Goal, _, DbgCtx, CAction),3889 ( '$lgt_dbg_port'(call, N, Goal, _, DbgCtx, CAction), 3883 3890 ( CAction == ignore -> 3884 3891 true 3885 3892 ; call(CAction), 3886 catch(TGoal, Error, '$lgt_dbg_exception'( Goal, Error, DbgCtx)),3887 ( '$lgt_dbg_port'(exit, Goal, _, DbgCtx, EAction),3893 catch(TGoal, Error, '$lgt_dbg_exception'(N, Goal, Error, DbgCtx)), 3894 ( '$lgt_dbg_port'(exit, N, Goal, _, DbgCtx, EAction), 3888 3895 call(EAction) 3889 ; '$lgt_dbg_port'(redo, Goal, _, DbgCtx, RAction),3896 ; '$lgt_dbg_port'(redo, N, Goal, _, DbgCtx, RAction), 3890 3897 RAction == ignore 3891 3898 ) 3892 3899 ; retractall('$lgt_dbg_skipping_'), 3893 '$lgt_dbg_port'(fail, Goal, _, DbgCtx, _),3900 '$lgt_dbg_port'(fail, N, Goal, _, DbgCtx, _), 3894 3901 fail 3895 3902 ) … … 3900 3907 3901 3908 3902 '$lgt_dbg_exception'(_, logtalk_debugger_aborted, _) :-3909 '$lgt_dbg_exception'(_, _, logtalk_debugger_aborted, _) :- 3903 3910 throw(logtalk_debugger_aborted). 3904 3911 3905 '$lgt_dbg_exception'( Goal, Error, DbgCtx) :-3906 '$lgt_dbg_port'(exception, Goal, Error, DbgCtx, TAction),3912 '$lgt_dbg_exception'(N, Goal, Error, DbgCtx) :- 3913 '$lgt_dbg_port'(exception, N, Goal, Error, DbgCtx, TAction), 3907 3914 ( TAction == fail -> 3908 3915 fail … … 3911 3918 3912 3919 3913 '$lgt_dbg_port'(Port, Goal, Error, DbgCtx, Action) :-3920 '$lgt_dbg_port'(Port, N, Goal, Error, DbgCtx, Action) :- 3914 3921 '$lgt_dbg_debugging_', 3915 3922 !, 3916 3923 ( '$lgt_dbg_leashing'(Port, Goal, DbgCtx, Code) -> 3917 3924 repeat, 3918 write(Code), '$lgt_dbg_write_port_name'(Port), writeq(Goal), write(' ? '),3925 write(Code), '$lgt_dbg_write_port_name'(Port), '$lgt_dbg_write_invocation_number'(Port, N), writeq(Goal), write(' ? '), 3919 3926 catch('$lgt_read_single_char'(Option), _, fail), 3920 3927 '$lgt_dbg_valid_port_option'(Option, Port, Code), … … 3922 3929 ! 3923 3930 ; ( '$lgt_dbg_tracing_' -> 3924 write(' '), '$lgt_dbg_write_port_name'(Port), writeq(Goal), nl3931 write(' '), '$lgt_dbg_write_port_name'(Port), '$lgt_dbg_write_invocation_number'(Port, N), writeq(Goal), nl 3925 3932 ; true 3926 3933 ), … … 3928 3935 ). 3929 3936 3930 '$lgt_dbg_port'(_, _, _, _, true). 3937 '$lgt_dbg_port'(_, _, _, _, _, true). 3938 3939 3940 '$lgt_dbg_write_invocation_number'(fact(_), _) :- !. 3941 '$lgt_dbg_write_invocation_number'(rule(_), _) :- !. 3942 '$lgt_dbg_write_invocation_number'(_, N) :- 3943 write('('), write(N), write(') '). 3931 3944 3932 3945 3933 3946 '$lgt_dbg_write_port_name'(fact(N)) :- 3934 3947 ( N =:= 0 -> 3935 write(' 3936 ; write(' Fact('), write(N), write('): ')3948 write(' Fact: ') 3949 ; write(' Fact #'), write(N), write(': ') 3937 3950 ). 3938 3951 '$lgt_dbg_write_port_name'(rule(N)) :- 3939 3952 ( N =:= 0 -> 3940 write(' 3941 ; write(' Rule('), write(N), write('): ')3953 write(' Rule: ') 3954 ; write(' Rule #'), write(N), write(': ') 3942 3955 ). 3943 3956 '$lgt_dbg_write_port_name'(call) :- 3944 write(' 3957 write(' Call: '). 3945 3958 '$lgt_dbg_write_port_name'(exit) :- 3946 write(' 3959 write(' Exit: '). 3947 3960 '$lgt_dbg_write_port_name'(redo) :- 3948 write(' 3961 write(' Redo: '). 3949 3962 '$lgt_dbg_write_port_name'(fail) :- 3950 write(' 3963 write(' Fail: '). 3951 3964 '$lgt_dbg_write_port_name'(exception) :- 3952 write(' 3965 write(' Exception: '). 3953 3966 3954 3967 … … 4036 4049 functor(Goal, Functor, Arity), 4037 4050 functor(CGoal, Functor, Arity), 4038 write(' 4051 write(' Enter a context spy point term formatted as (Sender, This, Self, Goal): '), 4039 4052 read(Spypoint), 4040 4053 Spypoint = (Sender, This, Self, CGoal), … … 4046 4059 4047 4060 '$lgt_dbg_do_port_option'(@, _, _, _, _, _) :- 4048 write(' 4061 write(' ?- '), 4049 4062 read(Goal), 4050 4063 call(Goal) -> … … 4056 4069 break, 4057 4070 '$lgt_dbg_resume'(Tracing) 4058 ; write(' 4071 ; write(' break no supportd by the back-end Prolog compiler.'), nl 4059 4072 ), 4060 4073 fail. … … 4068 4081 4069 4082 '$lgt_dbg_do_port_option'(d, _, Goal, _, _, _) :- 4070 write(' 4083 write(' Current goal: '), write_term(Goal, [ignore_ops(true)]), nl, 4071 4084 fail. 4072 4085 4073 4086 '$lgt_dbg_do_port_option'(x, _, _, _, DbgCtx, _) :- 4074 4087 '$lgt_dbg_ctx'(DbgCtx, Sender, This, Self), 4075 write(' 4076 write(' 4077 write(' 4088 write(' Sender: '), writeq(Sender), nl, 4089 write(' This: '), writeq(This), nl, 4090 write(' Self: '), writeq(Self), nl, 4078 4091 fail. 4079 4092 4080 4093 '$lgt_dbg_do_port_option'(e, _, _, Error, _, _) :- 4081 write(' 4094 write(' Exception term: '), writeq(Error), nl, 4082 4095 fail. 4083 4096 4084 4097 '$lgt_dbg_do_port_option'(h, _, _, _, _, _) :- 4085 write(' 4086 write(' 4087 write(' 4088 write(' 4089 write(' 4090 write(' 4091 write(' 4092 write(' 4093 write(' 4094 write(' 4095 write(' 4096 write(' 4097 write(' 4098 write(' 4099 write(' 4100 write(' 4101 write(' 4102 write(' 4103 write(' 4104 write(' 4105 write(' 4098 write(' Available options are:'), nl, 4099 write(' c - creep (go on; you may use also the spacebar, return, or enter keys)'), nl, 4100 write(' l - leap (continues execution until the next spy point is found)'), nl, 4101 write(' s - skip (skips debugging for the current goal; only meaningful at call and redo ports)'), nl, 4102 write(' i - ignore (ignores goal, assumes that it succeeded; only valid at call and redo ports)'), nl, 4103 write(' f - fail (forces backtracking; may also be used to convert an exception into a failure)'), nl, 4104 write(' n - nodebug (turns off debugging)'), nl, 4105 write(' ! - command (reads and executes a query)'), nl, 4106 write(' @ - command (reads and executes a query)'), nl, 4107 write(' b - break (suspends execution and starts new interpreter; type end_of_file to terminate)'), nl, 4108 write(' a - abort (returns to top level interpreter)'), nl, 4109 write(' q - quit (quits Logtalk)'), nl, 4110 write(' d - display (writes current goal without using operator notation)'), nl, 4111 write(' x - context (prints execution context)'), nl, 4112 write(' e - exception (prints exception term thrown by current goal)'), nl, 4113 write(' = - debugging (prints debugging information)'), nl, 4114 write(' * - add (adds a context spy point for current goal)'), nl, 4115 write(' + - add (adds a predicate spy point for current goal)'), nl, 4116 write(' - - remove (removes a predicate spy point for current goal)'), nl, 4117 write(' h - help (prints this list of options)'), nl, 4118 write(' ? - help (prints this list of options)'), nl, 4106 4119 fail. 4107 4120 4108 4121 '$lgt_dbg_do_port_option'(?, Port, Goal, Error, DbgCtx, Action) :- 4109 4122 '$lgt_dbg_do_port_option'(h, Port, Goal, Error, DbgCtx, Action). 4123 4124 4125 4126 '$lgt_dbg_inc_invocation_number'(New) :- 4127 retract('$lgt_dbg_invocation_number_'(Old)) -> 4128 New is Old + 1, 4129 asserta('$lgt_dbg_invocation_number_'(New)). 4130 4131 4132 '$lgt_dbg_reset_invocation_number' :- 4133 retractall('$lgt_dbg_invocation_number_'(_)), 4134 asserta('$lgt_dbg_invocation_number_'(0)). 4110 4135 4111 4136
