34
35:- module(clambda, [op(201,xfx,+\)]).
45:- reexport(library(compound_expand)). 46:- reexport(library(lambda)). 47:- use_module(library(apply)). 48:- use_module(library(lists)). 49:- use_module(library(occurs)). 50:- init_expansors. 51
54
55remove_hats(^(H, G1), G) -->
56 [H], !,
57 remove_hats(G1, G).
58remove_hats(G, G) --> [].
59
60remove_hats(G1, G, EL) :-
61 remove_hats(G1, G2, EL, T),
62 '$expand':extend_arg_pos(G2, _, T, G, _).
63
64cgoal_args(G1, G, AL, EL) :-
65 G1 =.. [F|Args],
66 cgoal_args(F, Args, G, Fr, EL),
67 term_variables(Fr, AL).
68
69cgoal_args(\, [G1|EL], G, [], EL) :- remove_hats(G1, G, EL).
70cgoal_args(+\, [Fr,G1|EL], G, Fr, EL) :- remove_hats(G1, G, EL).
71
72singleton(T, Name=V) :-
73 occurrences_of_var(V, T, 1),
74 \+ atom_concat('_', _, Name).
75
76have_name(VarL, _=Value) :-
77 member(Var, VarL),
78 Var==Value, !.
79
80bind_name(Name=_, Name).
81
82check_singletons(Goal, Term) :-
83 term_variables(Term, VarL),
84 ( nb_current('$variable_names', Bindings)
85 ->true
86 ; Bindings = []
87 ),
88 include(have_name(VarL), Bindings, VarN),
89 include(singleton(Term), VarN, VarSN),
90 ( VarSN \= []
91 ->maplist(bind_name, VarSN, Names),
92 print_message(warning, local_variables_outside(Names, Goal, Bindings))
93 ; true
94 ).
95
96prolog:message(local_variables_outside(Names, Goal, Bindings)) -->
97 [ 'Local variables ~w should not occurs outside lambda expression: ~W'
98 -[Names, Goal, [variable_names(Bindings)]] ].
99
100lambdaize_args(G, A1, M, VL, Ex, A) :-
101 check_singletons(G, h(VL, Ex, A1)),
102 ( ( Ex==[]
103 ; '$member'(E1, Ex),
104 '$member'(E2, VL),
105 E1==E2
106 )
107 ->'$expand':wrap_meta_arguments(A1, M, VL, Ex, A)
108 ; '$expand':remove_arg_pos(A1, _, M, VL, Ex, A, _)
109 ).
110
111goal_expansion(G1, G) :-
112 callable(G1),
113 cgoal_args(G1, G2, AL, EL),
114 '$current_source_module'(M),
115 expand_goal(G2, G3),
116 lambdaize_args(G1, G3, M, AL, EL, G4),
117 118 G4 =.. [AuxName|VL],
119 append(VL, EL, AV),
120 G =.. [AuxName|AV]
Lambda expressions
This library is semantically equivalent to the lambda library implemented by Ulrich Neumerkel, but it performs static expansion of the expressions to improve performance.
*/