Merge branch 'main' into artur-das-test

Author: vsbogd

lib/src/metta/runner/stdlib/core.rs

@@ -253,65 +253,6 @@ impl CustomExecute for CaptureOp {
     }
 }
 
-#[derive(Clone, Debug)]
-pub struct CaseOp {
-    space: DynSpace,
-    settings: PragmaSettings,
-}
-
-grounded_op!(CaseOp, "case");
-
-impl CaseOp {
-    pub fn new(space: DynSpace, settings: PragmaSettings) -> Self {
-        Self{ space, settings }
-    }
-}
-
-impl Grounded for CaseOp {
-    fn type_(&self) -> Atom {
-        Atom::expr([ARROW_SYMBOL, ATOM_TYPE_ATOM, ATOM_TYPE_EXPRESSION, ATOM_TYPE_UNDEFINED])
-    }
-
-    fn as_execute(&self) -> Option<&dyn CustomExecute> {
-        Some(self)
-    }
-}
-
-impl CustomExecute for CaseOp {
-    fn execute(&self, args: &[Atom]) -> Result<Vec<Atom>, ExecError> {
-        let arg_error = || ExecError::from("case expects two arguments: atom and expression of cases");
-        let cases = args.get(1).ok_or_else(arg_error)?;
-        let atom = args.get(0).ok_or_else(arg_error)?;
-        log::debug!("CaseOp::execute: atom: {}, cases: {:?}", atom, cases);
-
-        let switch = |interpreted: Atom| -> Atom {
-            Atom::expr([sym!("switch"), interpreted, cases.clone()])
-        };
-
-        // Interpreting argument inside CaseOp is required because otherwise `Empty` result
-        // calculated inside interpreter cuts the whole branch of the interpretation. Also we
-        // cannot use `unify` in a unit test because after interpreting `(chain... (chain
-        // (metta (unify ...) Atom <space>)) ...)` `chain` executes `unify` and also gets
-        // `Empty` even if we have `Atom` as a resulting type. It can be solved by different ways.
-        // One way is to invent new type `EmptyType` (type of the `Empty` atom) and use this type
-        // in a function to allow `Empty` atoms as an input. `EmptyType` type should not be
-        // casted to the `%Undefined%` thus one cannot pass `Empty` to the function which accepts
-        // `%Undefined%`. Another way is to introduce "call" level. Thus if function called
-        // returned the result to the `chain` it should stop reducing it and insert it into the
-        // last argument.
-        let results = interpret(self.space.clone(), atom, self.settings.clone());
-        log::debug!("CaseOp::execute: atom results: {:?}", results);
-        let results = match results {
-            Ok(results) if results.is_empty() =>
-                vec![switch(EMPTY_SYMBOL)],
-            Ok(results) =>
-                results.into_iter().map(|atom| switch(atom)).collect(),
-            Err(err) => vec![Atom::expr([ERROR_SYMBOL, atom.clone(), Atom::sym(err)])],
-        };
-        Ok(results)
-    }
-}
-
 fn collapse_add_next_atom_from_collapse_bind_result(args: &[Atom]) -> Result<Vec<Atom>, ExecError> {
     let arg0_error = || ExecError::from("Expression is expected as a first argument");
     let list = TryInto::<&ExpressionAtom>::try_into(args.get(0).ok_or_else(arg0_error)?).map_err(|_| arg0_error())?;
@@ -347,8 +288,6 @@ pub(super) fn register_context_independent_tokens(tref: &mut Tokenizer) {
 }
 
 pub(super) fn register_context_dependent_tokens(tref: &mut Tokenizer, space: &DynSpace, metta: &Metta) {
-    let case_op = Atom::gnd(CaseOp::new(space.clone(), metta.settings().clone()));
-    tref.register_token(regex(r"case"), move |_| { case_op.clone() });
     let capture_op = Atom::gnd(CaptureOp::new(space.clone(), metta.settings().clone()));
     tref.register_token(regex(r"capture"), move |_| { capture_op.clone() });
     let pragma_op = Atom::gnd(PragmaOp::new(metta.settings().clone()));
@@ -409,6 +348,18 @@ mod tests {
         assert_eq!(result, Ok(vec![vec![expr!("nok")]]));
     }
 
+    #[test]
+    fn metta_case_error() {
+        let program = "
+            (= (err) (Error (err) \"Test error\"))
+            !(case (err) (
+              ((Error $a \"Test error\") ())
+              ($_ (Error $_ \"Error is expected\"))
+              ))
+        ";
+        assert_eq!(run_program(program), Ok(vec![vec![UNIT_ATOM]]));
+    }
+
     #[test]
     fn test_pragma_interpreter_bare_minimal() {
         let program = "
@@ -503,8 +454,8 @@ mod tests {
         let nested = run_program("!(sealed ($c) (quote (= ($a $x $c) ($b))))");
         let simple_replace = run_program("!(sealed ($z $x) (quote (= ($y $z))))");
 
-        assert!(hyperon_atom::matcher::atoms_are_equivalent(&nested.unwrap()[0][0], &expr!("quote" ("=" (a b c) (z)))));
-        assert!(hyperon_atom::matcher::atoms_are_equivalent(&simple_replace.unwrap()[0][0], &expr!("quote" ("=" (y z)))));
+        assert!(atoms_are_equivalent(&nested.unwrap()[0][0], &expr!("quote" ("=" (a b c) (z)))));
+        assert!(atoms_are_equivalent(&simple_replace.unwrap()[0][0], &expr!("quote" ("=" (y z)))));
     }
 
     #[test]

lib/src/metta/runner/stdlib/stdlib.metta

@@ -310,7 +310,7 @@
       (return $then) ))))))
 
 ; Difference between `switch` and `case` is a way how they interpret `Empty`
-; result. `CaseOp` interprets first argument inside itself and then manually
+; result. `case` interprets first argument inside itself and then manually
 ; checks whether result is empty. `switch` is interpreted in a context of
 ; main interpreter. Minimal interpreter correctly passes `Empty` as an
 ; argument to the `switch` but when `switch` is called from MeTTa interpreter
@@ -325,6 +325,10 @@
   (@return "Result which corresponds to the pattern which is matched with the passed atom first"))
 (: switch (-> %Undefined% Expression %Undefined%))
 (= (switch $atom $cases)
+   (id (switch-minimal $atom $cases)))
+
+(: switch-minimal (-> Atom Expression Atom))
+(= (switch-minimal $atom $cases)
   (function (chain (decons-atom $cases) $list
     (chain (eval (switch-internal $atom $list)) $res
       (chain (eval (if-equal $res NotReducible Empty $res)) $x (return $x)) ))))
@@ -335,10 +339,11 @@
     (@param "Atom (it will be evaluated)")
     (@param "Deconsed tuple of pairs mapping condition patterns to results")))
   (@return "Result of evaluating of Atom bound to met condition"))
