Refactored metta_types.pl:

- Removed unused enums for type guards and behavior configurations.
- Consolidated type-related functionality into metta_typed_functions.pl for better modularity and maintainability.

Author: TeamSPoon

prolog/metta_lang/metta_types.pl

@@ -2230,331 +2230,4 @@
 
 % :- load_pfc_file('metta_ontology.pl.pfc').
 
-
-
-% Enums for Guarded Type Handling in Prolog
-
-% GuardMatchResult: Describes the result of evaluating several type guards against the function arguments.
-mo_match_behavior(return_original_on_no_match).
-mo_match_behavior(fail_on_no_match).
-mo_match_behavior(throw_type_error_on_no_match).
-% EvaluationOrder: Describes how the type guards are prioritized during evaluation.
-evaluation_order(clause_order_priority).
-evaluation_order(fittest_first_priority).
-% ExecutionResult: Describes the outcome of executing the guarded expression.
-execution_result_behavior(continue_on_success).
-execution_result_behavior(cut_on_first_success).
-% ExecutionResult: Describes the outcome of executing the guarded expression.
-execution_failed_behavior(continue_on_failure).
-execution_failed_behavior(cut_on_first_failure).
-% What do when there are no successfull bodies
-out_of_clauses_behavior(fail_on_final_failure).
-out_of_clauses_behavior(return_original_on_final_failure).
-
-
-
-
-%predicate_behavior(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior)
-predicate_behavior_impl('get-type', 1, fail_on_no_match, clause_order_priority, continue_on_success, continue_on_failure, fail_on_final_failure).
-
-predicate_behavior_impl('foo', 2, return_original_on_no_match, fittest_first_priority, continue_on_success, continue_on_failure, return_original_on_final_failure).
-
-predicate_behavior_impl('match', 4, fail_on_no_match, clause_order_priority, continue_on_success, continue_on_failure, fail_on_final_failure).
-% default
-predicate_behavior_fallback(_, _, return_original_on_no_match, clause_order_priority, continue_on_success, continue_on_failure, return_original_on_final_failure).
-
-predicate_behavior(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior):-
-   predicate_behavior_impl(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior)
-    *->true; predicate_behavior_fallback(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior).
-
-function_declaration(Predicate, Len, Parameters, ParamTypes, RetType, [let,ReturnVal,Body,ReturnVal], ReturnVal):-
-   Self='&self',
-   len_or_unbound(Parameters, Len),
-   NR = ([Predicate|Parameters]+Body),
-   copy_term(NR,NRR),
-   no_repeats_var(NRR),
-   metta_defn(Self,[Predicate|Parameters],Body),
-   get_operator_typedef(Self, Predicate, Len, ParamTypes, RetType),
-   NR=NRR,
-   write_src_nl(metta_defn(Self,[Predicate|Parameters],Body)).
-
-clause_match_level(Predicate, Len, Parameters, Score, Body, ReturnVal):-
-   function_declaration(Predicate, Len, Parameters, Types, RetType, Body, ReturnVal),
-   maplist(nc_weight,[RetType|Types],XXL),sumlist(XXL,Score).
-
-info_about(Predicate, Len):-
-   predicate_behavior(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior),
-   write_src_nl(predicate_behavior(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior)),!,
-   findall(Score- Body, clause_match_level(Predicate, Len, Parameters, Score, Body, ReturnVal), ScoredBodies),
-   maplist(write_src_nl,ScoredBodies),!.
-
-implement_predicate([Predicate|Parameters], ReturnVal):-
-  catch(implement_predicate_nr([Predicate|Parameters], ReturnVal),metta_notreducable(ReturnVal),true).
-
-implement_predicate_nr([Predicate|Parameters], ReturnVal) :-
-    len_or_unbound(Parameters, Len),
-
-    predicate_behavior(Predicate, Len, NoMatchBehavior, EvaluationOrder, SuccessBehavior, FailureBehavior, OutOfClausesBehavior),
-
-    % Generate Score-Body pairs
-    findall(Score- Body, clause_match_level(Predicate, Len, Parameters, Score, Body, ReturnVal), ScoredBodies),
-
-    % Handle no matches
-    (ScoredBodies \== [] ->
-        true ;
-        (NoMatchBehavior == fail_on_no_match -> fail ; throw(metta_notreducable([Predicate | Parameters])))), % vs return_original_on_no_match
-
-    % Sort based on evaluation order
-    (EvaluationOrder == clause_order_priority ->
-        OrderedBodies = ScoredBodies ;
-        sort(ScoredBodies, OrderedBodies)), % fittest_first_priority
-
-    % Extract bodies from sorted or original pairs
-    maplist(arg(2), OrderedBodies, Bodies),
-
-    % Iterate over bodies and handle success/failure policies
-    (((member(Body, Bodies), call(Body)) *->
-        (SuccessBehavior == cut_on_first_success -> ! ; true) % vs continue_on_success
-    ;
-        (FailureBehavior == cut_on_first_failure -> (!, fail) ; fail)) % vs continue_on_failure
-    *->
-        true ;
-        (OutOfClausesBehavior == fail_on_final_failure -> fail ; throw(metta_notreducable([Predicate | Parameters])))). % vs return_original_on_final_failure
-
-
-
-% ------------------------------------------------------------------------------
-% Core Logic with Type Guards
-% ------------------------------------------------------------------------------
-
-% Helper to check type guards.
-guard_match(X, number) :- number(X).
-guard_match(X, atom) :- atom(X).
-guard_match(X, list) :- is_list(X).
-guard_match(X, complex) :- is_list(X), length(X, N), N > 5.
-guard_match(X, simple) :- is_list(X), length(X, N), N =< 5.
-guard_match(_, generic).
-
-% Define what happens inside the guarded body.
-guarded_body(X, Result, success) :-
-    writeln(successful_guard(X)),
-    Result = processed(X).
-
-guarded_body(X, Result, failure) :-
-    writeln(failed_guard(X)),
-    Result = return_original(X).
-
-% Fallback logic if no guards match.
-fallback_logic(X, Result) :-
-    writeln('No type guard matched. Executing fallback.'),
-    Result = default_value(X).
-
-% Nested guard logic.
-nested_guard(X, Result) :-
-    (   X = hello ->
-        Result = special_case_handled
-    ;   Result = default_atom_result
-    ).
-
-% ------------------------------------------------------------------------------
-% Tests
-% ------------------------------------------------------------------------------
-
-% Test 1: Simple Type Guard Matching
-test_simple_guard :-
-    function(42, Result1), writeln(Result1),
-    function(hello, Result2), writeln(Result2),
-    function([], Result3), writeln(Result3),
-    function(foo, Result4), writeln(Result4).
-
-% Test 2: Fallback Behavior
-test_fallback :-
-    function_with_fallback([], Result), writeln(Result).
-
-% Test 3: Prioritized Type Guard Evaluation
-test_prioritized :-
-    prioritized_function([1,2,3], Result1), writeln(Result1),
-    prioritized_function([1,2,3,4,5,6], Result2), writeln(Result2),
-    prioritized_function(hello, Result3), writeln(Result3).
-
-% Test 4: Nested Guarded Logic with Errors
-test_nested :-
-    nested_function(42, Result1), writeln(Result1),
-    nested_function(hello, Result2), writeln(Result2),
-    nested_function(world, Result3), writeln(Result3),
-    nested_function([], Result4), writeln(Result4).
-
-% ------------------------------------------------------------------------------
-% Function Definitions
-% ------------------------------------------------------------------------------
-
-% Function with basic guards.
-function(X, Result) :-
-    (   guard_match(X, number) ->
-        guarded_body(X, Result, success)
-    ;   guard_match(X, atom) ->
-        guarded_body(X, Result, success)
-    ;   guard_match(X, list) ->
-        guarded_body(X, Result, success)
-    ;   guarded_body(X, Result, failure)
-    ).
-
-% Function with a fallback mechanism.
-function_with_fallback(X, Result) :-
-    (   guard_match(X, number) ->
-        guarded_body(X, Result, success)
-    ;   guard_match(X, atom) ->
-        guarded_body(X, Result, success)
-    ;   fallback_logic(X, Result)
-    ).
-
-% Function with prioritized guards.
-prioritized_function(X, Result) :-
-    evaluation_order(fittest_first), % Assume we process most specific guards first.
-    (   guard_match(X, complex) ->
-        guarded_body(X, Result, success)
-    ;   guard_match(X, simple) ->
-        guarded_body(X, Result, success)
-    ;   guard_match(X, generic) ->
-        guarded_body(X, Result, success)
-    ;   guarded_body(X, Result, failure)
-    ).
-
-% Function with nested guards and error handling.
-nested_function(X, Result) :-
-    (   guard_match(X, number) ->
-        guarded_body(X, Result, success)
-    ;   guard_match(X, atom) ->
-        nested_guard(X, Result)
-    ;   fallback_logic(X, Result)
-    ).
-
-ffffff:- writeln('
-    ?- test_simple_guard.
-    ?- test_fallback.
-    ?- test_prioritized.
-    ?- test_nested.
-').
-
-
-%! freeist(+X, +Y, -Result) is det.
-%
-%  A comparison predicate for `predsort/3` that sorts terms by freeness.
-%
-%  Terms are sorted based on the following criteria:
-%  - Variables are considered the "most free" and are sorted first.
-%  - Partially instantiated terms come next.
-%  - Fully ground terms are sorted last. Among them, they are further sorted by
-%    their complexity (the total number of functors and arguments in the term).
-%
-%  If two terms have the same degree of freeness and complexity, a lexicographic comparison
-%  is used as a final fallback.
-%
-%  Example usage with `predsort/3`:
-%  ==
-%  ?- predsort(freeist, [X, f(Y), g(a), Z, b, h(1,2,3)], Sorted).
-%  % Sorted = [X, Z, f(Y), b, g(a), h(1, 2, 3)].
-%
-%  ?- predsort(freeist, [a, f(a), h(a, b, c), g(a), b], Sorted).
-%  % Sorted = [a, b, g(a), f(a), h(a, b, c)].
-%
-%  ?- predsort(freeist, [X, Z, f(X, Y), b, h(a), g(a)], Sorted).
-%  % Sorted = [X, Z, f(X, Y), b, g(a), h(a)].
-%
-%  ?- predsort(freeist, [g(a), g(b), f(a, b), a, h(a, b, c), X, Z], Sorted).
-%  % Sorted = [X, Z, a, g(a), g(b), f(a, b), h(a, b, c)].
-%  ==
-%
-%  @param Result Comparison result: `<`, `=`, or `>`.
-%  @param Y Second term to compare.
-%  @param X First term to compare.
-
-%freeist(Result, X, Y):- X == Y, !, Result = (=).
-freeist(Result, X, Y):- X =@= Y, !, compare(Result, Y, X).
-freeist(Result, Y, X) :- compound(Y),Y=(YY-_),!,freeist(Result, YY, X).
-freeist(Result, Y, X) :- compound(X),X=(XX-_),!,freeist(Result, Y, XX).
-freeist(Result, Y, X) :-
-    term_freeness(Y, FX),
-    term_freeness(X, FY),
-    ( FX = FY ->
-        ( FX = 2 -> % If both terms are ground
-            term_arity(Y, AX),
-            term_arity(X, AY),
-            ( AX = AY ->
-                term_complexity(Y, CX),
-                term_complexity(X, CY),
-                ( CX = CY ->
-                    (compound_term_compare(ResultNE, X, Y), (ResultNE \= (=) -> ResultNE=Result ; compare(Result, Y, X))) % Compare compound terms argument by argument
-                ; compare(Result, CX, CY) )
-            ; compare(Result, AX, AY) )
-        ; compare(Result, Y, X) ) % Fallback for other types if freeness is the same
-    ; compare(Result, FX, FY) % Compare by freeness
-    ), !.
-
-% Calculate term freeness
-term_freeness(Term, 1) :- attvar(Term), !.
-term_freeness(Term, 0) :- var(Term), !.
-%term_freeness(Term, 1) :- term_variables(Term, Vars), Vars \= [], !.
-term_freeness(_, 2).
-
-% Calculate term arity (number of arguments)
-term_arity(Term, Arity) :-
-    %ground(Term), % Only applies to ground terms
-    Term =.. [_|Args],
-    length(Args, Arity).
-term_arity([_|Args], Arity):-length(Args, Arity).
-
-% Calculate term complexity (total number of functors and arguments in the term)
-term_complexity(Term, Complexity) :- fail,
-    ground(Term), % Only applies to ground terms
-    term_complexity_acc(Term, 0, Complexity).
-term_complexity(_,1).
-
-term_complexity_acc(Term, Acc, Complexity) :-
-    Term =.. [_|Args],
-    length(Args, ArgCount),
-    NewAcc is Acc + 1 + ArgCount,
-    foldl(term_complexity_acc, Args, NewAcc, Complexity).
-
-term_to_list(L, [L]):- \+ compound(L),!.
-term_to_list(L,L):- is_list(L),!.
-term_to_list(C, [F|Args]):- C \=[_|_],!, compound_name_arguments(C,F,Args).
-term_to_list(L, [L]).
-
-% Compare compound terms argument by argument
-compound_term_compare(Result, X, Y) :-
-    term_to_list(X,XX),
-    term_to_list(Y,YY),
-    maplist(nc_weight,XX,XXL),sumlist(XXL,SX),
-    maplist(nc_weight,YY,YYL),sumlist(YYL,SY),
-    compare(FunctorResult, SY, SX), % Compare functors lexicographically
-    ( FunctorResult = (=) ->
-        compare_args(Result, XX, YY)  % Compare arguments recursively
-    ; Result = FunctorResult ).
-
-% Recursively compare lists of arguments
-compare_args(Result, [A1|Rest1], [A2|Rest2]) :- !,
-    non_compound_compare(ArgResult, A1, A2), % Compare individual arguments using the custom predicate
-    ( ArgResult = (=) ->
-        compare_args(Result, Rest1, Rest2) % Continue with the remaining arguments
-    ; Result = ArgResult ).
-compare_args(Result, A, B) :- A==B, Result = (=). % Both lists are empty
-compare_args(Result, A, _) :- A==[], Result = (<). % First list is shorter
-compare_args(Result, _, B) :- B==[], Result = (>). % Second list is shorter
-
-% Example custom comparison for individual atoms or non-compound terms
-non_compound_compare(Result, A, B) :-
-    % Example: Comparing atoms by custom weights
-    nc_weight(A, WA),
-    nc_weight(B, WB),
-    (WA==WB-> compare(Result, WB, WA); compare(Result, A, B)).
-
-% Example weight mapping for atomics
-nc_weight(Attvar, 7):- attvar(Attvar),!.
-nc_weight(Var, 8):- var(Var),!.
-nc_weight(T, N):- is_decl_mtype(T,N),!.
-nc_weight(T, N):- is_decl_utype(T,N),!.
-nc_weight(T, 6):- atomic(T),!.
-
-
-
+:- ensure_loaded(metta_typed_functions).