trueagi-io / metta-wam

A Hyperon MeTTa Interpreter/Transpilier that targets the Warren Abstract Machine
5 stars 8 forks source link

The weird bug breaking Nils' backchainer #5

Open TeamSPoon opened 4 months ago

TeamSPoon commented 4 months ago
TeamSPoon commented 4 months ago
(: go-level
    (-> (go_gene (ontology_term $o) (gene $g))
        (member (gene $g) (ontology_term $o) Z)))

(: go-level 
    (-> (go_parent (ontology_term $o) (ontology_term $x))
        (-> (member (gene $g) (ontology_term $x) $k)
            (member (gene $g) (ontology_term $o) (S $k)))))

(: go_gene-a-g (go_gene (ontology_term a) (gene g)))
(: go_gene-b-g (go_gene (ontology_term b) (gene g)))

(: go_parent-c-b (go_parent (ontology_term c) (ontology_term b)))
(: go_parent-d-c (go_parent (ontology_term d) (ontology_term c)))

(: Nat Type)
(: Z Nat)
(: S (-> Nat Nat))

;; Define <=
(: <= (-> $a $a Bool))
(= (<= $x $y) (or (< $x $y) (== $x $y)))

;; Define cast functions between Nat and Number
(: fromNumber (-> Number Nat))
(= (fromNumber $n) (if (<= $n 0) Z (S (fromNumber (- $n 1)))))
(: fromNat (-> Nat Number))
(= (fromNat Z) 0)
(= (fromNat (S $k)) (+ 1 (fromNat $k)))

;; Curried Backward Chainer
(: bc (-> $a Nat $a))
;; Base case
(= (bc (: $prf $ccln) $_)
     (let () (println! (bc-base (: $prf $ccln)))
          (match &kb (: $prf $ccln) 
               (let () (println! (bc-base-ground (: $prf $ccln))) (: $prf $ccln)))))

;; Recursive step
(= (bc (: ($prfabs $prfarg) $ccln) (S $k))
  (let () (println! (bc-rec (: ($prfabs $prfarg) $ccln) (S $k))) 
     (let* (((: $prfabs (-> $prms $ccln)) (bc (: $prfabs (-> $prms $ccln)) $k))
               ((: $prfarg $prms) (bc (: $prfarg $prms) $k)))
               (: ($prfabs $prfarg) $ccln))))

!(bc (: $prf (member $g $o $k)) (fromNumber 3))

Expected output