Fix System F pretty printer

X->Y -> Z => X->Y->Z

src/Language/SystemF/Expression.hs

@@ -101,11 +101,16 @@ pprTyArrow :: PrettyPrint n
            -> Ty n
            -> Ty n
            -> PDoc String
-pprTyArrow pdoc space a@(TyVar _) b = pprTyArrow' pdoc space a b
-pprTyArrow pdoc space a@(TyArrow _ _) b = pprTyArrow' pdoc space a' b
-  where a' = betweenParens (pprTy empty space a) empty
-
-pprTyArrow' pdoc space a b = between arrow (prettyPrint a) (prettyPrint b) pdoc
+pprTyArrow pdoc space a@(TyVar _) b = pprTyArrow' space (pprTy pdoc space a) 
+                                                        (pprTy pdoc space b)
+pprTyArrow pdoc space (TyArrow a1 a2) b = pprTyArrow' space a' (pprTy pdoc space b)
+  where a' = betweenParens (pprTyArrow pdoc space a1 a2) empty
+
+pprTyArrow' :: Bool -- Add a space between arrows?
+            -> PDoc String
+            -> PDoc String
+            -> PDoc String
+pprTyArrow' space a b = a <> arrow <> b
   where arrow | space     = " -> " `add` empty
               | otherwise = "->" `add` empty
 

test/Language/SystemF/ExpressionSpec.hs

@@ -27,10 +27,13 @@ spec = describe "prettyPrint" $ do
     prettyPrint (Abs "f" (TyVar "F") (Abs "x" (TyVar "X") (Var "x")))
       `shouldBe` "λ f:F x:X. x"
 
-  it "prints abstractions with composite types" $ 
+  it "prints abstractions with composite types" $ do
     prettyPrint (Abs "f" (TyArrow (TyVar "X") (TyVar "Y")) (Var "f"))
       `shouldBe ` "λ f:(X->Y). f"
 
+    prettyPrint (Abs "f" (TyArrow (TyVar "X") (TyArrow (TyVar "Y") (TyVar "Z"))) (Var "f"))
+      `shouldBe ` "λ f:(X->Y->Z). f"
+
   it "prints nested type abstractions" $
     prettyPrint (TyAbs (TyVar "A") (TyAbs (TyVar "B") (Var "x")))
       `shouldBe` "Λ A B. x"