Skip to content

Commit

Permalink
metta_typed_functions
Browse files Browse the repository at this point in the history
  • Loading branch information
@TeamSPoon
TeamSPoon committed Jan 5, 2025
1 parent 8b86f98 commit 92dfc51
Show file tree
Hide file tree
Showing 3 changed files with 87 additions and 36 deletions.
40 changes: 33 additions & 7 deletions prolog/metta_lang/metta_printer.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -748,7 +748,7 @@
must_det_lls((
pre_guess_varnames(V,II),call(II=V),
guess_varnames(II,I),
nop(ignore(numbervars(I,10000,_,[singleton(true),attvar(skip)]))),
nop(ignore(numbervars(I,400,_,[singleton(true),attvar(skip)]))),
materialize_vns(I))).
pre_guess_varnames(V,I):- \+ compound(V),!,I=V.
pre_guess_varnames(V,I):- copy_term_nat(V,VC),compound_name_arity(V,F,A),compound_name_arity(II,F,A), metta_file_buffer(_, _, _, II, Vs, _,_), Vs\==[], copy_term_nat(II,IIC), VC=@=IIC, II=I,maybe_name_vars(Vs),!.
Expand All @@ -758,22 +758,48 @@

write_w_attvars(Term):- \+ \+ write_w_attvars0(Term).
write_w_attvars0(Term):-
number_src_vars(Term,PrintSV,Goals),
once_writeq_nl_now(PrintSV),
if_t(Goals\==[], once_writeq_nl_now(yellow,goals={Goals})),!.

number_src_vars(Term,PrintSV,Goals):-
src_vars(Term,PrintSV),
copy_term(Term,TermC,Goals), PrintSV = TermC,
materialize_vns(PrintSV),
ignore(numbervars(PrintSV,20000,_,[singleton(true),attvar(skip)])),
ignore(numbervars(PrintSV,260,_,[singleton(true),attvar(skip)])),
ignore(numbervars(PrintSV,26,_,[singleton(true),attvar(bind)])),
must(PrintSV = Term),
once_writeq_nl_now(green,Term),
if_t(Goals\==[], once_writeq_nl_now(yellow,{Goals})),!.
must(PrintSV = Term),!.

once_writeq_nl_now(Color,P) :-
once_writeq_nl_now(P) :-
% Standardize variable names in `P` and print it using `ansi_format`.
% Use `nb_setval` to store the printed term in `$once_writeq_ln`.
\+ \+ (must_det_ll((
src_vars(P,PP),
with_output_to(user_error,ansi_format([fg(Color)], '~N~q.~n', [PP]))))).
format('~N~q.~n', [PP])))).

% Standardize variable names in `P` and print it using `ansi_format`.
% Use `nb_setval` to store the printed term in `$once_writeq_ln`.
once_writeq_nl_now(Color,P) :- w_color(Color,once_writeq_nl_now(P)).

%! write_src_nl(+Src) is det.
%
% Prints a source line followed by a newline.
%
% @arg Src The source line to print.
%
write_src_nl(Src) :-
% Print a newline, the source line, and another newline.
\+ \+ (must_det_ll((
number_src_vars(Src, SrcSrc, Goals),
(format('~N'), write_src(SrcSrc),
if_t(Goals\==[],once_writeq_nl_now(yellow,goals=Goals)),
format('~N'))))).


w_color(Color,Goal):-
\+ \+ (must_det_ll((
wots(Text,Goal),
with_output_to(user_error,ansi_format([fg(Color)], '~w', [Text]))))).

materialize_vns(Term):- term_variables(Term,List), maplist(materialize_vn,List).
materialize_vn(Var):- \+ attvar(Var),!.
Expand Down
9 changes: 0 additions & 9 deletions prolog/metta_lang/metta_space.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1664,15 +1664,6 @@
% Print each line of the source code.
maplist(write_src_nl, SrcL).

%! write_src_nl(+Src) is det.
%
% Prints a source line followed by a newline.
%
% @arg Src The source line to print.
%
write_src_nl(Src) :-
% Print a newline, the source line, and another newline.
format('~N'), write_src(Src), format('~N').

%'get-metta-src'(Pred,[Len|SrcL]):-
% findall(['AtomDef',Src], 'get-metta-src1'(Pred,Src), SrcL),
Expand Down
74 changes: 54 additions & 20 deletions prolog/metta_lang/metta_typed_functions.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -203,33 +203,51 @@


