fix #528

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

@@ -563,9 +563,15 @@ run ioHandler env ir = do
     -- call _ _ fn@(Lam _ _ _) args | trace ("call "<> show fn <> " " <>show args) False = undefined
     call size m fn@(Lam arity underapply body) args = let nargs = length args in
       -- fully applied call, `(x y -> ..) 9 10`
-      if nargs == arity then do
-        (size, m) <- pushManyZ size args m
-        go size m body
+      if nargs == arity then case underapply of
+        -- when calling a closure, we supply all the closure arguments, before
+        -- `args`. See fix528.u for an example.
+        FormClosure _hash _tm pushedArgs -> do
+          (size, m) <- pushManyZ size (fmap Val (reverse pushedArgs) ++ args) m
+          go size m body
+        _ -> do
+          (size, m) <- pushManyZ size args m
+          go size m body
       -- overapplied call, e.g. `id id 42`
       else if nargs > arity then do
         let (usedArgs, extraArgs) = splitAt arity args
@@ -602,14 +608,9 @@ run ioHandler env ir = do
               body
             in done $ Lam (arity - nargs) (Specialize hash lam pushedArgs') compiled
           Specialize _ e pushedArgs -> error $ "can't underapply a non-lambda: " <> show e <> " " <> show pushedArgs
-          FormClosure hash tm pushedArgs -> let
-            pushedArgs' = reverse argvs ++ pushedArgs
-            arity' = arity - nargs
-            allArgs = replicate arity' Nothing ++ map Just pushedArgs'
-            bound = Map.fromList [ (i, v) | (Just v, i) <- allArgs `zip` [0..]]
-            in done $ Lam (arity - nargs)
-                       (FormClosure hash tm pushedArgs')
-                       (specializeIR bound body)
+          FormClosure hash tm pushedArgs ->
+            let pushedArgs' = reverse argvs ++ pushedArgs
+            in done $ Lam (arity - nargs) (FormClosure hash tm pushedArgs') body
     call size m (Cont k) [arg] = do
       v <- at size arg m
       callContinuation size m k v

unison-src/tests/fix528.u

@@ -0,0 +1,12 @@
+
+(|>) : a -> (a -> b) -> b
+a |> f = f a
+
+ex1 = "bob" |> (Text.++) "hi, "
+
+type Woot = Woot Text Int Nat
+
+ex2 = case 0 |> Woot "Zonk" +10 of
+  Woot.Woot _ i _ -> i
+
+> (ex1, ex2)

unison-src/tests/fix528.ur

@@ -0,0 +1 @@
+("hi, bob", +10)

unison-src/tests/fix528.uu

@@ -1,32 +0,0 @@
-use Trie tail head Trie
-
-type Trie k v = { head : Optional v, tail : [(k, Trie k v)] }
-
-Trie.empty = Trie None [] 
-
-Trie.toList : Trie k v -> [([k], v)]
-Trie.toList t =
-  go : [k] -> Trie k v -> [([k], v)]
-  go path t = 
-    [] ++ join (map (p -> go [] Trie.empty) (tail t))
-    -- this phrasing crashes - 
-    -- tail t |> List.map (p -> go [] Trie.empty)
-    --        |> List.join
-    --        |> (List.++) []
-  go [] t
-
-> toList Trie.empty
-
----
-
-bombs with:
-
-  💔💥
-
-  I stopped evaluation after encountering an error:
-
-    user error (type error, expecting List, got: (Lam 1 FormClosure 5MQKGmyVUfJMTmaGyk8TBmLJMoZbUKGDE4fgKBhAMzMkmwpweM7gsPPUivFuY4PeMM1Qrt7e2RnAs2sw4QJzsqjJ Ref(##List.++) [[]] (Leaf External:ExternalFunction)))
-
-  I'm sorry this message doesn't have more detail
-  about the location of the failure. My makers plan to
-  fix this in a future release. 😢