+(: switch-internal (-> Atom Expression Atom))
 (= (switch-internal $atom (($pattern $template) $tail))
   (function (unify $atom $pattern
     (return $template)
-    (chain (eval (switch $atom $tail)) $ret (return $ret)) )))
+    (chain (eval (switch-minimal $atom $tail)) $ret (return $ret)) )))
 
 ; TODO: Type is used here, but there is no definition for the -> type
 ; constructor for instance, thus in practice it matches because -> has
@@ -351,15 +356,14 @@
   (@return "True if type is a function type, False - otherwise"))
 (: is-function (-> Type Bool))
 (= (is-function $type)
-  (function (chain (eval (get-metatype $type)) $meta
-    (eval (switch ($type $meta) (
-      (($type Expression)
-        (chain (decons-atom $type) $pair
-          (unify ($head $_tail) $pair
-            (unify $head -> (return True) (return False))
-            (return (Error (is-function $type) "is-function non-empty expression as an argument")) )))
-      (($type $meta) (return False))
-    ))))))
+    (let $mtype (get-metatype $type)
+        (unify $mtype Expression
+        (let $size (size-atom $type)
+            (unify $size 0
+                False
+                (let ($h $t) (decons-atom $type)
+                    (unify $h -> True False))))
+        False)))
 
 (@doc type-cast
   (@desc "Casts atom passed as a first argument to the type passed as a second argument using space as a context")
@@ -735,6 +739,7 @@
   (@return "Expression containing full documentation on function"))
 (: @doc-formal (-> DocItem DocKindFunction DocType DocDescription DocParameters DocReturn DocFormal))
 (: @doc-formal (-> DocItem DocKindAtom DocType DocDescription DocFormal))
+(: @doc-formal (-> DocItem DocKindFunction DocType DocDescription DocFormal))
 
 (@doc @item
   (@desc "Used for documentation purposes. Converts atom/function's name to DocItem")
@@ -1167,6 +1172,12 @@
     (@param "Atom (it will be evaluated)")
     (@param "Tuple of pairs mapping condition patterns to results")))
   (@return "Result of evaluating of Atom bound to met condition"))
+(: case (-> Atom Expression %Undefined%))
+(= (case $atom $cases)
+   (let $c (collapse $atom)
+     (if (== (noeval $c) ())
+       (id (switch-minimal Empty $cases))
+       (chain (eval (superpose $c)) $e (id (switch-minimal $e $cases))) )))
 
 (@doc capture
   (@desc "Wraps an atom and capture the current space")

lib/tests/test_stdlib.metta

@@ -22,6 +22,20 @@
    (case (unify (B C) (C B) ok  Empty) ((ok ok) (Empty nok)))
    (nok))
 
+; case/switch/switch-minimal check if result is being reduced or not
+
+!(assertEqual
+    (case 5 ((4 False) (5 (+ 1 2))))
+    3)
+
+!(assertEqual
+    (switch 5 ((4 False) (5 (+ 1 2))))
+    3)
+
+!(assertEqual
+    (switch-minimal 5 ((4 False) (5 (+ 1 2))))
+    (noeval (+ 1 2)))
+
 ; assertIncludes
 !(assertEqualToResult
    (assertIncludes (superpose (41 42 43)) (42))