metta_defn_return(Self, Original, Body, WrappedBody, ReturnVal):-
if_or_else(metta_defn_decl(Self, Original, Body, WrappedBody, ReturnVal), metta_defn_fallback(Self, Original, Body, WrappedBody, ReturnVal)).
if_or_else(metta_defn_decl(Self, Original, Body, WrappedBody, ReturnVal),
metta_defn_fallback(Self, Original, Body, WrappedBody, ReturnVal)).

metta_defn_decl(Self, [Op | Parameters], Body, [let, ReturnVal, Body, ReturnVal], ReturnVal):- metta_defn(Self, [Op | Parameters], Body).

must_length(List,Len):- is_list(List),!,must_det_lls(length(List,Len)).
must_length(List,Len):- integer(Len),!,must_det_lls(length(List,Len)).
must_length(List,Len):- trace,length(List,Len).

metta_defn_fallback(_Self, [Op | Parameters], [let, ReturnVal, Body, ReturnVal], Body, ReturnVal):-
must_length(Parameters, Len),
format(atom(Fn),'mc_~w__~w',[Len,Op]),
current_predicate(Fn/_),
Body = ['call-fn',Fn|Parameters],!.

metta_defn_fallback(_Self, [Op | Parameters], Body, Body, ReturnVal):-
Body = [let, [quote, ReturnVal], [quote, [Op | Parameters]], ReturnVal].


metta_typed_defn(Self, ParamTypes, RetType, Head, WrappedBody, ReturnVal):- Head = [Op | Parameters],
function_declaration(Self, Op, _Len, Parameters, ParamTypes, RetType, WrappedBody, ReturnVal).

function_declaration(Self, Op, Len, Parameters, ParamTypes, RetType, WrappedBody, ReturnVal) :-
function_declaration(_, Op, Len, Parameters, ParamTypes, RetType, WrappedBody, ReturnVal) :-
must_det_lls((
%Self = '&self',
len_or_unbound(Parameters, Len),
%(var(Len)->op_farity(Op, Len);true),
%len_or_unbound(Parameters, Len),
nop(no_repeats_var(NRR)),
metta_defn_return(Self, [Op | Parameters], Body, WrappedBody, ReturnVal),
len_or_unbound(Parameters, Len),
must_length(Parameters, Len),
NR = ([Op | Parameters] + Body),
copy_term(NR, NRR),
no_repeats_var(NRR),
head_body_typedef(Self, Op, Len, ParamTypes, RetType, [Op | Parameters], Body),
NR = NRR. %nop(write_src_nl(metta_defn(Self, [Op | Parameters], Body))).
NR = NRR)). %nop(write_src_nl(metta_defn(Self, [Op | Parameters], Body))).

head_body_typedef(Self, Op, Len, ParamTypes, RetType, Head, Body):-
(src_data_ordinal(Self, [=, Head, Body], ClauseOrdinal)*->true; (ClauseOrdinal = -1)),
(src_data_ordinal(Self, [=, Head, Body], ClauseOrdinal)*->true;
(src_data_ordinal(Self, [=, Head, _], ClauseOrdinal)*->true;
(ClauseOrdinal = -1))),
length(ParamTypes, Len),
SrcObject = pr(ParamTypes, RetType),
findall(TypeDeclLoc-SrcObject, (src_data_ordinal(Self, [:, Op, [Ar|Type]], TypeDeclLoc), Ar=='->', append(ParamTypes, [RetType], Type)), SrcObjectList),
nearest_src_object(SrcObject, ClauseOrdinal, SrcObjectList).
nearest_src_object(SrcObject, ClauseOrdinal, SrcObjectList),!.
head_body_typedef(Self, Op, Len, ParamTypes, RetType, _Head, _Body):-
get_operator_typedef(Self, Op, Len, ParamTypes, RetType).

src_data_ordinal(_Self, Data, Ordinal):-
user:metta_file_buffer(0, Ordinal, _TypeNameCompound, Data, _NamedVarsListC, _Context, _Range).
Expand All @@ -250,7 +268,8 @@
DistanceOther is LocOther-ClauseOrdinal,
DistanceOther>0, DistanceOther<Distance), !.

nearest_src_object(SrcObject, _, SrcObjectList):- last(_ - SrcObject, SrcObjectList).
nearest_src_object(SrcObject, _, SrcObjectList):- last(_ - SrcObject, SrcObjectList),!.


