diff --git a/src/canary/metta_corelib.pl b/src/canary/metta_corelib.pl index a4fb830e8d6..ce3c7f0aabf 100755 --- a/src/canary/metta_corelib.pl +++ b/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'). diff --git a/src/canary/metta_eval.pl b/src/canary/metta_eval.pl index e98268432ee..d9dc8d06573 100755 --- a/src/canary/metta_eval.pl +++ b/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). diff --git a/src/canary/metta_ontology.pfc.pl b/src/canary/metta_ontology.pfc.pl index 9bceb723078..3440e6008cf 100755 --- a/src/canary/metta_ontology.pfc.pl +++ b/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.")]). diff --git a/tests/baseline_compat/hyperon-mettalog_sanity/xor_test.metta b/tests/baseline_compat/hyperon-mettalog_sanity/xor_test.metta new file mode 100644 index 00000000000..de1b1c5d540 --- /dev/null +++ b/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)