Merge pull request #6859 from urbit/jb/safe-wtcl

hoon: correct ?: miscompilation, loobean jet mismatches

pkg/arvo/sys/hoon.hoon

@@ -7224,11 +7224,10 @@
   ~/  %cond
   |=  [pex=nock yom=nock woq=nock]
   ^-  nock
-  ?-  pex
-    [%1 %0]  yom
-    [%1 %1]  woq
-    *        [%6 pex yom woq]
-  ==
+  ?:  =([%1 &] pex)  yom
+  ?:  =([%1 |] pex)  woq
+  ?:  =([%0 0] pex)  pex
+  [%6 pex yom woq]
 ::
 ++  cons                                                ::  make formula cell
   ~/  %cons
@@ -7273,43 +7272,44 @@
   ~/  %flan
   |=  [bos=nock nif=nock]
   ^-  nock
-  ?:  =(bos nif)  bos
-  ?:  =([%0 0] bos)  nif
-  ?:  =([%0 0] nif)  bos
-  ?-    bos
-      [%1 %1]   bos
-      [%1 %0]   nif
-      *
-    ?-    nif
-        [%1 %1]   nif
-        [%1 %0]   bos
-        *       [%6 bos nif [%1 1]]
+  ?:  ?|  =(bos nif)
+          =([%1 |] bos)
+          =([%1 &] nif)
+          =([%0 0] bos)
       ==
+    bos
+  ?:  ?|  =([%1 &] bos)
+          =([%1 |] nif)
+          =([%0 0] nif)
       ==
+    nif
+  [%6 bos nif [%1 |]]
 ::
 ++  flip                                                ::  loobean negation
   ~/  %flip
   |=  dyr=nock
+  ^-  nock
+  ?:  =([%1 &] dyr)  [%1 |]
+  ?:  =([%1 |] dyr)  [%1 &]
   ?:  =([%0 0] dyr)  dyr
-  [%6 dyr [%1 1] [%1 0]]
+  [%6 dyr [%1 |] %1 &]
 ::
 ++  flor                                                ::  loobean  |
   ~/  %flor
   |=  [bos=nock nif=nock]
   ^-  nock
-  ?:  =(bos nif)  bos
-  ?:  =([%0 0] bos)  nif
-  ?:  =([%0 0] nif)  bos
-  ?-  bos
-      [%1 %1]   nif
-      [%1 %0]   bos
-      *
-    ?-  nif
-        [%1 %1]   bos
-        [%1 %0]   nif
-        *         [%6 bos [%1 0] nif]
+  ?:  ?|  =(bos nif)
+          =([%1 &] bos)
+          =([%1 |] nif)
+          =([%0 0] bos)
       ==
+    bos
+  ?:  ?|  =([%1 |] bos)
+          =([%1 &] nif)
+          =([%0 0] nif)
       ==
+    nif
+  [%6 bos [%1 &] nif]
 ::
 ++  hike
   ~/  %hike
@@ -9994,15 +9994,22 @@
     ::
         [%wtcl *]
       =+  nor=$(gen p.gen, gol bool)
-      =+  fex=(gain p.gen)
-      =+  wux=(lose p.gen)
-      =+  ^=  duy
-          ?:  =(%void fex)
-            ?:(=(%void wux) [%0 0] [%1 1])
-          ?:(=(%void wux) [%1 0] q.nor)
+      =+  [fex=(gain p.gen) wux=(lose p.gen)]
+      ::
+      ::  if either branch is impossible, eliminate it
+      ::  (placing the conditional in a dynamic hint to preserve crashes)
+      ::
+      =+  ^=  [ned duy]
+        ?-  -
+          [%void %void]  |+[%0 0]
+          [%void *]      &+[%1 |]
+          [* %void]      &+[%1 &]
+          *              |+q.nor
+        ==
       =+  hiq=$(sut fex, gen q.gen)
       =+  ran=$(sut wux, gen r.gen)
-      [(fork p.hiq p.ran ~) (cond duy q.hiq q.ran)]
+      =+  fol=(cond duy q.hiq q.ran)
+      [(fork p.hiq p.ran ~) ?.(ned fol [%11 [%toss q.nor] fol])]
     ::
         [%wthx *]
       :-  (nice bool)

tests/bug/wtcl-crash.hoon

@@ -0,0 +1,13 @@
+::  miscompilation: crashing conditional expression compiled out
+::
+/+  *test
+|%
+::
+++  test-wtcl-cond-crash
+  %-  expect-fail
+  |.  %.  %foo
+  |=  sam=$@(?(%foo %bar) [%baz @])
+  ^-  [%baz @]
+  ?>  ?=(%baz -.sam)
+  sam
+--