From 6565a3f76cb0b66c6efe6adc587f2e57712577bc Mon Sep 17 00:00:00 2001 From: TeamSPoon Date: Sat, 17 Aug 2024 16:56:27 -0700 Subject: [PATCH] Towards Create and Integrate stdlib_mettalog.metta and/or corelib.metta https://github.com/trueagi-io/metta-wam/issues/72 --- src/canary/corelib.metta | 1 + src/canary/metta_prelude.metta | 430 ------------------------------- src/canary/metta_prelude_comp.pl | 242 ----------------- src/canary/stdlib_mettalog.metta | 101 ++++++-- 4 files changed, 77 insertions(+), 697 deletions(-) create mode 100755 src/canary/corelib.metta delete mode 100755 src/canary/metta_prelude.metta delete mode 100755 src/canary/metta_prelude_comp.pl diff --git a/src/canary/corelib.metta b/src/canary/corelib.metta new file mode 100755 index 00000000000..c066daf7e0e --- /dev/null +++ b/src/canary/corelib.metta @@ -0,0 +1 @@ +!(include stdlib_mettalog.metta) diff --git a/src/canary/metta_prelude.metta b/src/canary/metta_prelude.metta deleted file mode 100755 index ebeac455660..00000000000 --- a/src/canary/metta_prelude.metta +++ /dev/null @@ -1,430 +0,0 @@ - -(: unify (-> Atom Atom Atom Atom %Undefined%)) -(: if (-> Bool Atom Atom $t#330)) -(: quote (-> Atom Atom)) -(: Error (-> Atom Atom ErrorType)) -(: empty (-> %Undefined%)) -(: get-atoms (-> Space Atom)) -(: add-atom (-> Space Atom (->))) -(: remove-atom (-> Space Atom (->))) -(: add-atom (-> Space Atom (->))) - -;`$then`, `$else` should be of `Atom` type to avoid evaluation -; and infinite cycle in inference -(: if (-> Bool Atom Atom $t)) -(= (if True $then $else) $then) -(= (if False $then $else) $else) - -(: Error (-> Atom Atom ErrorType)) - -(= (if-non-empty-expression $atom $then $else) - (chain (eval (get-metatype $atom)) $type - (eval (if-equal $type Expression - (eval (if-equal $atom () $else $then)) - $else )))) - -(= (if-decons $atom $head $tail $then $else) - (eval (if-non-empty-expression $atom - (chain (decons $atom) $list - (match $list ($head $tail) $then $else) ) - $else ))) - -(= (if-empty $atom $then $else) - (eval (if-equal $atom Empty $then $else))) - -(= (if-error $atom $then $else) - (eval (if-decons $atom $head $_ - (eval (if-equal $head Error $then $else)) - $else ))) - -(= (return-on-error $atom $then) - (eval (if-empty $atom Empty - (eval (if-error $atom $atom - $then ))))) - -(= (car $atom) - (eval (if-decons $atom $head $_ - $head - (Error (car $atom) "car expects a non-empty expression as an argument") ))) - -(= (switch $atom $cases) - (chain (decons $cases) $list (eval (switch-internal $atom $list)))) - -(= (switch-internal $atom (($pattern $template) $tail)) - (match $atom $pattern $template (eval (switch $atom $tail)))) - -(= (subst $atom $var $templ) - (match $atom $var $templ - (Error (subst $atom $var $templ) - "subst expects a variable as a second argument") )) - -(= (reduce $atom $var $templ) - (chain (eval $atom) $res - (eval (if-error $res $res - (eval (if-empty $res - (eval (subst $atom $var $templ)) - (eval (reduce $res $var $templ)) )))))) - -(= (type-cast $atom $type $space) - (chain (eval (get-type $atom $space)) $actual-type - (eval (switch ($actual-type $type) - ( - ((%Undefined% $_) $atom) - (($_ %Undefined%) $atom) - (($type $_) $atom) - ($_ (Error $atom BadType)) ))))) - -(= (is-function $type) - (chain (eval (get-metatype $type)) $meta - (eval (switch ($type $meta) - ( - (($_ Expression) - (chain (eval (car $type)) $head - (match $head -> True False) )) - ($_ False) ))))) - -(= (interpret $atom $type $space) - (chain (eval (get-metatype $atom)) $meta - (eval (switch ($type $meta) - ( - ((Atom $_meta) $atom) - (($meta $meta) $atom) - (($_type Variable) $atom) - - (($_type Symbol) (eval (type-cast $atom $type $space))) - (($_type Grounded) (eval (type-cast $atom $type $space))) - (($_type Expression) (eval (interpret-expression $atom $type $space))) ))))) - -(= (interpret-expression $atom $type $space) - (eval (if-decons $atom $op $args - (chain (eval (get-type $op $space)) $op-type - (chain (eval (is-function $op-type)) $is-func - (match $is-func True - (chain (eval (interpret-func $atom $op-type $space)) $reduced-atom - (eval (call $reduced-atom $type $space)) ) - (chain (eval (interpret-tuple $atom $space)) $reduced-atom - (eval (call $reduced-atom $type $space)) )))) - (eval (type-cast $atom $type $space)) ))) - -(= (interpret-func $expr $type $space) - (eval (if-decons $expr $op $args - (chain (eval (interpret $op $type $space)) $reduced-op - (eval (return-on-error $reduced-op - (eval (if-decons $type $arrow $arg-types - (chain (eval (interpret-args $expr $args $arg-types $space)) $reduced-args - (eval (return-on-error $reduced-args - (cons $reduced-op $reduced-args) ))) - (Error $type "Function type expected") ))))) - (Error $expr "Non-empty expression atom is expected") ))) - -(= (interpret-args $atom $args $arg-types $space) - (match $args () - (match $arg-types ($ret) () (Error $atom BadType)) - (eval (if-decons $args $head $tail - (eval (if-decons $arg-types $head-type $tail-types - (chain (eval (interpret $head $head-type $space)) $reduced-head - ; check that head was changed otherwise Error or Empty in the head - ; can be just an argument which is passed by intention - (eval (if-equal $reduced-head $head - (eval (interpret-args-tail $atom $reduced-head $tail $tail-types $space)) - (eval (return-on-error $reduced-head - (eval (interpret-args-tail $atom $reduced-head $tail $tail-types $space)) ))))) - (Error $atom BadType) )) - (Error (interpret-atom $atom $args $arg-types $space) - "Non-empty expression atom is expected") )))) - -(= (interpret-args-tail $atom $head $args-tail $args-tail-types $space) - (chain (eval (interpret-args $atom $args-tail $args-tail-types $space)) $reduced-tail - (eval (return-on-error $reduced-tail - (cons $head $reduced-tail) )))) - -(= (interpret-tuple $atom $space) - (match $atom () - $atom - (eval (if-decons $atom $head $tail - (chain (eval (interpret $head %Undefined% $space)) $rhead - (chain (eval (interpret-tuple $tail $space)) $rtail - (cons $rhead $rtail) )) - (Error (interpret-tuple $atom $space) "Non-empty expression atom is expected as an argument") )))) - -(= (call $atom $type $space) - (chain (eval $atom) $result - (eval (if-empty $result $atom - (eval (if-error $result $result - (eval (interpret $result $type $space)) )))))) - -(: ErrorType Type) -(: Error (-> Atom Atom ErrorType)) -(: ReturnType Type) -(: return (-> Atom ReturnType)) - -(: function (-> Atom Atom)) -(: eval (-> Atom Atom)) -(: chain (-> Atom Variable Atom Atom)) -(: unify (-> Atom Atom Atom Atom Atom)) -(: cons (-> Atom Atom Atom)) -(: decons (-> Atom Atom)) - -(: id (-> Atom Atom)) -(= (id $x) $x) - -(: apply (-> Atom Variable Atom Atom)) -(= (apply $atom $var $templ) - (function (chain (eval (id $atom)) $var (return $templ))) ) - -(: if-non-empty-expression (-> Atom Atom Atom Atom)) -(= (if-non-empty-expression $atom $then $else) - (function (chain (eval (get-metatype $atom)) $type - (eval (if-equal $type Expression - (eval (if-equal $atom () (return $else) (return $then))) - (return $else) ))))) - -(: if-decons (-> Atom Variable Variable Atom Atom Atom)) -(= (if-decons $atom $head $tail $then $else) - (function (eval (if-non-empty-expression $atom - (chain (decons $atom) $list - (unify $list ($head $tail) (return $then) (return $else)) ) - (return $else) )))) - -(: if-empty (-> Atom Atom Atom Atom)) -(= (if-empty $atom $then $else) - (function (eval (if-equal $atom Empty (return $then) (return $else)))) ) - -(: if-not-reducible (-> Atom Atom Atom Atom)) -(= (if-not-reducible $atom $then $else) - (function (eval (if-equal $atom NotReducible (return $then) (return $else)))) ) - -(: if-error (-> Atom Atom Atom Atom)) -(= (if-error $atom $then $else) - (function (eval (if-decons $atom $head $_ - (eval (if-equal $head Error (return $then) (return $else))) - (return $else) )))) - -(: return-on-error (-> Atom Atom Atom)) -(= (return-on-error $atom $then) - (function (eval (if-empty $atom (return (return Empty)) - (eval (if-error $atom (return (return $atom)) - (return $then) )))))) - -(: switch (-> %Undefined% Expression Atom)) -(= (switch $atom $cases) - (function (chain (decons $cases) $list - (chain (eval (switch-internal $atom $list)) $res - (chain (eval (if-not-reducible $res Empty $res)) $x (return $x)) )))) - -(= (switch-internal $atom (($pattern $template) $tail)) - (function (unify $atom $pattern - (return $template) - (chain (eval (switch $atom $tail)) $ret (return $ret)) ))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; MeTTa interpreter implementation ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(= (match-types $type1 $type2 $then $else) - (function (eval (if-equal $type1 %Undefined% - (return $then) - (eval (if-equal $type2 %Undefined% - (return $then) - (eval (if-equal $type1 Atom - (return $then) - (eval (if-equal $type2 Atom - (return $then) - (unify $type1 $type2 (return $then) (return $else)) )))))))))) - -(= (type-cast $atom $type $space) - (function (chain (eval (get-metatype $atom)) $meta - (eval (if-equal $type $meta - (return $atom) - ; TODO: the proper way to get types is something like - ; `(collapse (get-type ))` but it leads to the infinite - ; recursion because interpreter called by `collapse` evaluates - ; `type-cast` again. - (chain (eval (collapse-get-type $atom $space)) $actual-types - (chain (eval (foldl-atom $actual-types False - $a $b (chain (eval (match-types $b $type True False)) $is-b-comp - (chain (eval (or $a $is-b-comp)) $or $or) ))) $is-some-comp - (eval (if $is-some-comp - (return $atom) - (return (Error $atom BadType)) ))))))))) - - -(= (is-function $type) - (function (chain (eval (get-metatype $type)) $meta - (eval (switch ($type $meta) ( - (($_ Expression) - (eval (if-decons $type $head $_tail - (unify $head -> (return True) (return False)) - (return (Error (is-function $type) "is-function non-empty expression as an argument")) ))) - ($_ (return False)) - )))))) - -(: filter-atom (-> Expression Variable Atom Expression)) -(= (filter-atom $list $var $filter) - (function (eval (if-decons $list $head $tail - (chain (eval (filter-atom $tail $var $filter)) $tail-filtered - (chain (eval (apply $head $var $filter)) $filter-expr - (chain $filter-expr $is-filtered - (eval (if $is-filtered - (chain (cons $head $tail-filtered) $res (return $res)) - (return $tail-filtered) ))))) - (return ()) )))) - -(: map-atom (-> Expression Variable Atom Expression)) -(= (map-atom $list $var $map) - (function (eval (if-decons $list $head $tail - (chain (eval (map-atom $tail $var $map)) $tail-mapped - (chain (eval (apply $head $var $map)) $map-expr - (chain $map-expr $head-mapped - (chain (cons $head-mapped $tail-mapped) $res (return $res)) ))) - (return ()) )))) - -(: foldl-atom (-> Expression Atom Variable Variable Atom Atom)) -(= (foldl-atom $list $init $a $b $op) - (function (eval (if-decons $list $head $tail - (chain (eval (apply $init $a $op)) $op-init - (chain (eval (apply $head $b $op-init)) $op-head - (chain $op-head $head-folded - (chain (eval (foldl-atom $tail $head-folded $a $b $op)) $res (return $res)) ))) - (return $init) )))) - -(= (interpret $atom $type $space) - (function (chain (eval (get-metatype $atom)) $meta - (eval (if-equal $type Atom - (return $atom) - (eval (if-equal $type $meta - (return $atom) - (eval (switch ($type $meta) ( - (($_type Variable) (return $atom)) - (($_type Symbol) - (chain (eval (type-cast $atom $type $space)) $ret (return $ret))) - (($_type Grounded) - (chain (eval (type-cast $atom $type $space)) $ret (return $ret))) - (($_type Expression) - (chain (eval (interpret-expression $atom $type $space)) $ret (return $ret))) - )))))))))) - -(= (interpret-expression $atom $type $space) - (function (eval (if-decons $atom $op $args - (chain (eval (get-type $op $space)) $op-type - (chain (eval (is-function $op-type)) $is-func - (unify $is-func True - (chain (eval (interpret-func $atom $op-type $type $space)) $reduced-atom - (chain (eval (metta-call $reduced-atom $type $space)) $ret (return $ret)) ) - (chain (eval (interpret-tuple $atom $space)) $reduced-atom - (chain (eval (metta-call $reduced-atom $type $space)) $ret (return $ret)) )))) - (chain (eval (type-cast $atom $type $space)) $ret (return $ret)) )))) - -(= (interpret-func $expr $type $ret-type $space) - (function (eval (if-decons $expr $op $args - (chain (eval (interpret $op $type $space)) $reduced-op - (eval (return-on-error $reduced-op - (eval (if-decons $type $arrow $arg-types - (chain (eval (interpret-args $expr $args $arg-types $ret-type $space)) $reduced-args - (eval (return-on-error $reduced-args - (chain (cons $reduced-op $reduced-args) $r (return $r))))) - (return (Error $type "Function type expected")) ))))) - (return (Error $expr "Non-empty expression atom is expected")) )))) - -(= (interpret-args $atom $args $arg-types $ret-type $space) - (function (unify $args () - (eval (if-decons $arg-types $actual-ret-type $_tail - (eval (match-types $actual-ret-type $ret-type - (return ()) - (return (Error $atom BadType)) )) - (return (Error (interpret-args $atom $args $arg-types $ret-type $space) "interpret-args expects a non-empty value for $arg-types argument")) )) - (eval (if-decons $args $head $tail - (eval (if-decons $arg-types $head-type $tail-types - (chain (eval (interpret $head $head-type $space)) $reduced-head - ; check that head was changed otherwise Error or Empty in the head - ; can be just an argument which is passed by intention - (eval (if-equal $reduced-head $head - (chain (eval (interpret-args-tail $atom $reduced-head $tail $tail-types $ret-type $space)) $ret (return $ret)) - (eval (return-on-error $reduced-head - (chain (eval (interpret-args-tail $atom $reduced-head $tail $tail-types $ret-type $space)) $ret (return $ret)) ))))) - (return (Error $atom BadType)) )) - (return (Error (interpret-atom $atom $args $arg-types $space) "Non-empty expression atom is expected")) ))))) - -(= (interpret-args-tail $atom $head $args-tail $args-tail-types $ret-type $space) - (function (chain (eval (interpret-args $atom $args-tail $args-tail-types $ret-type $space)) $reduced-tail - (eval (return-on-error $reduced-tail - (chain (cons $head $reduced-tail) $ret (return $ret)) ))))) - -(= (interpret-tuple $atom $space) - (function (unify $atom () - (return $atom) - (eval (if-decons $atom $head $tail - (chain (eval (interpret $head %Undefined% $space)) $rhead - (eval (if-empty $rhead (return Empty) - (chain (eval (interpret-tuple $tail $space)) $rtail - (eval (if-empty $rtail (return Empty) - (chain (cons $rhead $rtail) $ret (return $ret)) )))))) - (return (Error (interpret-tuple $atom $space) "Non-empty expression atom is expected as an argument")) ))))) - -(= (metta-call $atom $type $space) - (function (eval (if-error $atom (return $atom) - (chain (eval $atom) $result - (eval (if-not-reducible $result (return $atom) - (eval (if-empty $result (return Empty) - (eval (if-error $result (return $result) - (chain (eval (interpret $result $type $space)) $ret (return $ret)) ))))))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Standard library written in MeTTa ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;`$then`, `$else` should be of `Atom` type to avoid evaluation -; and infinite cycle in inference -(: if (-> Bool Atom Atom $t)) -(= (if True $then $else) $then) -(= (if False $then $else) $else) - -(: or (-> Bool Bool Bool)) -(= (or False False) False) -(= (or False True) True) -(= (or True False) True) -(= (or True True) True) - -(: and (-> Bool Bool Bool)) -(= (and False False) False) -(= (and False True) False) -(= (and True False) False) -(= (and True True) True) - -(: match (-> Atom Atom Atom %Undefined%)) -(= (match $space $pattern $template) - (unify $pattern $space $template Empty)) - -(: let (-> Atom %Undefined% Atom Atom)) -(= (let $pattern $atom $template) - (unify $atom $pattern $template Empty)) - -(: let* (-> Expression Atom Atom)) -(= (let* $pairs $template) - (eval (if-decons $pairs ($pattern $atom) $tail - (let $pattern $atom (let* $tail $template)) - $template ))) - -(: car-atom (-> Expression Atom)) -(= (car-atom $atom) - (eval (if-decons $atom $head $_ - $head - (Error (car-atom $atom) "car-atom expects a non-empty expression as an argument") ))) - -(: cdr-atom (-> Expression Expression)) -(= (cdr-atom $atom) - (eval (if-decons $atom $_ $tail - $tail - (Error (cdr-atom $atom) "cdr-atom expects a non-empty expression as an argument") ))) - -(: quote (-> Atom Atom)) -(= (quote $atom) NotReducible) - -(: unquote (-> %Undefined% %Undefined%)) -(= (unquote (quote $atom)) $atom) - -; TODO: there is no way to define operation which consumes any number of -; arguments and returns unit -(= (nop) ()) -(= (nop $x) ()) - diff --git a/src/canary/metta_prelude_comp.pl b/src/canary/metta_prelude_comp.pl deleted file mode 100755 index 8594b787f34..00000000000 --- a/src/canary/metta_prelude_comp.pl +++ /dev/null @@ -1,242 +0,0 @@ -%;`$then`, `$else` should be of `Atom` type to avoid evaluation -%; and infinite cycle in inference -metta_type('&self',if,[ ->, 'Bool','Atom','Atom',_]). -metta_defn_ES([if,'True',A,_],A). -metta_defn_ES([if,'False',_,A],A). -metta_type('&self','Error',[->,'Atom','Atom','ErrorType']). -metta_defn_ES(['if-non-empty-expression',A,B,C],[ chain, - [ eval, - ['get-metatype',A]], - D, - [ eval, - [ 'if-equal', D,'Expression', - [ eval, - [ 'if-equal', A, [], C, B]], - C]]]). -metta_defn_ES([ 'if-decons', A,B,C,D, - E],[ eval, - [ 'if-non-empty-expression', - A, - [ chain, - [decons,A], - F, - [ match, - F, - [B,C], D,E]], - E]]). -metta_defn_ES(['if-empty',A,B,C],[ eval, - [ 'if-equal', A,'Empty',B,C]]). -metta_defn_ES(['if-error',A,B,C],[ eval, - [ 'if-decons', A,D,_, - [ eval, - [ 'if-equal', D,'Error',B,C]], - C]]). -metta_defn_ES(['return-on-error',A,B],[ eval, - [ 'if-empty', A,'Empty', - [ eval, - ['if-error',A,A,B]]]]). -metta_defn_ES([car,A],[ eval, - [ 'if-decons', A,B,_,B, - [ 'Error', - [car,A], - '$STRING'("car expects a non-empty expression as an argument")]]]). -metta_defn_ES([switch,A,B],[ chain, - [decons,B], - C, - [ eval, - ['switch-internal',A,C]]]). -metta_defn_ES([ 'switch-internal', - A, - [ [B,C], - D]],[ match, A,B,C, - [ eval, - [switch,A,D]]]). -metta_defn_ES([subst,A,B,C],[ match, A,B,C, - [ 'Error', - [subst,A,B,C], - '$STRING'("subst expects a variable as a second argument")]]). -metta_defn_ES([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_defn_ES(['type-cast',A,B,C],[ chain, - [ eval, - ['get-type',A,C]], - D, - [ eval, - [ switch, - [D,B], - [ [ ['%Undefined%',E], - A], - [ [E,'%Undefined%'], - A], - [ [B,E], - A], - [ E, - ['Error',A,'BadType']]]]]]). -metta_defn_ES(['is-function',A],[ chain, - [ eval, - ['get-metatype',A]], - B, - [ eval, - [ switch, - [A,B], - [ [ [C,'Expression'], - [ chain, - [ eval, - [car,A]], - D, - [ match, D,->,'True','False']]], - [C,'False']]]]]). -metta_defn_ES([interpret,A,B,C],[ chain, - [ eval, - ['get-metatype',A]], - D, - [ eval, - [ switch, - [B,D], - [ [ ['Atom',_], - A], - [ [D,D], - A], - [ [E,'Variable'], - A], - [ [E,'Symbol'], - [ eval, - ['type-cast',A,B,C]]], - [ [E,'Grounded'], - [ eval, - ['type-cast',A,B,C]]], - [ [E,'Expression'], - [ eval, - ['interpret-expression',A,B,C]]]]]]]). -metta_defn_ES(['interpret-expression',A,B,C],[ eval, - [ 'if-decons', A,D,_, - [ chain, - [ eval, - ['get-type',D,C]], - E, - [ chain, - [ eval, - ['is-function',E]], - F, - [ match, F,'True', - [ chain, - [ eval, - ['interpret-func',A,E,C]], - G, - [ eval, - [call,G,B,C]]], - [ chain, - [ eval, - ['interpret-tuple',A,C]], - G, - [ eval, - [call,G,B,C]]]]]], - [ eval, - ['type-cast',A,B,C]]]]). -metta_defn_ES(['interpret-func',A,B,C],[ eval, - [ 'if-decons', A,D,E, - [ chain, - [ eval, - [interpret,D,B,C]], - F, - [ eval, - [ 'return-on-error', - F, - [ eval, - [ 'if-decons', B,_,G, - [ chain, - [ eval, - [ 'interpret-args', A,E,G, - C]], - H, - [ eval, - [ 'return-on-error', - H, - [cons,F,H]]]], - [ 'Error', B,'$STRING'("Function type expected")]]]]]], - [ 'Error', - A, - '$STRING'("Non-empty expression atom is expected")]]]). -metta_defn_ES([ 'interpret-args', A,B,C,D],[ match, - B, - [], - [ match, - C, - [_], - [], - ['Error',A,'BadType']], - [ eval, - [ 'if-decons', B,E,F, - [ eval, - [ 'if-decons', C,G,H, - [ chain, - [ eval, - [interpret,E,G,D]], - I, - [ eval, - [ 'if-equal', I,E, - [ eval, - [ 'interpret-args-tail', A,I,F, - H,D]], - [ eval, - [ 'return-on-error', - I, - [ eval, - [ 'interpret-args-tail', A,I,F, - H,D]]]]]]], - ['Error',A,'BadType']]], - [ 'Error', - [ 'interpret-atom', A,B,C, - D], - '$STRING'("Non-empty expression atom is expected")]]]]). -%; check that head was changed otherwise Error or Empty in the head -%; can be just an argument which is passed by intention -metta_defn_ES([ 'interpret-args-tail', A,B,C,D, - E],[ chain, - [ eval, - [ 'interpret-args', A,C,D,E]], - F, - [ eval, - [ 'return-on-error', - F, - [cons,B,F]]]]). -metta_defn_ES(['interpret-tuple',A,B],[ match, - A, - [], - A, - [ eval, - [ 'if-decons', A,C,D, - [ chain, - [ eval, - [interpret,C,'%Undefined%',B]], - E, - [ chain, - [ eval, - ['interpret-tuple',D,B]], - F, - [cons,E,F]]], - [ 'Error', - ['interpret-tuple',A,B], - '$STRING'("Non-empty expression atom is expected as an argument")]]]]). -metta_defn_ES([call,A,B,C],[ chain, - [eval,A], - D, - [ eval, - [ 'if-empty', D,A, - [ eval, - [ 'if-error', D,D, - [ eval, - [interpret,D,B,C]]]]]]]). -% 1,264,919 inferences, 0.139 CPU in 0.140 seconds (99% CPU, 9074539 Lips) -% (= metta_prelude.metta 0) - diff --git a/src/canary/stdlib_mettalog.metta b/src/canary/stdlib_mettalog.metta index d9f49d21229..a864a2abde8 100755 --- a/src/canary/stdlib_mettalog.metta +++ b/src/canary/stdlib_mettalog.metta @@ -65,11 +65,11 @@ (@doc if-unify (@desc "Matches two first arguments and returns third argument if they are matched and forth argument otherwise") (@params ( - (@param "First atom to if-unify with") - (@param "Second atom to if-unify with") + (@param "First atom to unify with") + (@param "Second atom to unify with") (@param "Result if two atoms unified successfully") (@param "Result otherwise"))) - (@return "Third argument when first two atoms are matched of forth one otherwise")) + (@return "Third argument when first two atoms are unifiable or forth one otherwise")) (: if-unify (-> Atom Atom Atom Atom %Undefined%)) ;; Implemented from Interpreters @@ -83,18 +83,6 @@ (= (if-unify-or-empty $a $b) (empty)) -;; Public MeTTa -(@doc unify - (@desc "Like Match ....") - (@params ( - (@param "The collection or space to match") - (@param "Second atom to unify with") - (@param "Result if two atoms unified successfully") - (@param "Result otherwise"))) - (@return "Third argument when found or forth one otherwise")) -(: unify (-> Atom Atom Atom Atom Atom)) -;; Implemented from Interpreters - ;; Public MeTTa (@doc cons-atom (@desc "Constructs an expression using two arguments") @@ -134,8 +122,8 @@ (@param "Expression in form (Atom Binding)"))) (@return "Non-deterministic list of Atoms")) ;; superpose-bind because `superpose` doesnt guarentee shared bindings -(: superpose-bind (-> Atom Atom)) ; We specialize them but leaving the old defs in case (: superpose-bind (-> Expression Atom)) +(: superpose-bind (-> Atom Atom)) ; We specialize them but leaving the old defs in case ;; Implemented from Interpreters ; Helper Minimal Metta? @@ -241,7 +229,7 @@ (@param "Tuple of pairs mapping condition patterns to results"))) (@return "Result which corresponds to the pattern which is matched with the passed atom first")) -;; Dumb MeTTaLog unwill we implent it +;; Dumb MeTTaLog? will we implement it? (: switch (-> Atom Atom Atom)) (= (switch $atom $list) (case (eval $atom) $list)) @@ -303,8 +291,9 @@ (@param "Type to cast atom to") (@param "Context atomspace"))) (@return "Atom if casting is successful, (Error ... BadType) otherwise")) +(: type-cast (-> Atom Atom Atom Atom)) ;; This impl is old and maybe not sufficiant? -(= (type-cast $atom $type $space) +(ALT= (type-cast $atom $type $space) (function (chain (eval (get-metatype $atom)) $meta (eval (if-equal $type $meta (return $atom) @@ -324,6 +313,7 @@ (@param "Atom to be returned if types can be unified") (@param "Atom to be returned if types cannot be unified"))) (@return "Third or fourth argument")) +(: match-types (-> Atom Atom Atom Atom Atom)) (= (match-types $type1 $type2 $then $else) (function (eval (if-equal $type1 %Undefined% (return $then) @@ -746,9 +736,11 @@ (@params ( (@param "Anything"))) (@return "Unit atom")) +(: nop (-> Atom (->))) ;; Implemented from Interpreters -(= (nop) ()) -(= (nop $x) ()) +(ALT= (nop $x) ()) +(: nop (-> EmptyType)) +(ALT= (nop) ()) ;; Public MeTTa (@doc empty @@ -757,11 +749,13 @@ (@return "Nothing")) (: empty (-> %Undefined%)) ;; Implemented from Interpreters -(= (empty) (let a b never-happens)) +(ALT= (empty) (let a b never-happens)) +;For testing +;(= (empty) Empty) -(= (empty-rust1) (let a b never-happens)) +;(= (empty-rust1) (let a b never-happens)) ; TODO: MINIMAL added for compatibility, remove after migration -(= (empty-minimal) Empty) +;(= (empty-minimal) Empty) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Documentation formatting functions @@ -1032,6 +1026,7 @@ (@param "Atomspace to add atom into") (@param "Atom to add"))) (@return "Unit atom")) +(: add-atom (-> hyperon::space::DynSpace Atom (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1039,6 +1034,7 @@ (@desc "Creates new Atomspace which could be used further in the program as a separate from &self Atomspace") (@params ()) (@return "Reference to a new space")) +(: new-space (-> hyperon::space::DynSpace Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1048,6 +1044,7 @@ (@param "Reference to the space from which the Atom needs to be removed") (@param "Atom to be removed"))) (@return "Unit atom")) +(: remove-atom (-> hyperon::space::DynSpace Atom (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1056,6 +1053,7 @@ (@params ( (@param "Reference to the space"))) (@return "List of all atoms in the input space")) +(get-atoms (-> hyperon::space::DynSpace Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1064,6 +1062,7 @@ (@params ( (@param "Atom to be wrapped"))) (@return "Returns (State $value) where $value is an argument to a new-state")) +(: new-state (-> $tnso (StateMonad $tnso))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1073,6 +1072,7 @@ (@param "State created by new-state function") (@param "Atom which will replace wrapped atom in the input state"))) (@return "State with replaced wrapped atom")) +(: change-state! (-> (StateMonad $tcso) $tcso (StateMonad $tcso))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1081,6 +1081,7 @@ (@params ( (@param "State"))) (@return "Atom wrapped by state")) +(: get-state (-> (StateMonad $tgso) $tgso)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1089,6 +1090,8 @@ (@params ( (@param "Atom to get type for"))) (@return "Type notation or %Undefined% if there is no type for input Atom")) +(: get-type (-> Atom Atom)) +(: get-type (-> Atom Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1099,6 +1102,7 @@ (@param "Atom to get type for"))) (@return "Type notation or %Undefined% if there is no type for input Atom in provided atomspace")) ;; Implemented from Interpreters? +(: get-type-space (-> Atom Atom Atom)) (= (get-type-space $space $atom) (get-type $atom $space)) @@ -1108,8 +1112,21 @@ (@params ( (@param "Atom to get metatype for"))) (@return "Metatype of input atom")) +(: get-metatype (-> Atom Atom)) ;; Implemented from Interpreters +;; Public MeTTa +(@doc unify + (@desc "Like Match but allows any sort of container for the first argument. (Match only allows MeTTa spaces.)") + (@params ( + (@param "The collection or space to match") + (@param "Second atom to unify with") + (@param "Result if two atoms unified successfully") + (@param "Result otherwise"))) + (@return "Third argument when found or forth one otherwise")) +(: unify (-> Atom Atom Atom Atom Atom)) +;; Implemented from Interpreters + ;; Public MeTTa (@doc match (@desc "Searches for all declared atoms corresponding to the given pattern (second argument) and produces the output pattern (third argument)") @@ -1120,7 +1137,7 @@ (@return "If match was successfull it outputs pattern (third argument) with filled variables (if any were present in pattern) using matched pattern (second argument). Nothing - otherwise")) (: match (-> Atom Atom Atom %Undefined%)) ;; Implemented from Interpreters -;(= (match $space $pattern $template) +;(ALT= (match $space $pattern $template) ; (unify $space $pattern $template Empty)) ;; Public MeTTa @@ -1129,6 +1146,7 @@ (@params ( (@param "File system path"))) (@return "Unit atom")) +(: register-module! (-> Atom (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1137,16 +1155,19 @@ (@params ( (@param "Module name"))) (@return "Space name")) +(: mod-space! (-> Atom hyperon::space::DynSpace)) ;; Implement from Interpreter! (= (mod-space! top) &self) (= (mod-space! corelib) &corelib) (= (mod-space! stdlib) &stdlib) + ;; Public MeTTa (@doc print-mods! (@desc "Prints all modules with their correspondent spaces") (@params ()) (@return "Unit atom")) +(: print-mods! (-> (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1156,6 +1177,7 @@ (@param "First expression") (@param "Second expression"))) (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) +(: assertEqual (-> Atom Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1165,6 +1187,7 @@ (@param "First expression (it will be evaluated)") (@param "Second expression (it won't be evaluated)"))) (@return "Unit atom if both expression after evaluation is equal, error - otherwise")) +(: assertEqualToResult (-> Atom Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1173,6 +1196,7 @@ (@params ( (@param "Atom which will be evaluated"))) (@return "Tuple")) +(: collapse (-> Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1181,6 +1205,7 @@ (@params ( (@param "Function name which space need to be captured"))) (@return "Function")) +(: capture (-> Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1190,6 +1215,7 @@ (@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 Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1198,6 +1224,7 @@ (@params ( (@param "Tuple to be converted"))) (@return "Argument converted to nondeterministic result")) +(: superpose (-> Expression %Undefined%)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1207,6 +1234,7 @@ (@param "Key's name") (@param "New value"))) (@return "Unit atom")) +(: pragma! (-> Symbol %Undefined% (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1217,6 +1245,7 @@ (@param "Module name"))) (@return "Unit atom")) ;; Implemented from Interpreters +(: import! (-> Atom Atom (->))) ;; Public MeTTa (@doc include @@ -1224,6 +1253,7 @@ (@params ( (@param "Name of metta script to import"))) (@return "Unit atom")) +(: include (-> Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1233,6 +1263,7 @@ (@param "Token name") (@param "Atom, which is associated with the token after reduction"))) (@return "Unit atom")) +(: bind! (-> Symbol %Undefined% (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1242,6 +1273,7 @@ (@param "Atom to print") (@param "Atom to return"))) (@return "Evaluated second input")) +(: trace! (-> %Undefined% $a $a)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1250,6 +1282,7 @@ (@params ( (@param "Expression/atom to be printed out"))) (@return "Unit atom")) +(: println! (-> %Undefined% (->))) ;; Implemented from Interpreters ;; Public MeTTa @@ -1259,6 +1292,7 @@ (@param "Expression with {} symbols to be replaced") (@param "Atoms to be placed inside expression instead of {}"))) (@return "Expression with replaced {} with atoms")) +(: format-args (-> String Expresson String)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1268,6 +1302,7 @@ (@param "Variable list e.g. ($x $y)") (@param "Atom which uses those variables"))) (@return "Second argument but with variables being replaced with unique variables")) +(: sealed (-> Expression Atom Atom)) ;; Implemented from Interpreters @@ -1287,6 +1322,7 @@ (@param "Addend") (@param "Augend"))) (@return "Sum")) +(: + (-> Number Number Number)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1296,6 +1332,7 @@ (@param "Minuend") (@param "Deductible"))) (@return "Difference")) +(: - (-> Number Number Number)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1305,6 +1342,7 @@ (@param "Multiplier") (@param "Multiplicand"))) (@return "Product")) +(: * (-> Number Number Number)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1314,6 +1352,7 @@ (@param "Dividend") (@param "Divisor"))) (@return "Fraction")) +(: / (-> Number Number Number)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1323,6 +1362,7 @@ (@param "Dividend") (@param "Divisor"))) (@return "Remainder")) +(: % (-> Number Number Number)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1332,6 +1372,7 @@ (@param "First number") (@param "Second number"))) (@return "True if first argument is less than second, False - otherwise")) +(: < (-> Number Number Bool)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1341,6 +1382,7 @@ (@param "First number") (@param "Second number"))) (@return "True if first argument is greater than second, False - otherwise")) +(: > (-> Number Number Bool)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1350,6 +1392,7 @@ (@param "First number") (@param "Second number"))) (@return "True if first argument is less than or equal to second, False - otherwise")) +(: <= (-> Number Number Bool)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1359,6 +1402,7 @@ (@param "First number") (@param "Second number"))) (@return "True if first argument is greater than or equal to second, False - otherwise")) +(: >= (-> Number Number Bool)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1368,6 +1412,7 @@ (@param "First argument") (@param "Second argument"))) (@return "Returns True if two arguments are equal, False - otherwise. If arguments are of different type function returns Error currently")) +(: == (-> $t $t Bool)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1376,6 +1421,7 @@ (@params ( (@param "Non-deterministic set of values"))) (@return "Unique values from input set")) +(: unique (-> Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1385,6 +1431,7 @@ (@param "Non-deterministic set of values") (@param "Another non-deterministic set of values"))) (@return "Union of sets")) +(: union (-> Atom Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1394,6 +1441,7 @@ (@param "Non-deterministic set of values") (@param "Another non-deterministic set of values"))) (@return "Intersection of sets")) +(: intersection (-> Atom Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1403,6 +1451,7 @@ (@param "Non-deterministic set of values") (@param "Another non-deterministic set of values"))) (@return "Subtraction of sets")) +(: subtraction (-> Atom Atom Atom)) ;; Implemented from Interpreters ;; Public MeTTa @@ -1411,4 +1460,6 @@ (@params ( (@param "URL to github repo"))) (@return "Unit atom")) -;; Implemented from Interpreters +(: git-module! (-> Atom (->))) +;; Implemented from Interpreters +