Merge branch 'main' of https://github.com/TeamSPoon/metta-wam

src/canary/metta_corelib.pl

@@ -77,6 +77,10 @@
 metta_atom_corelib_defn( [=, [or, 'False', 'True'], 'True']).
 metta_atom_corelib_defn( [=, [or, 'True', 'False'], 'True']).
 metta_atom_corelib_defn( [=, [or, 'True', 'True'], 'True']).
+metta_atom_corelib_defn( [=, [xor, 'False', 'False'], 'False']).
+metta_atom_corelib_defn( [=, [xor, 'False', 'True'], 'True']).
+metta_atom_corelib_defn( [=, [xor, 'True', 'False'], 'True']).
+metta_atom_corelib_defn( [=, [xor, 'True', 'True'], 'False']).
 metta_atom_corelib_defn( [=, [quote, _], 'NotReducible']).
 metta_atom_corelib_defn( [=, [reduce, A, B, C], [chain, [eval, A], D, [eval, ['if-error', D, D, [eval, ['if-empty', D, [eval, [subst, A, B, C]], [eval, [reduce, D, B, C]]]]]]]]).
 metta_atom_corelib_defn( [=, [subst, A, B, C], [match, A, B, C, ['Error', [subst, A, B, C], "subst expects a variable as a second argument"]]]).
@@ -129,6 +133,7 @@
 metta_atom_corelib_types( [:, let, [->, 'Atom', '%Undefined%', 'Atom', 'Atom']]).
 metta_atom_corelib_types( [:, match, [->, 'Atom', 'Atom', 'Atom', '%Undefined%']]).
 metta_atom_corelib_types( [:, or, [->, 'Bool', 'Bool', 'Bool']]).
+metta_atom_corelib_types( [:, xor, [->, 'Bool', 'Bool', 'Bool']]).
 metta_atom_corelib_types( [:, quote, [->, 'Atom', 'Atom']]).
 metta_atom_corelib_types( [:, return, [->, 'Atom', 'ReturnType']]).
 metta_atom_corelib_types( [:, switch, [->, '%Undefined%', 'Expression', 'Atom']]).
@@ -181,6 +186,7 @@
 
 op_decl(and, [ 'Bool', 'Bool' ], 'Bool').
 op_decl(or, [ 'Bool', 'Bool' ], 'Bool').
+op_decl(xor, [ 'Bool', 'Bool' ], 'Bool').
 op_decl(case, [ 'Expression', 'Atom' ], 'Atom').
 
 op_decl(apply, [ 'Atom', 'Variable', 'Atom' ], 'Atom').

src/canary/metta_eval.pl

@@ -1334,6 +1334,8 @@
 is_comma(',').
 is_comma('{}').
 
+bool_xor(A,B) :- (A == 'True'; B == 'True'), \+ (A == B).
+
 eval_20(Eq,RetType,Depth,Self,['and',X,Y],TF):- !,
     as_tf(( (eval_args_true(Eq,RetType,Depth,Self,X),
              eval_args_true(Eq,RetType,Depth,Self,Y))), TF).
@@ -1343,6 +1345,12 @@
   as_tf(( (eval_args_true(Eq,RetType,Depth,Self,X);
            eval_args_true(Eq,RetType,Depth,Self,Y))), TF).
 
+eval_20(Eq,RetType,Depth,Self,['xor',X,Y],TF):- !,
+  as_tf(  (eval_args_true(Eq,RetType,Depth,Self,X)),  XTF),  % evaluate X
+  as_tf(  (eval_args_true(Eq,RetType,Depth,Self,Y)),  YTF),  % evaluate Y
+  as_tf(  (bool_xor(XTF,YTF))			   ,   TF).   
+
+
 eval_20(Eq,RetType,Depth,Self,['not',X],TF):- !,
    as_tf(( \+ eval_args_true(Eq,RetType,Depth,Self,X)), TF).
 

src/canary/metta_ontology.pfc.pl

@@ -421,6 +421,7 @@
 properties('&corelib','\\=', [logic, qhelp("Inequality test."), inequality]).
 properties('&corelib','==', [logic, qhelp("Equality test."), equality_test]).
 properties('&corelib','or', [logic, qhelp("Logical OR."), logical_or]).
+properties('&corelib','xor', [logic, qhelp("Logical XOR."), logical_xor])
 properties('&corelib','and', [logic, qhelp("Logical AND."), logical_and]).
 properties('&corelib','not', [logic, qhelp("Logical NOT."), logical_not]).
 properties('&corelib','quote', [evaluation_control, qhelp("Prevents evaluation, treating input as literal.")]).

tests/baseline_compat/hyperon-mettalog_sanity/xor_test.metta

@@ -0,0 +1,19 @@
+;; Basic XOR Logic
+!(assertEqual (xor True False) True)
+!(assertEqual (xor False True) True)
+!(assertEqual (xor True True) False)
+!(assertEqual (xor False False) False)
+
+;; XOR with Expressions
+!(assertEqual (xor (> 5 3) (< 2 1)) True)
+!(assertEqual (xor (== 1 1) (== 2 2)) False)
+!(assertEqual (xor (not True) (and True False)) False)
+
+(: mprogn (-> Atom Atom Atom ))
+(= (mprogn $code1 $code2) (let $_ (eval $code1) (eval $code2)))
+
+;; XOR with Side Effects to Ensure Both Expressions Are Evaluated
+!(assertEqual (xor (mprogn (println! "First") True) (mprogn (println! "Second") False)) True)
+!(assertEqual (xor (mprogn (println! "First") True) (mprogn (println! "Second") True)) False)
+!(assertEqual (xor (mprogn (println! "First") False) (mprogn (println! "Second") True)) True)
+!(assertEqual (xor (mprogn (println! "First") False) (mprogn (println! "Second") False)) False)