infinite loops, somewhere

subject-knowledge/lib/subject-knowledge.hoon

@@ -1,7 +1,7 @@
 =<
 ::  a memoization for formula analysis, updated/inspected at eval
 ::  boundaries (2/9)
-=|  memo=(map [sock *] [(unit sock) (unit @tas)])
+=|  memo=(map * (list [sock (unit sock) (unit @tas)]))
 ::  A jet dashboard
 ::
 ::  The @tas tag is used only for debugging
@@ -9,22 +9,61 @@
 |%
 ::  Partial knowledge of a noun
 +$  sock  ^sock
+++  entr
+  |=  [s=sock f=* nam=(unit @tas)]
+  ^-  (each _memo [r=(unit sock) n=(unit @tas)])
+  =/  entry
+    =/  e  (~(get by memo) f)  ?~  e  ~  u.e
+  |-
+  ^-  (each _memo [(unit sock) (unit @tas)])
+  ?~  entry
+    :-  %&
+    ?:  (~(has by memo) f)
+      (~(jab by memo) f |=(e=(list [sock (unit sock) (unit @tas)]) [[s ~ nam] e]))
+    (~(put by memo) f ~[[s ~ nam]])
+  ?:  (mous -<.entry s)
+    [%| ->.entry]
+  $(entry +.entry)
+++  exit
+  |=  [s=sock f=* r=sock]
+  ^-  _memo
+  ~|  "Should not exit where there is no entry"
+  %:
+    ~(jab by memo)
+    f
+    |=  e=(list [sock (unit sock) (unit @tas)])
+    |-
+    ^-  (list [sock (unit sock) (unit @tas)])
+    ?<  ?=  %~  e
+    ?:  =(-<.e s)
+      [[s `r ->+.e] +.e]
+    [-.e $(e +.e)]
+  ==
 ++  bord  *(map * (list [sock [$-(* *) @tas]]))
 ::  test whether a sock nests in another sock
 ::  a=sock nests in b=sock if b has the same information as a, or
 ::  strictly more information
 ::
-::  mous ignores hints for matching
 ++  mous
   |=  [a=sock b=sock]
   ^-  ?
   ?:  ?=  [%gues ~]  a
     %.y
-  ?:  ?=  [%hint *]  a
-    $(a r.a)
-  ?:  ?=  [%hint *]  b
-    $(b r.b)
   ?-  a
+      ::
+      [%hint *]
+    ?&
+      ?=  [%hint *]  b
+      .=  s.a  s.b
+      ?~  d.a
+        ?~  d.b
+          %.y
+        %.n
+      ?~  d.b
+        %.n
+      $(u.d.a u.d.b)
+      $(r.a r.b)
+    ==
       ::
       [%know *]
     ?|
@@ -61,7 +100,8 @@
 ++  wash
   |=  [s=sock f=*]
   ^-  [sock _memo]
-  [r.- +]:(pull s f)
+  =+  (pull s f)
+  [(cort -<) ->]
 ::  Check for a jet
 ++  juke
   |=  [s=sock f=*]
@@ -157,11 +197,11 @@
   |-
   ^-  [sock (unit @tas)]
   ?:  =(b 1)
-    ?.  ?=  [%hint *]  s  [s ~]
+    ?.  ?=  [%hint *]  s  [s nam]
-    ?.  =(s.s %fast)  [s ~]
+    ?.  =(s.s %fast)  [s nam]
-    ?~  d.s  [s ~]
+    ?~  d.s  [s nam]
     =/  namsock  (yarn u.d.s 2)
-    ?.  ?=  [%know @]  namsock  [s ~]
+    ?.  ?=  [%know @]  namsock  [s nam]
     [s `k.namsock]
   ?:  ?=  [%hint *]  s
      ?.  =(s.s %fast)  $(s r.s)
@@ -327,6 +367,9 @@
       [%jet *]
     [%gues ~]
   ==
+++  pull
+  |=  [s=sock f=*]
+  (pull-eval s [%know f] ~)
 ++  pull-eval
   |=  [s=sock f=sock nam=(unit @tas)]
   ^-  [coot _memo]
@@ -339,25 +382,32 @@
     ::  found a jet
     ~&  "Jet: {<+.u.jet>}"
     [[%jet +.u.jet] memo]
-  =/  mem  (~(get by memo) [s k.f])
+  =/  mem=(each _memo [r=(unit sock) n=(unit @tas)])  (entr s k.f nam)
-  ?~  mem
+  ?-  mem
-    :: memo miss
+      ::
-    =.  memo  (~(put by memo) [s k.f] [~ nam]) :: blackhole for recursive eval
+      [%& *]
-    =^  res  memo  (pull s k.f)
+    ::  ~&  "Miss sock: {<s>}"
-    ~&  "Miss: sock {<s>} formula {<k.f>}"
+    ::  ~&  "Miss formula: {<k.f>}"
-    =.  memo  (~(jab by memo) [s k.f] |=([(unit sock) nm=(unit @tas)] [`r.res nm]))
+    ::  ~&  "Miss name: {<nam>}"
-    [[%mis res] memo] :: fill in result
+    =.  memo  +.mem
-  ?~  -.u.mem
+    =^  res  memo  (pull-inner s k.f)
+    =.  memo  (exit s k.f r.res)
+    [[%mis res] memo]
+      ::
+      [%| *]
+    ?~  r.p.mem
       :: memo blackhole
       ~&  "Recur: sock {<[s]>} formula {<k.f>}"
       [[%rec s k.f] memo]
     :: memo hit
-  ~&  "Hit: sock {<[s]>} formula {<k.f>} result {<u.u.mem>}"
+    ~&  "Hit: sock {<[s]>} formula {<k.f>} result {<u.r.p.mem>} named {<n.p.mem>}"
-  [[%hit u.-.u.mem] memo] 
+    [[%hit u.r.p.mem] memo] 
-++  pull
+  ==
+++  pull-inner
   |=  [s=sock f=*]
   ^-  [foot _memo]
-  ~|  "Formula {(scow %q (mug f))}"
+  ~&  "Formula {<f>}"
+  =/  r
     ?+  f  ~|  "Unrecognized nock {<f>}"  ~|  %pull-bonk  !!
         ::
         [[* *] *]
@@ -438,7 +488,7 @@
         [[[%6 bfoot `cfoot ~] s r.cfoot] memo]
           ::
           [%know %1]
-      =^  dfoot  memo  ^$(f d/f)
+        =^  dfoot  memo  ^$(f d.f)
         [[[%6 bfoot ~ `dfoot] s r.dfoot] memo]
           ::
           [%gues ~]
@@ -466,7 +516,7 @@
         [%10 [b=@ c=*] d=*]
       =^  cfoot  memo  $(f c.f)
       =^  dfoot  memo  $(f d.f)
-    [[[%10 [b.f cfoot] dfoot] s (knit r.dfoot b.f r.cfoot)] memo]
+      [[[%10 [b.f cfoot] dfoot] s (knit r.dfoot b.f [%gues ~])] memo]
         ::
         [%11 b=@ c=*]
       =^  cfoot  memo  $(f c.f)
@@ -493,6 +543,7 @@
       =^  pathfoot  memo  $(f path.f)
       [[[%12 reffoot pathfoot] s [%gues ~]] memo]
     ==
+  ~&  "Result {<r>}"  r
 ::  example nocks for testing
 ++  nocs
   |%