home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
lifeos2.zip
/
LIFE-1.02
/
LIB
/
STD_EXPA.LF
< prev
next >
Wrap
Text File
|
1996-06-04
|
13KB
|
448 lines
% $Id: std_expander.lf,v 1.2 1994/12/09 00:24:52 duchier Exp $
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% STANDARD EXPANDER
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
module("std_expander") ?
import("acc_declarations") ?
public(std_expander,comma,
clauses,context,code,define,macro) ?
associate_expanders(std_expander,make_expander) ?
op(1000,xfy,comma)?
global(init_method,head_method,traverse_method,leaf_method,
split_method,save_method,restore_method,merge_method,
terminate_method,begin_body_method,end_body_method) ?
X:std_expander :-
make_expander(X,in_clauses => In,out_clauses => []),
maprel(assert,In),
fail.
make_expander(S:std_expander(Name,
init => init_method,
head => head_method,
begin_body => begin_body_method,
leaf => leaf_method,
split => split_method,
save => save_method,
restore => restore_method,
merge => merge_method,
end_body => end_body_method,
terminate => terminate_method),
in_clauses => In,out_clauses => Out) :-
( head_method = std,!
;
pred_info(head_method,[clauses,code])
),
( save_method = std,!
;
pred_info(save_method,[context,code])
),
( restore_method = std,!
;
pred_info(restore_method,[context,code])
),
( leaf_method = std,!
;
pred_info(leaf_method,[clauses,context,code])
),
( init_method = std,!
;
pred_info(init_method,[clauses])
),
( begin_body_method = std,!
;
pred_info(begin_body_method,[context,code,clauses])
),
( end_body_method = std,!
;
pred_info(end_body_method,[context,code,clauses])
),
( terminate_method = std,!
;
pred_info(terminate_method,[code,clauses])
),
split_method = {std;@},!,
merge_method = {std;@},!,
traverse_method = str2psi(strcon(psi2str(Name),"_traverse"),
current_module),
pred_info(Name,clauses),
pred_info(traverse_method,[context,clauses,code]),
first_clause(Name,First),
conj_clause(Conj),
disj_clause(Disj),
cond_clause(Cond),
macro_clause(Macro),
leaf_clause(Leaf),
In = [First,Conj,Disj,Cond,Macro,Leaf|Out].
first_clause(Name,First) :-
First =
(Name & @(Head :- Body,
in_clauses => Cl1,out_clauses => Cl6,
file => File, line => Line) :-
initialize(file => File,line => Line) comma
head(Head,NewHead,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co4,
in_clauses => Cl1,out_clauses => Cl2) comma
begin_body(in_code => Code2,out_code => Code3,
in_context => Co1,out_context => Co2,
in_clauses => Cl2,out_clauses => Cl3) comma
traverse(Body,
in_code => Code3,out_code => Code4,
in_context => Co2,out_context => Co3,
in_clauses => Cl3,out_clauses => Cl4) comma
end_body(in_code => Code4,out_code => Code5,
in_context => Co3,out_context => Co4,
in_clauses => Cl4,out_clauses => Cl5) comma
terminate( Clause:`(NewHead :- Code1),
in_code => Code5,out_code => succeed,
in_context => Co1,out_context => Co4,
in_clauses => Cl5,out_clauses => Cl6)
).
conj_clause(Conj) :-
Conj =
(traverse(S1:@(A,B),
in_code => Code1,out_code => Code3,
in_context => Co1,out_context => Co3,
in_clauses => Cl1,out_clauses => Cl3):-
`(S1 :== ,),
!,
traverse(A,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2),
traverse(B,
in_code => Code2,out_code => Code3,
in_context => Co2,out_context => Co3,
in_clauses => Cl2,out_clauses => Cl3)
).
disj_clause(Disj) :-
Disj =
(traverse(S2:@(A,B),
in_code => Code1,out_code => Code4,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl3) :-
`(S2 :== ;),
!,
split(in_code => Code1,out_code => Code2,
in => Co1,out1 => Co1A,out2 => Co1B) comma
(
save(in_code => CodeA,out_code => CodeA2,
in_context => Co1A,out_context => Co2A) comma
traverse(A,
in_code => CodeA2,out_code => CodeA3,
in_context => Co2A,out_context => Co3A,
in_clauses => Cl1,out_clauses => Cl2) comma
restore(in_code => CodeA3,out_code => succeed,
in_context => Co3A,out_context => Co4A)
),
(
save(in_code => CodeB,out_code => CodeB2,
in_context => Co1B,out_context => Co2B) comma
traverse(B,
in_code => CodeB2,out_code => CodeB3,
in_context => Co2B,out_context => Co3B,
in_clauses => Cl2,out_clauses => Cl3) comma
restore(in_code => CodeB3,out_code => succeed,
in_context => Co3B,out_context => Co4B)
),
merge(in_code => Code3,out_code => Code4,
in1 => Co4A,in2 => Co4B,out => Co2),
Code2 = `((CodeA;CodeB) comma Code3)
).
cond_clause(Cond) :-
Cond =
(traverse(S3,
in_code => Code1,out_code => Code4,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl3) :-
`(S3 :== `cond),
!,
(
`has_feature(1,S3,Condition),!
;
Condition = "missing condition in the code!" %% should not
% be silent !!
),
split(in_code => Code1,out_code => Code2,
in => Co1,out1 => Co1A,out2 => Co1B) comma
(
`has_feature(2,S3,Alt1),!,
save(in_code => CodeA,out_code => CodeA2,
in_context => Co1A,out_context => Co2A) comma
traverse(Alt1,
in_code => CodeA2,out_code => CodeA3,
in_context => Co2A,out_context => Co3A,
in_clauses => Cl1,out_clauses => Cl2) comma
restore(in_code => CodeA3,out_code => succeed,
in_context => Co3A,out_context => Co4A)
;
save(in_code => CodeA6,out_code => CodeA5,
in_context => Co1A,out_context => Co5A) comma
restore(in_code => CodeA5,out_code => succeed,
in_context => Co5A,out_context => Co4A) comma
Cl1 = Cl2,
CodeA = CodeA6
),
(
`has_feature(3,S3,Alt2),!,
save(in_code => CodeB,out_code => CodeB2,
in_context => Co1B,out_context => Co2B) comma
traverse(Alt2,
in_code => CodeB2,out_code => CodeB3,
in_context => Co2B,out_context => Co3B,
in_clauses => Cl2,out_clauses => Cl3) comma
restore(in_code => CodeB3,out_code => succeed,
in_context => Co3B,out_context => Co4B)
;
save(in_code => CodeB6,out_code => CodeB5,
in_context => Co1B,out_context => Co5B) comma
restore(in_code => CodeB5,out_code => succeed,
in_context => Co5B,out_context => Co4B) comma
Cl2 = Cl3,
CodeB = CodeB6
),
merge(in_code => Code3,out_code => Code4,
in1 => Co4A,in2 => Co4B,out => Co2),
Code2 = `(`cond(Condition,
CodeA,
CodeB
) comma Code3)
).
macro_clause(MacroClause) :-
MacroClause =
(traverse(Leaf,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2) :-
`macro(Leaf,Def),!,
traverse(Def,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2)
).
leaf_clause(LeafClause) :-
LeafClause =
(traverse(Leaf,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2) :-
leaf(Leaf,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2)
).
initialize(file => File,line => Line) ->
cond( init_method :== std,
succeed,
root_sort(init_method)
& @(file => File,line => Line)
).
terminate(Clause,
in_context => Co1,out_context => Co2,
in_code => Code1,out_code => Code2,
in_clauses => Cl1,out_clauses => Cl2) ->
cond( terminate_method :== std,
( succeed | Cl1 = [Clause|Cl2], Code1 = Code2),
root_sort(terminate_method)
& @(in_context => Co1,out_context => Co2,
in_code => Code1,out_code => Code2,
in_clauses => Cl1,out_clauses => Cl2)
).
head(Head,NewHead,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2) ->
cond( head_method :== std,
( succeed | Cl1 = Cl2, NewHead = Head, Code1 = Code2),
root_sort(head_method)
& @(Head,NewHead,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2)
).
begin_body(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2) ->
cond( begin_body_method :== std,
( succeed | Cl1 = Cl2, Co1 = Co2, Code1 = Code2),
root_sort(begin_body_method)
& @(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2)
).
end_body(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2) ->
cond( end_body_method :== std,
( succeed | Cl1 = Cl2, Co1 = Co2, Code1 = Code2),
root_sort(end_body_method)
& @(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2)
).
traverse(Body,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl3,out_clauses => Cl4) ->
root_sort(traverse_method)
& @(Body,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl3,out_clauses => Cl4).
split(in_code => Code1,out_code => Code2,
in => Co,out1 => Co1,out2 => Co2) ->
cond( split_method :== std,
(succeed | Co = Co1, Co1 = Co2, Code1 = Code2),
root_sort(split_method)
& @(in_code => Code1,out_code => Code2,
in => Co,out1 => Co1,out2 => Co2)
).
save(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2) ->
cond( save_method :== std,
(succeed | Co1 = Co2, Code1 = Code2),
root_sort(save_method)
& @(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2)
).
restore(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2) ->
cond( restore_method :== std,
(succeed | Co1 = Co2, Code1 = Code2),
root_sort(restore_method)
& @(in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2)
).
merge(in_code => Code1,out_code => Code2,
in1 => Co1,in2 => Co2,out => Co) ->
cond( merge_method :== std,
(succeed | Co = Co1, Co1 = Co2, Code1 = Code2),
root_sort(merge_method)
& @(in_code => Code1,out_code => Code2,
in1 => Co1,in2 => Co2,out => Co)
).
leaf(Leaf,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2) ->
cond( leaf_method :== std,
(succeed | Co1 = Co2, Cl1 = Cl2, Code1 = (Leaf comma Code2)),
root_sort(leaf_method)
& @(Leaf,
in_code => Code1,out_code => Code2,
in_context => Co1,out_context => Co2,
in_clauses => Cl1,out_clauses => Cl2)
).
X comma Y -> cond( X :== succeed,
Y,
cond( Y :== succeed,
X,
(X,Y))).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Macros
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% macro definition
persistent(macros_table) ?
non_strict(define) ?
define(A,B) :-
macros_table.current_module.A <<- @(A,B).
associate_expanders(define,define_expander) ?
define_expander(define(A,B),in_clauses => In,out_clauses => In) :-
define(A,B).
macro(X,Def) ->
cond( X :< string,
submacro(features(macros_table.current_module),
X,Def),
macro2(X,Def)
).
macro2(X,Def) ->
cond( has_feature(X,macros_table.current_module,Def1),
( true |
@(X,Def) = copy_term(Def1)
),
cond( is_sort(X),
submacro(features(macros_table,current_module),
X,Def),
false
)
).
submacro([A|B],X,Def) ->
cond( X :< A,
( true |
@(X,Def) = copy_term(macros_table.current_module.A)
),
submacro(B,X,Def)
).
submacro([],_,_) -> false.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Info for accumulation
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
acc_info(clauses,X,In,Out,acc_pred => In = [X|Out]).
acc_info(context).
acc_info(code,X,In,Out,acc_pred => In = (X comma Out)).