fixes to modules and debugger

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@220 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-12-10 05:37:39 +00:00
parent 2ea16c2512
commit 373a5439fa
10 changed files with 50 additions and 37 deletions

2
TO_DO
View File

@ -7,6 +7,8 @@ BEFORE 4.4:
- mask when installing.
- debugger: leash(full). [-user]. a(X) :- call(setof(Z,call(c(Z)),X)). a(X) :- b(X). b(X) :- c(X). c(1). c(2). end_of_file. spy a/1. a(X).
- debugger: don't stop from within system code.
- error handling.
- reports from Nikos.
TO CHECK:
- bad register allocation for a(X,Y) :- X is Y+2.3 ?

View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Tag Scheme for machines with 24 bits adresses (m68000) *
* version: $Id: Tags_24bits.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: Tags_24bits.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
/* Version for 24 bit addresses (68000)

View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32LowTag.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: Tags_32LowTag.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
#define TAG_LOW_BITS_32 1

View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32Ops.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: Tags_32Ops.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
/*

View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_32bits.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: Tags_32bits.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
/* Original version for 32 bit addresses machines,

View File

@ -18,7 +18,7 @@
* Last rev: December 90 *
* mods: *
* comments: Original Tag Scheme for machines with 32 bits adresses *
* version: $Id: Tags_64bits.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: Tags_64bits.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
#define TAG_64BITS 1

View File

@ -17,7 +17,7 @@
* File: TermExt.h *
* mods: *
* comments: Extensions to standard terms for YAP *
* version: $Id: TermExt.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: TermExt.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
#if USE_OFFSETS

View File

@ -17,7 +17,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.5 2001-09-24 18:07:16 vsc Exp $ *
* version: $Id: Yap.h,v 1.6 2001-12-10 05:37:39 vsc Exp $ *
*************************************************************************/
#include "config.h"

View File

@ -723,24 +723,13 @@ debugging :-
'$creep_call'([A|B],Module,_) :- !,
'$direct_spy'([Module|[A|B]]).
'$creep_call'(A,Module,CP) :-
'$undefined'(A,Module), !,
'$creep_call_undefined'(A,Module,CP).
'$undefined'(A,Module),
functor(A,F,N),
'$recorded'('$import','$import'(S,Module,F,N),_), !,
'$creep_call'(A,S,CP).
'$creep_call'(A,Module,_) :-
'$direct_spy'([Module|A]).
'$creep_call_undefined'(A,M,CP) :-
functor(A,F,N),
'$recorded'('$import','$import'(S,M,F,N),_), !,
'$creep_call'(A,S,CP).
'$creep_call_undefined'(G, M, CP) :-
( \+ '$undefined'(unknown_predicate_handler(_,_,_), user),
user:unknown_predicate_handler(G,NM,NG) ->
'$creep_call'(NG,NM,CP) ;
'$is_dynamic'(G, M) -> fail ;
'$recorded'('$unknown','$unknown'(M:G,US),_),
'$creep_call'(US,M,CP)
).
%'$creep'(G) :- $current_module(M),write(user_error,[creep,M,G]),nl(user_error),fail.
'$creep'(G) :-
'$get_value'('$alarm', true), !,

View File

@ -362,21 +362,22 @@ module(N) :-
% if I don't know what the module is, I cannot do anything to the goal,
% so I just put a call for later on.
'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,_) :- var(M), !.
'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,_) :- var(G), !.
'$module_expansion'(M:G,G1,GO,_,_,TM,HVars) :-
'$module_expansion'(G,G1,GO,M,M,TM,HVars).
% if M1 is given explicitly process G within M1's context.
'$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !,
% is this imported from some other module M1?
( '$imported_pred'(G, M, M1) ->
% continue recursively...
'$module_expansion'(G,G1,GO,M1,M,TM,HVars)
;
(
'$meta_expansion'(M, M, G, NG, HVars)
;
G = NG
),
'$complete_goal_expansion'(NG, M, M, TM, G1, GO, HVars)
).
% '$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !,
% % is this imported from some other module M1?
% ( '$imported_pred'(G, M, M1) ->
% % continue recursively...
% '$module_expansion'(G,G1,GO,M1,M,TM,HVars)
% ;
% (
% '$meta_expansion'(M, M, G, NG, HVars)
% ;
% G = NG
% ),
% '$complete_goal_expansion'(NG, M, M, TM, G1, GO, HVars)
% ).
%
% next, check if this is something imported.
%
@ -473,7 +474,8 @@ module(N) :-
'$meta_expansion_loop'(I,D,G,G1,HVars,M) :-
arg(I,D,X), (X==':' ; integer(X)),
arg(I,G,A), '$do_expand'(A,HVars), !,
arg(I,G1,M:A),
'$process_expanded_arg'(A, M, NA),
arg(I,G1,NA),
I1 is I-1,
'$meta_expansion_loop'(I1,D,G,G1,HVars,M).
'$meta_expansion_loop'(I,D,G,G1,HVars,M) :-
@ -487,6 +489,26 @@ module(N) :-
'$do_expand'(_:_,_) :- !, fail.
'$do_expand'(_,_).
'$process_expanded_arg'(V, M, M:V) :- var(V), !.
'$process_expanded_arg'((V1,V2), M, (NV1,NV2)) :- !,
'$process_expanded_arg'(V1, M, NV1),
'$process_expanded_arg'(V2, M, NV2).
'$process_expanded_arg'((V1;V2), M, (NV1;NV2)) :- !,
'$process_expanded_arg'(V1, M, NV1),
'$process_expanded_arg'(V2, M, NV2).
'$process_expanded_arg'((V1|V2), M, (NV1|NV2)) :- !,
'$process_expanded_arg'(V1, M, NV1),
'$process_expanded_arg'(V2, M, NV2).
'$process_expanded_arg'((V1->V2), M, (NV1->NV2)) :- !,
'$process_expanded_arg'(V1, M, NV1),
'$process_expanded_arg'(V2, M, NV2).
'$process_expanded_arg'(\+V, M, \+NV) :- !,
'$process_expanded_arg'(V, M, NV).
'$process_expanded_arg'(M:A, _, M:A) :- !.
'$process_expanded_arg'(G, _, G) :-
'$system_predicate'(G), !.
'$process_expanded_arg'(A, M, M:A).
'$not_in_vars'(_,[]).
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).