SWI-Prolog / packages-xpce

The graphics toolkit for SWI-Prolog
16 stars 14 forks source link

guitrace edcg grammar #24

Open kwon-young opened 2 years ago

kwon-young commented 2 years ago

Hello,

First of all, merry christmas !

I'm having some trouble to debug a grammar written using the edcg library.

Here is a simple example from the library:

:- use_module(library(edcg)).

% Declare accumulators
edcg:acc_info(adder, X, In, Out, plus(X,In,Out)).

% Declare predicates using these hidden arguments
edcg:pred_info(len,0,[adder,dcg]).
edcg:pred_info(increment,0,[adder]).

increment -->>
    [1]:adder.  % add one to the accumulator

len(Xs,N) :-
    len(0,N,Xs,[]).

len -->>
    [_],  % 'dcg' accumulator has an element
    !,
    increment,  % increment the 'adder' accumulator
    len.
len -->>
    [].

Launching the gui debugger using gtrace, len([a],1)., I can correctly creep into len but not into increment. I also get this error:

[trace]  ?- gtrace, len([a],1).
ERROR: is/2: Arguments are not sufficiently instantiated
true.

Using the command line tracer I obtain:

[trace]  ?- trace, len([a],1).
   Call: (11) len([a], 1) ? creep
   Call: (12) len(0, 1, [a], []) ? creep
   Call: (13) true ? creep
   Exit: (13) true ? creep
   Call: (13) increment(0, _18554) ? creep
   Call: (14) plus(1, 0, _18554) ? creep
   Exit: (14) plus(1, 0, 1) ? creep
   Call: (14) true ? creep
   Exit: (14) true ? creep
   Exit: (13) increment(0, 1) ? creep
   Call: (13) len(1, 1, [], []) ? creep
   Exit: (13) len(1, 1, [], []) ? creep
   Exit: (12) len(0, 1, [a], []) ? creep
   Exit: (11) len([a], 1) ? creep
true.

I'm available if you need any help in order to resolve this issue, although I've never used xpce before.

kamahen commented 2 years ago

This appears to be a caused by gtrace/0 when handling certain kinds of expansion (perhaps when trying to find the source location?). When I tried to reproduce the problem with the expanded code, it worked fine. For reference, here's the expanded code:

increment(A, B) :-
    plus(1, A, B),
    true.

len(Xs, N) :-
    len(0, N, Xs, []).

len(A, B, [_|C], D) :-
    true,
    !,
    increment(A, E),
    len(E, B, C, D).
len(A, A, B, B).

The problem also showed when I replaced the definition of edcg:acc_info with

edcg:acc_info(adder, X, In, Out, Out is X+In).

I tried wrapping with catch_with_backtrace/3, but couldn't get any additional information.

kwon-young commented 2 years ago

I've found out recently that the difference that allows the gui debugger to trace len without problem but fails to correctly trace increment is that len is using the dcg accumulator and consume an element of the dcg accumulator ([_]) which modified the body and head of the clause.

My very ugly workaround for now is to add a dcg accumulator and add [_] at the start of each grammar clauses ...

Is there some specific workaround for dcg grammar in the gui debugger ?

JanWielemaker commented 2 years ago

I tried the example. Works fine for me (using current development version). Please be more precise about the versions and what you did exactly to produce this.

kamahen commented 2 years ago