finfo([Op|Args]):- is_list(Args), !, length(Args, Len), finfo(Op, Len).
finfo(Op):- atomic(Op), !, finfo(Op, _, _).
Expand All @@ -259,28 +278,43 @@
finfo(Op, Len, Head) :-
% length(Parameters, Len),
op_farity(Op, Len),
succ(Len,LenP1),
call_showing(predicate_behavior(Self, Op, Len, [List|_]), predicate_behavior(Self, Op, Len, List)),
length(Parameters, Len),
length(ParamTypes, Len),
[Op|Parameters] = Head,
call_showing(get_ftype('=', _RetType1, 20, Self, Head, TypeO), get_ftype(Self, Head, TypeO)),
call_showing(get_ftype('=', _RetType1, 20, Self, Head, TypeO), [['get-ftype', Self, Head],==>,TypeO]),
%call_showing(metta_atom(_, [iz, Op, _])),
%call_showing(metta_atom(_, [':', Op, _])),
% ReturnVal = '$VAR'('ReturnVal'),
call_showing(function_declaration_scores(Self, Op, Len, Parameters, ParamTypes, _RetType, _Body, _ReturnVal, _Scores)),
call_showing((metta_atom(KB, [A, B|Out]), sub_var(Op, [A, B])), ist(KB, [A, B|Out])),
ReturnVal = '$VAR'('_returnVal'),
call_showing(transpiler_predicate_store(Op, LenP1, _, _)),
call_showing(transpiler_clause_store(Op, LenP1, _, _, _, _, _, _, _)),
format(atom(Fn),'mc_~w__~w',[Len,Op]), % forall(current_predicate(Fn/LenP1),listing(Fn/LenP1)),
call_showing(Fn/LenP1),
call_showing(function_declaration_scores(Self, Op, Len, Parameters, ParamTypes, _RetType, Body, ReturnVal,_)),
if_t(\+ metta_defn(Self, [Op | Parameters], Body), call_showing(metta_defn_return(Self, [Op | Parameters], Body, _, ReturnVal),[=,[Op | Parameters],Body])),
call_showing((metta_atom(KB, [A, B|Out]), sub_var(Op, [A, B])), [ist,KB, [A, B|Out]]),
true.

call_showing(Var):- \+ callable(Var), !.
call_showing(Atom):- atom(Atom), !, current_predicate(Atom/_, SHOWP), !, call_showing(SHOWP, SHOWP).
call_showing(Op/Len):- !, current_predicate(Op/Len, SHOWP), !, call_showing(SHOWP, SHOWP).
call_showing(SHOWP):- call_showing(SHOWP, SHOWP), !.
call_showing(Var):- \+ callable(Var), !, write_src_nl(not(callable(Var))).
call_showing(Atom):- atom(Atom), \+ current_predicate(Atom/_, _), !, write_src_nl(unknown(Atom)).
call_showing(Atom):- atom(Atom), !, forall(current_predicate(Atom/N),call_showing(Atom/N)).
call_showing(Op/Len):- \+ current_predicate(Op/Len), !, write_src_nl(unknown(Op/Len)).
call_showing(Op/Len):- !, forall(current_predicate(Op/Len, SHOWP), call_showing(clause(SHOWP,Body), (SHOWP:-Body))).
call_showing(SHOWP):- \+ current_predicate(_, SHOWP), !, write_src_nl(unknown(SHOWP)).
call_showing(SHOWP):- call_showing(SHOWP, SHOWP).

call_showing(SHOWP, Template):- current_predicate(_, SHOWP), !,
call_showing(SHOWP, Template):-
no_repeats_var(TemplateNR),
findall(Template, (SHOWP, TemplateNR=Template), ScoredBodies),
maplist(write_src_nl, ScoredBodies), !.
call_showing(SHOWP, _Template):- write_src_nl(unknown(SHOWP)).
maplist(output_showing, ScoredBodies),
ignore((ScoredBodies==[], functor(Template,F,A),output_showing(missing(F/A)))).

output_showing(List):- is_list(List),!,write_src_nl(List).
output_showing(Info):- w_color(white,write_w_attvars(Info)),nl, !.
output_showing(Info):- write_src_nl(Info).



function_declaration_scores(Self, Op, Len, Parameters, ParamTypes, RetType, Body, ReturnVal, Score + HScore):-
function_declaration(Self, Op, Len, Parameters, ParamTypes, RetType, Body, ReturnVal),
Expand Down

0 comments on commit 92dfc51

Please sign in to comment.