Merge pull request #2372 from unisonweb/fix/delay

Fix `delay.impl` calling convention

parser-typechecker/src/Unison/Runtime/Builtin.hs

@@ -1090,10 +1090,10 @@ boxBoxTo0 instr
   (arg1, arg2) = fresh2
 
 -- Nat -> ()
-natToUnit :: ForeignOp
-natToUnit = inNat arg nat result (TCon Ty.unitRef 0 [])
-  where
-    (arg, nat, result) = fresh3
+-- natToUnit :: ForeignOp
+-- natToUnit = inNat arg nat result (TCon Ty.unitRef 0 [])
+--   where
+--     (arg, nat, result) = fresh3
 
 -- a -> Bool
 boxToBool :: ForeignOp
@@ -1233,12 +1233,29 @@ boxBoxToEFBox = inBxBx arg1 arg2 result
   where
     (arg1, arg2, result, stack1, stack2, fail) = fresh6
 
--- a -> Nat -> Either Failure
+-- a -> Nat -> Either Failure b
 boxNatToEFBox :: ForeignOp
 boxNatToEFBox = inBxNat arg1 arg2 nat result
            $ outIoFail stack1 stack2 fail result
   where (arg1, arg2, nat, stack1, stack2, fail, result) = fresh7
 
+-- Nat -> Either Failure ()
+natToEFUnit :: ForeignOp
+natToEFUnit
+  = inNat arg nat result
+  . TMatch result . MatchSum $ mapFromList
+  [ (0, ([BX, BX],)
+      . TAbss [stack1, stack2]
+      . TLetD fail BX (TCon Ty.failureRef 0 [stack1, stack2])
+      $ TCon eitherReference 0 [fail])
+  , (1, ([],)
+      . TLetD unit BX (TCon Ty.unitRef 0 [])
+      $ TCon eitherReference 1 [unit])
+
+  ]
+  where
+    (arg, nat, result, fail, stack1, stack2, unit) = fresh7
+
 -- a -> Either b c
 boxToEBoxBox :: ForeignOp
 boxToEBoxBox instr
@@ -1595,7 +1612,8 @@ declareForeigns = do
 
   declareForeign "IO.kill.impl.v3" boxTo0 $ mkForeignIOF killThread
 
-  declareForeign "IO.delay.impl.v3" natToUnit $ mkForeignIOF threadDelay
+  declareForeign "IO.delay.impl.v3" natToEFUnit
+    $ mkForeignIOF threadDelay
 
   declareForeign "IO.stdHandle" standard'handle
     . mkForeign $ \(n :: Int) -> case n of

unison-src/transcripts-using-base/base.u

@@ -136,6 +136,11 @@ stdout = IO.stdHandle StdOut
 printText : Text -> {io2.IO} Either Failure ()
 printText t = putBytes.impl stdout (toUtf8 t)
 
+printLine : Text -> {io2.IO, Exception} ()
+printLine t = reraise (printText (t ++ "\n"))
+
+delay : Nat ->{IO, Exception} ()
+delay n = reraise (delay.impl n)
 -- Run tests which might fail, might create temporary directores and Stream out
 -- results, returns the Results and the result of the test
 evalTest: '{Stream Result, TempDirs, io2.IO, Exception} a ->{io2.IO, Exception}([Result], a)

unison-src/transcripts-using-base/fix2358.md

@@ -0,0 +1,18 @@
+
+Tests a former error due to bad calling conventions on delay.impl
+
+```ucm:hide
+.> builtins.mergeio
+```
+
+```unison
+timingApp2 : '{IO, Exception} ()
+timingApp2 _ = 
+  printLine "Hello"
+  delay 10
+  printLine "World"
+```
+
+```ucm
+.> run timingApp2
+```

unison-src/transcripts-using-base/fix2358.output.md

@@ -0,0 +1,26 @@
+
+Tests a former error due to bad calling conventions on delay.impl
+
+```unison
+timingApp2 : '{IO, Exception} ()
+timingApp2 _ = 
+  printLine "Hello"
+  delay 10
+  printLine "World"
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      timingApp2 : '{IO, Exception} ()
+
+```
+```ucm
+.> run timingApp2
+
+```