Indeed, it works for me with the current development version, and crashes with 8.5.4-23-g92b15f1de-DIRTY (the "DIRTY" is my changes to PCRE, which shouldn't be relevant).

kamahen commented 2 years ago

And it also throws a "not sufficiently instantiated" error with 8.5.4-35-g1bba33785-DIRTY.

kwon-young commented 2 years ago

Sorry, should have done this from the start.

Operating System: Fedora Linux 35
KDE Plasma Version: 5.23.3
KDE Frameworks Version: 5.88.0
Qt Version: 5.15.2
Kernel Version: 5.15.10-200.fc35.x86_64 (64-bit)
Graphics Platform: X11
Processors: 8 × Intel® Core™ i7-7820HQ CPU @ 2.90GHz
Memory: 31.2 GiB of RAM
Graphics Processor: Mesa Intel® HD Graphics 630
$ dnf info pl
Installed Packages
Name         : pl
Version      : 8.4.1
Release      : 1.fc35
Architecture : x86_64
Size         : 14 M
Source       : pl-8.4.1-1.fc35.src.rpm
Repository   : @System
From repo    : updates
Summary      : SWI-Prolog - Edinburgh compatible Prolog compiler
URL          : https://www.swi-prolog.org/
License      : (GPLv2+ with exceptions or Artistic 2.0) and (GPL+ or Artistic) and (BSD or GPL+) and TCL and UCD and MIT and BSD and Public Domain
Description  : ISO/Edinburgh-style Prolog compiler including modules, auto-load,
             : libraries, Garbage-collector, stack-expandor, C/C++-interface,
             : GNU-readline interface, very fast compiler.  Including packages clib
             : (Unix process control and sockets), cpp (C++ interface), sgml (reading
             : XML/SGML), sgml/RDF (reading RDF into triples).
             :
             : XPCE (Graphics UI toolkit, integrated editor (Emacs-clone) and source-level
             : debugger) is available in pl-xpce package.
JanWielemaker commented 2 years ago

It fails to reproduce for me. Saved the file as f.pl, run

swipl f.pl ?- gtrace, len([a],1).

Tracing works fine. Only len/4 is shown in decompiled version rather than as source code. That is to be expected (and requires the edgc library to use the expansion predicates that also allow for rewriting the layout information or hook into the debugger to tell the debugger how the source term relates to the compiled term).

@kamahen, the error probably happens in the debugger thread, so you can't catch it in the main thread. Errors inside the debugger are a bit nasty to debug. My typical solution is to run under gdb and set a breakpoint on PL_error(). Then, if the correct error is trapped, using (gdb) call PL_backtrace(25,0) to get a Prolog backtrace.

kwon-young commented 2 years ago

Tracing works fine.

Just to be sure, are you able to step through inside increment and plus ?

In my case, I am able to reproduce the problem even after compiling swipl-devel master branch from source.

kamahen commented 2 years ago

I've been able to reproduce the problem on two systems (Ubuntu 20.0.4 and a Chromebook). I might have time later today (Pacific Time) to run this with gdb and try to get a traceback using gdb. I vaguely remember a similar problem showing up a while ago, but can't remember the details.

kamahen commented 2 years ago

Here's the backtrace:

     [38] _89564 is _89562+1
     [35] pce_prolog_tracer:show_source(245, [pc(exit), port(exit), style(exit), source, bindings])
     [34] pce_prolog_tracer:prolog_show_frame(245, [pc(exit), port(exit), style(exit), source, bindings])
     [32] pce_prolog_tracer:show(245, 255, 0, exit)
     [31] pce_prolog_tracer:do_intercept_(exit, 245, 255, _87816)
     [30] setup_call_catcher_cleanup(pce_prolog_tracer:true, pce_prolog_tracer:do_intercept_(exit, 245, 255, _87816), _91696, pce_prolog_tracer:notrace(set_prolog_flag(access_level, user)))
     [26] pce_prolog_tracer:intercept_(exit, 245, 255, _87676)
     [25] setup_call_catcher_cleanup(pce_prolog_tracer:true, pce_prolog_tracer:intercept_(exit, 245, 255, _87676), _92494, pce_prolog_tracer:notrace(set_prolog_flag(access_level, user)))
     [21] '$c_call_prolog'
     [20] notrace(intercept(exit, 245, 255, _87676))
     [19] pce_prolog_tracer:prolog_trace_interception_gui(exit, 245, 255, _87592)
     [18] setup_call_catcher_cleanup(pce_prolog_tracer:true, pce_prolog_tracer:prolog_trace_interception_gui(exit, 245, 255, _87592), _94068, pce_prolog_tracer:notrace(set_prolog_flag(access_level, user)))
     [14] '$c_call_prolog'
     [13] increment(0, 1)
     [12] len(0, 1, [a], [])
     [11] len([a], 1)
     [10] '<meta-call>'(user:user:(gtrace, len([a], 1)))
      [9] toplevel_call(user:user:(gtrace, len([a], 1)))
      [8] stop_backtrace(user:user:(gtrace, len([a], 1)), _26086)
      [7] '$wfs_call'('$toplevel':stop_backtrace(user:user:(gtrace, len([a], 1)), _26086), user:_26084)
      [5] '$execute_goal2'(user:(gtrace, len([a], 1)), [], true)
      [3] '$query_loop'
      [2] '$runtoplevel'
      [1] '$toplevel'
      [0] '$c_call_prolog'
kamahen commented 2 years ago

I don't know if this is relevant, but when I also got another call to PL_error (which was suppressed?). This happened when I initially ran gtrace,len([a],1).:

?- gtrace,len([a],1).
[New Thread 0x7ffff5155700 (LWP 1929888)]
% The graphical front-end will be used for subsequent tracing
[Switching to Thread 0x7ffff5155700 (LWP 1929888)]

Thread 3 "pce" hit Breakpoint 1, PL_error (pred=pred@entry=0x0, arity=arity@entry=0, 
    msg=msg@entry=0x0, id=id@entry=ERR_TYPE) at ../src/pl-error.c:106
106 { GET_LD
(gdb) call PL_backtrace(25,0)
     [98] variant_hash(f(f(f(f(f(f(f(f(f(...))))))))), _52796)
     [97] '<meta-call>'(nb_set:(f(f(f(f(f(f(...))))))=f(f(f(f(f(f(...)))))), variant_hash(f(f(f(f(f(f(...)))))), _52796)))
     [96] catch(nb_set:(f(f(f(f(f(f(...))))))=f(f(f(f(f(f(...)))))), variant_hash(f(f(f(f(f(f(...)))))), _52796)), _52862, nb_set:fail)
     [95] '$eval_if'(catch((f(f(f(f(f(f(...))))))=f(f(f(f(f(f(...)))))), variant_hash(f(f(f(f(f(f(...)))))), _52796)), _52862, fail))
     [94] catch('$expand':'$eval_if'(catch((f(f(f(f(...))))=f(f(f(f(...)))), variant_hash(f(f(f(f(...)))), _52796)), _52862, fail)), _52962, '$expand':(print_message(error, _52962), fail))
     [93] cond_compilation((:-if(catch((f(f(f(f(...))))=f(f(f(f(...)))), variant_hash(f(f(f(f(...)))), _52796)), _52862, fail))), [])
     [92] expand_term((:-if(catch((f(f(f(f(...))))=f(f(f(f(...)))), variant_hash(f(f(f(f(...)))), _52796)), _52862, fail))), term_position(4286, 4338, 4286, 4288, [term_position(4289, 4338, 4289, 4291, [term_position(4292, 4337, 4292, 4297, [parentheses_term_position(4298, 4327, term_position(4299, 4326, 4307, 4308, [...|...])), 4329-4330, ... - ...])])]), [], _52934)
     [90] catch(system:'$expand_term'((:-if(catch((f(f(...))=f(f(...)), variant_hash(f(f(...)), _52796)), _52862, fail))), term_position(4286, 4338, 4286, 4288, [term_position(4289, 4338, 4289, 4291, [term_position(4292, 4337, 4292, 4297, [parentheses_term_position(..., ..., ...)|...])])]), [], _52934), error(_52922, _52924), system:'$print_message_fail'(error(_52922, _52924)))
     [89] '$expanded_term'(<stream>(0x55555685ea00),  (:-if(catch((f(f(f(f(...))))=f(f(f(f(...)))), variant_hash(f(f(f(f(...)))), _52796)), _52862, fail))), term_position(4286, 4338, 4286, 4288, [term_position(4289, 4338, 4289, 4291, [term_position(4292, 4337, 4292, 4297, [parentheses_term_position(4298, 4327, term_position(4299, 4326, 4307, 4308, [...|...])), 4329-4330, ... - ...])])]), _50236, _50238, _50232, _50234, _50240, ['/home/peter/src/swipl-devel/build/home/library/nb_set.pl'], [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [88] '$term_in_file'(<stream>(0x55555685ea00), _50236, _50238, _50232, _50234, _50240, ['/home/peter/src/swipl-devel/build/home/library/nb_set.pl'], [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [87] setup_call_catcher_cleanup(system:'$open_source'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', <stream>(0x55555685ea00), close(<stream>(0x55555685ea00), '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', <clause>(0x5555569acd20)), [], [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])]), system:'$term_in_file'(<stream>(0x55555685ea00), _50236, _50238, _50232, _50234, _50240, ['/home/peter/src/swipl-devel/build/home/library/nb_set.pl'], [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])]), _57054, system:'$close_source'(close(<stream>(0x55555685ea00), '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', <clause>(0x5555569acd20)), true))
     [84] '$source_term'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', _50236, _50238, _50232, _50234, _50240, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [83] '$load_file'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', _50112, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [82] setup_call_catcher_cleanup(system:'$start_consult'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', 1633028666.0), system:'$load_file'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', _50112, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])]), _58248, system:'$end_consult'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', lexstate(202, swi), solution_sequences))
     [79] '$consult_file'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences, compiled, _50112, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [78] '$do_load_file_2'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences, compiled, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [75] '$qdo_load_file'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [73] setup_call_catcher_cleanup(system:with_mutex('$load_file', '$mt_start_load'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', <clause>(0x5555569b3680), [if(not_loaded), must_be_module(true), imports([... / ...])])), system:'$mt_do_load'(<clause>(0x5555569b3680), '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])]), _59836, system:'$mt_end_load'(<clause>(0x5555569b3680)))
     [71] '$c_call_prolog'
     [70] sig_atomic(setup_call_cleanup(with_mutex('$load_file', '$mt_start_load'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', <clause>(0x5555569b3680), [if(not_loaded), must_be_module(true), imports([... / ...])])), '$mt_do_load'(<clause>(0x5555569b3680), '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', '/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])]), '$mt_end_load'(<clause>(0x5555569b3680))))
     [67] '$load_file'('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences, [if(not_loaded), must_be_module(true), imports([empty_nb_set/1])])
     [62] do_autoload('/home/peter/src/swipl-devel/build/home/library/nb_set.pl', solution_sequences:empty_nb_set/1, nb_set)
     [60] setup_call_catcher_cleanup('$autoload':leave_sandbox(false), '$autoload':'$autoload3'(solution_sequences:empty_nb_set/1), _61796, '$autoload':restore_sandbox(false))
     [57] setup_call_catcher_cleanup('$autoload':'$start_aux'('/tmp/e.pl', []), '$autoload':'$autoload2'(solution_sequences:empty_nb_set/1), _62192, '$autoload':'$end_aux'('/tmp/e.pl', []))
     [54] '$undefined_procedure'(solution_sequences, empty_nb_set, 1, _46854)
(gdb) cont
JanWielemaker commented 2 years ago

Not all exceptions are wrong :smile: This comes from

:- if(catch((A = f(A), variant_hash(A,_)), _, fail)).
hash_key(Term, BCount, Key) :-
...
JanWielemaker commented 2 years ago

[38] _89564 is _89562+1 [35] pce_prolog_tracer:show_source(245, [pc(exit), port(exit), style(exit), source, bindings])

Unfortunately we have thee missing frames, so know little more than that we are dealing with trying to show the source code :cry: You can try first (but after starting the gui tools such that xpce is running):

?- thread_signal(pce, debug).

That will hopefully give a complete stack trace.

kwon-young commented 2 years ago

I've followed the code for pce_prolog_tracer:show_source and I believe the missing frames are the following:

Here is the code of clause_end:

clause_end(ClauseRef, File, CharA, CharZ) :-
    pce_clause_info(ClauseRef, File, TPos, _),
    nonvar(TPos),
    arg(2, TPos, CharA),
    CharZ is CharA + 1.

The problem is that CharA is not defined and after some more debugging, I found out that `TPos is not grounded:

term_position(_129142,_129144,_129146,_129148,[_129154,_129160])

So I tried to query the clause_info for the increment clause and voilà:

?- debug(clause_info), nth_clause(increment(1, 2), 1, Ref), clause_info(Ref, File, TermPos, Vars).
% clause_info(<clause>(0xedef30)) (1-st clause of increment/2)... 
% from /home/kwon-young/prog/DMOS-prolog/test_edcg.pl:10 ... 
% read ...
% unified ...
% got names

Ref = <clause>(0xedef30),
File = '/home/kwon-young/prog/DMOS-prolog/test_edcg.pl',
TermPos = term_position(_, _, _, _, [_, _]),
Vars = varnames('_', '_').

I'll try to debug clause_info next to try to understand why it can't get to term position in the file.

JanWielemaker commented 2 years ago

Thanks. That explains fine the error. What I don't get is why it works for me:

?- debug(clause_info), nth_clause(increment(1, 2), 1, Ref), clause_info(Ref, File, TermPos, Vars).
% clause_info(<clause>(0x55fbfc8c3320)) (1-st clause of increment/2)... 
% from /home/janw/src/swipl-devel/linux/edcg.pl:10 ... 
% read ...
% unified ...
% got names

Ref = <clause>(0x55fbfc8c3320),
File = '/home/janw/src/swipl-devel/linux/edcg.pl',
TermPos = term_position(228, 256, 238, 242, [228-237, term_position(247, 256, 250, 251, [list_position(247, 250, [248-249], none), 251-256])]),
Vars = varnames('_', '_').

Just to be sure, attached is the file I used. For edcg I use:

?- pack_info(edcg).
Package:                edcg
Title:                  Extended DCG
Installed version:      0.9.1.5
Installed in directory: /home/janw/.local/share/swi-prolog/pack/edcg
Author:                 Peter Van Roy <peter.vanroy@uclouvain.be>
Maintainer:             Peter Ludemann <peter.ludemann@gmail.com>
Packager:               Michael Hendricks <michael@ndrix.org>
Home page:              https://github.com/kamahen/edcg
Download URL:           https://github.com/kamahen/edcg/archive/*.zip
Provided libraries:     edcg

edcg.pl.txt

kwon-young commented 2 years ago

Ah, I'm using a more recent version of edcg:

?- pack_info(edcg).
Package:                edcg
Title:                  Extended DCG
Installed version:      0.9.1.7
Installed in directory: /home/kwon-young/.local/share/swi-prolog/pack/edcg
Author:                 Peter Van Roy <peter.vanroy@uclouvain.be>
Maintainer:             Peter Ludemann <peter.ludemann@gmail.com>
Packager:               Michael Hendricks <michael@ndrix.org>
Home page:              https://github.com/kamahen/edcg
Download URL:           https://github.com/kamahen/edcg/archive/*.zip
Provided libraries:     edcg
true.
kwon-young commented 2 years ago

So I found this in edcg source code:

% term_expansion/4 is used to work around SWI-Prolog's attempts to
% match variable names when doing a listing (or interactive trace) and
% getting confused; this sometimes results in a strange error message
% for an unknown extended_pos(Pos,N).

% Returning a variable for _Layout2 means "I don't know".
% See https://swi-prolog.discourse.group/t/strange-warning-message-from-compile-or-listing/3774

% TODO: support ((H,PB-->>B) [same as regular DCG]
user:term_expansion((H-->>B), _Layout1, Expansion, _Layout2) :-
    user:term_expansion((H-->>B), Expansion).
user:term_expansion((H,PB==>>B), _Layout1, Expansion, _Layout2) :-
    user:term_expansion((H,PB==>>B), Expansion).
user:term_expansion((H==>>B), _Layout1, Expansion, _Layout2) :-
    user:term_expansion((H==>>B), Expansion).

By unifying _Layout1 and _Layout2 into a single variable Layout, The gui debugger can trace the execution of the grammar at the source level for increment but len is being trace at the user or decompiled level:

Screenshot_20220107_141848

Screenshot_20220107_141928

This reminded me that when I was working in my PhD with a custom grammar and obscure prolog implementation, we had a debugger that was able to switch views between the source level and decompiled level, so that we could see the variables used in the grammar at the source level, or see all the accumulators values when switching to the decompiled view.

kamahen commented 2 years ago

I'm a bit confused ... should I change the edcg code to have _Layout1=_Layout2, or does someone need to figure out why clause_info isn't getting the term position, or both?

(Changing edcg to have proper term_expansion/4 is rather low on my "todo" list, I'm afraid ... partly because I don't use trace or gtrace much for EDCGs)

JanWielemaker commented 2 years ago

Ideally term_expansion/4 should translate the layout. I've pushed a fix that should stop the instantiation error. Without layout info you'll typically (always?) end up with the decompiled code in the debugger. Translating the layout can be a nasty job. You need to produce a layout term that is consistent with the output of the term expansion (defined with read_term/2). You may use variables to indicate "don't know". For proper operation of the debugger you only need to get the overall clause (:-/2 term), the head position and the body subclause positions right. It is ok to leave the argument locations undefined.

Eventually we must make something better. I've tried to automate this, doing it heuristically by finding where sub-terms move during the translation. This worked to some extend, but finishing the project stalled due to too many other duties. An alternative could be a more high level description of what moves where or maybe a restricted form of term expansion where the tooling could inspect the expansion rules to understand what happened.

kwon-young commented 2 years ago

I agree that computing the layout of the produce term is a very difficult job. Maybe I'll try to implement this in edcg in the future as I'm using the gui debugger extensively with one of my project.

For now, the last fix from Jan does remove the instantiation error but the gui debugger still does not creep into the increment term and I think this behavior is still faulty. The debugger should at least be able to creep inside the decompiled code of increment.

I'll try to find a solution to this and make a pr as I've started to get familiar with debugging the debugger :)

kwon-young commented 2 years ago

Here is one weird thing that I have found:

clause_info/4 succeed on increment/2 but fails on len/4:

?- debug(clause_info), nth_clause(increment(0, 1), 1, Ref), clause_info(Ref, File, TermPos, Vars).
% clause_info(<clause>(0x2142f30)) (1-st clause of increment/2)... 
% from /home/kwon-young/prog/DMOS-prolog/test_edcg.pl:10 user... 
% read ...
% unified ...
% got names

Ref = <clause>(0x2142f30),
File = '/home/kwon-young/prog/DMOS-prolog/test_edcg.pl',
TermPos = term_position(_, _, _, _, [_, _]),
Vars = varnames('_', '_').

?- debug(clause_info), nth_clause(len(0, X, [a], []), 1, Ref), clause_info(Ref, File, TermPos, Vars).
% clause_info(<clause>(0x21518c0)) (1-st clause of len/4)... 
% from /home/kwon-young/prog/DMOS-prolog/test_edcg.pl:17 user... 
% read ...
% Could not unify clause
false.

After some debugging, I think that the reason that clause_info/4 fails on len/4 is because it fails at unifying the body of the clause. I need to dig a little deeper to understand why.

This means that the gui debugger is somehow able to :

JanWielemaker commented 2 years ago

clause_info failing on source clauses is fine. That normally should make it revert to listing the clause and then compute the clause info not for the actual source code but for the decompiled version. That should always succeed. At least, that is how I have the story in my head ...

kamahen commented 2 years ago

@kwon-young wrote "the gui debugger still does not creep into the increment term"

Do you get the same behavior with the non-gui debugger?

Perhaps the call to increment has been optimized, so would only show if you run with "debug" mode? (Or maybe it's only backtrace that needs "debug" mode to show everything ...)

kamahen commented 2 years ago

@kwon-young If you improve edcg's term_expansion/4, I'll happily take a PR. And any other improvements while you're at it -- I'm not terribly happy with the need to declare all edcg expansions before any use; it would be nice to be able to declare the EDCG expansion info with the predicate, e.g.:

:- edcg(increment//0, [adder]).
increment -->> [1]:adder.

:- edcg(len//0, [adder,dcg]). % This declaration is after the first use
len -->> [_], !, increment, len.
len -->> [].

Perhaps this could be done by 2-pass expansion, by adding a term_expansion on end_of_input ... there was some discussion here: https://swi-prolog.discourse.group/t/multi-pass-compilation-for-term-expansion/2196

JanWielemaker commented 2 years ago

Indeed, increment/2 is not traced. I think the problem is that the debugger reads the source term, calls term_expansion/4 to expect that to return a term layout. As the term is nicely expanded and a layout is returned, it is happy. Next the debugger tries to show the source given the layout, but fails. The best solution is surely to return a proper layout term. Alternatively we could consider to reject the layout if it is critically unbound. I've pushed a patch to library(clause_info) of the main repo to address this. At least you can now trace through all the code in decompiled format.

kwon-young commented 2 years ago

@JanWielemaker I've pushed a patch to library(clause_info) of the main repo to address this. At least you can now trace through all the code in decompiled format.

Thank you very much for this !

@kamahen If you improve edcg's term_expansion/4, I'll happily take a PR.

Well, I'll try since I would really benefit from this.

I'm not terribly happy with the need to declare all edcg expansions before any use; it would be nice to be able to declare the EDCG expansion info with the predicate

This seems like a really hard problem to solve with my little knowledge of prolog ... So, maybe one day, but don't expect anything from me.

i believe this issue can be closed now since the main problem was resolved.

kamahen commented 2 years ago

@kwon-young The 2-pass processing can be mostly done independently of improving the term_expansion/4, I think.

I'm going to make a small change to the code, which should simplify integrating your changes and my 2-pass changes. (Hopefully, I'll do that today or tomorrow.)

kamahen commented 2 years ago

It looks pretty straightforward although tedious to put the proper position information into term_expansion/4. My main concern is typos -- the set of test cases is rather small (the change will also make the code even more unreadable).

It also appears that I'd need to create a prolog_clause:make_varnames_hook/5 to properly deal with the extra arguments that are created. I should be able to use the code in the 2nd clause of prolog_clause:make_varnames/5 as a basis for this.

@kwon-young - Please wait a few days before starting to work on this -- I think I can make the changes quickly if higher priority things don't get in the way.

(PS: @JanWielemaker - clicking on "make_varnames_hook/5" in https://www.swi-prolog.org/pldoc/doc_for?object=prolog_clause%3Amake_varnames/5 gives a 403 error: "You don't have permission to access /home/jan/src/plweb/pack/mirror/GIT/xlibrary/prolog/mapnlist.pl on this server")

kwon-young commented 2 years ago

It looks pretty straightforward although tedious

@kamahen I can do tedious work without a problem :) Let me know when you think I can start working on this.

kamahen commented 2 years ago

@kwon-young - I'm about half-way through a set of changes; but I won't be able to do more work on it until Tuesday (Pacific Time). I'd need to finish this set of changes before giving it to you for the "tedious" work. ;)

In the meantime, perhaps you could look at the tests, which are run by find t -name '*.pl' | xargs -L1 swipl -g run_tests -g halt:

Here's some debugging code that recursively processes a term with its position information, and might be useful: https://gist.github.com/kamahen/a74f67d1fc2dcd6325d0a326a842fb3f I'll be calling that code as part of term_expansion/4, but it's not sufficient - it only verifies that the "location" (or TermPos) structure has the expected "shape" for the expanded term:

edcg_term_expansion(Term, Expansion, TermPos0, TermPos) :-
    edcg_term_expansion_(Term, Expansion, TermPos0, TermPos),
    assertion(valid_termpos(Expansion, TermPos)).
JanWielemaker commented 2 years ago

@kwon-young The 2-pass processing can be mostly done independently of improving the term_expansion/4, I think.

Well, you need to be careful to pass on the clause location information if you do two pass compilation. If you temporary store a term you need to call source_location/2 and store the file and line. Then when you do the actual expansion at a later stage you must create the terms as

'$source_location'(File,Line):Clause.
kamahen commented 2 years ago

@JanWielemaker Why would the expansion need $source_location'(File,Line):Clause. if the result of term_expansion/4 contains the correct Layout information? My idea is that each -->> clause would be saved with its Layout information, and the end_of_file would trigger processing them all, generating a list of expanded clauses and a list of layouts -- I presume that term_expansion/4 can return a list of clauses and a list of locations, similar to the way term_expansion/2 can return a list of clauses. On the other hand, Paul Moura has an alternative way of doing this, which might be better: https://swi-prolog.discourse.group/t/multi-pass-compilation-for-term-expansion/2196/2

JanWielemaker commented 2 years ago

That is not the way the gui tracer works. The compiler just stores the file and line of the clause. The gui tracer reads the clause to get the raw term and its layout info. It then needs to do the magic to relate this to the actual (transformed) clause and produce layout information for that. One of its steps is that it tries calling term_expansion/4 to see whether the source term+layout is transformed into the target clause+layout. If that fails it has a number of rules and heuristics as well as a hook that allows packages to do the matching. See library(prolog_clause).

So, all the compiler needs to do is to ensure the source file:line is correct. If it clause is immediately asserted this is provided by source_location/2, which records this info from the last read term. If you create the clause later you must remember this location and pass it on.

kamahen commented 2 years ago

The guitracer's design makes 2-pass term_expansion rather tricky, if not impossible. I'll have to rethink things - and there are other issues, such as making edcg play nicely with modules.

Anyway, it seems that besides term_expansion/4, I also need define prolog_clause:make_varnames_hook/5 and prolog_clause:unify_clause_hook/5. Anything else?

JanWielemaker commented 2 years ago

The guitracer's design makes 2-pass term_expansion rather tricky, if not impossible

This is probably true that term_expansion/4 cannot solve this problem when you have two passes. You need to use the prolog_clause:unify_clause_hook/5 hook for this case. Should you have had a working term_expansion/4 it should be quite eacy to define prolog_clause:unify_clause_hook/5 on top of that (I think). The prolog_clause:make_varnames_hook/5 is, if I recall correctly, not important for showing the source location. It does allow you to display the ECDG hidden state variables though, which might be pretty useful.

kamahen commented 2 years ago

Instead of making term_expansion/4 produce the correct Layout (which is turning to be both trickier and more tedious than I had expected), is a better solution to add sufficient information to prolog_clause:unify_clause_hook/5?

Does the builtin DCG do this, or does it also have the equivalent of term_expansion/4 that produces a correct Layout? (I noticed that prolog_clause:unify_clause_hook/5 has some code specifically for DCGs, although it appears to only have a special case for head --> [...], goals, presumably because the stuff in the list gets optimized into the head.)

kamahen commented 2 years ago

I'm now thinking about doing a much more minimal jobs of creating the Layout for the expanded clauses. For a "minimal" layout, appears that I need to do the following:

JanWielemaker commented 2 years ago

AFAIK, all it needs is a matching layout term up to the clause subgoals. The details are ignored. Maybe we need them at some point to show variable bindings on hovering, but probably it is simpler to just get the clause hovered and the name of the variable hovered, neither of which needs the clause layout. For the overall structure the subterm positions must be valid. For the final subgoal the first two arguments must be valid. The common structure of all layout terms is that the first two arguments give the character range for the whole thing and code that is not interested in the details thus (should) use arg/3 to get the range.

Note that {G} uses brace_term_position(From,To,ArgPos).

And yes, prolog_clause:unify_clause_hook/5 is probably the quickest way to get this working.

Thinking of a more robust solution is a nice challenge. I once started on that, following the ideas behind dif: find (sub)term correspondences between the input and output clause and reconstruct the layout from there. It started to work, but the project stalled due to other priorities. I still think this is the way to go, although it probably also requires some hooks to help it resolving ambiguities.

kamahen commented 2 years ago

The changes have mostly been done, but I'm not sure how best to test them: https://github.com/kamahen/edcg/tree/te4 I know that there are some cases of not generating a term_position that matches the term (they faile valid_termpos/4), and location information for the accumulators is not yet generated. Also, I haven't activated and tested prolog_clause:unify_clause_hook/5 yet -- it's basically a thin wrapper on edcg's term_expansion/4 (I presume that was the original intent of the hook.

kamahen commented 2 years ago

@JanWielemaker - the valid_termpos/2 predicate that I wrote is really helpful in debugging term_expansion/4 ... maybe it should be added to expand_term/4, or be put into one of the library modules (e.g., in prolog_clause.pl). If you can suggest where to put it, I'll prepare a PR (also, I'd add a bit of text to term_expansion/4, with what I've learned as "best practices"). If you don't llike the name "valid_termpos", please suggest something better.

JanWielemaker commented 2 years ago

Yes, such a predicate could be useful. I'd name it valid_term_position/2 to make the link with term_position more obvious. The best library is not obvious. prolog_clause.pl or prolog_source.pl I'd say.

I presume that was the original intent of the hook.

Not really. The mechanisms in prolog_clause predate term_position/4. The latter was modeled after SICStus. I'm not happy with it. It is simply too complicated :cry:

kamahen commented 2 years ago

@kwon-young I won't be able to work on edcg.pl for a little while (not sure how long) ... I've pushed the latest code to https://github.com/kamahen/edcg/tree/te4 (that's the "te4" branch). You can see failing test cases by: cd ~/src/edcg && find t -name '*.pl' | xargs -L1 swipl -g run_tests -g halt which are caused by location position code that I haven't finished writing. (you can find some of them by searching for ExpandPos = _). If you want to work on this, I'll integrate PRs that you send me.

I don't want to promote this code to "master" until it's complete; but it might be useful to you in its incomplete form.

If there are changes to https://github.com/SWI-Prolog/swipl-devel/pull/925 , I'll incorporate them; and when that PR becomes part of a new SWI-Prolog devel release, I'll make the appropriate changes to edcg.pl.