Merge pull request #5526 from unisonweb/cp/fix-set-echo

Fix old bool wrapper on setEcho builtin
unisonweb · Jan 8, 2025 · cda1ecd · cda1ecd
2 parents b7b3439 + e5242d2
commit cda1ecd
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 8 deletions.
diff --git a/unison-runtime/src/Unison/Runtime/Builtin.hs b/unison-runtime/src/Unison/Runtime/Builtin.hs
@@ -1015,11 +1015,10 @@ set'echo :: ForeignOp
 set'echo instr =
   ([BX, BX],)
     . TAbss [arg1, arg2]
-    . unenum 2 arg2 Ty.booleanRef bol
-    . TLetD result UN (TFOp instr [arg1, bol])
+    . TLetD result UN (TFOp instr [arg1, arg2])
     $ outIoFailUnit stack1 stack2 stack3 unit fail result
   where
-    (arg1, arg2, bol, stack1, stack2, stack3, unit, fail, result) = fresh
+    (arg1, arg2, stack1, stack2, stack3, unit, fail, result) = fresh
 
 -- a -> IOMode -> ...
 inIomr :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> ForeignFunc -> ([Mem], ANormal v)

diff --git a/unison-runtime/src/Unison/Runtime/Stack.hs b/unison-runtime/src/Unison/Runtime/Stack.hs
@@ -1181,7 +1181,7 @@ peekOffBool stk i = do
   b <- bpeekOff stk i
   pure $ case b of
     Enum _ t -> t /= TT.falseTag
-    _ -> error "peekBool: not a boolean"
+    _ -> error "peekOffBool: not a boolean"
 {-# INLINE peekOffBool #-}
 
 peekOffS :: Stack -> Int -> IO USeq

diff --git a/unison-src/transcripts/idempotent/io.md b/unison-src/transcripts/idempotent/io.md
@@ -319,6 +319,14 @@ testSeek _ =
 
   runTest test
 
+testSetEcho : '{io2.IO} [Result]
+testSetEcho = do
+    a = setEcho.impl (stdHandle StdErr) true
+    b = setEcho.impl (stdHandle StdErr) false
+    match (a, b) with
+      (Right _, Right _) -> [ Ok "setEcho works" ]
+      _ -> [ Fail "setEcho failure" ]
+
 testAppend : '{io2.IO} [Result]
 testAppend _ =
   test = 'let
@@ -352,17 +360,19 @@ testAppend _ =
 
     ⍟ These new definitions are ok to `add`:
     
-      testAppend : '{IO} [Result]
-      testSeek   : '{IO} [Result]
+      testAppend  : '{IO} [Result]
+      testSeek    : '{IO} [Result]
+      testSetEcho : '{IO} [Result]
 ```
 
 ``` ucm
 scratch/main> add
 
   ⍟ I've added these definitions:
 
-    testAppend : '{IO} [Result]
-    testSeek   : '{IO} [Result]
+    testAppend  : '{IO} [Result]
+    testSeek    : '{IO} [Result]
+    testSetEcho : '{IO} [Result]
 
 scratch/main> io.test testSeek
 
@@ -380,6 +390,16 @@ scratch/main> io.test testSeek
 
   Tip: Use view 1 to view the source of a test.
 
+scratch/main> io.test testSetEcho
+
+    New test results:
+
+    1. testSetEcho   ◉ setEcho works
+
+  ✅ 1 test(s) passing
+
+  Tip: Use view 1 to view the source of a test.
+
 scratch/main> io.test testAppend
 
     New test results: