parse and pretty-print tuples properly

Tuples are now parsed as parens containing terms separated by commas,
instead of just treating the comma as a binary infix operator.  This
fixes #225 --- we now properly parse tuples containing lambdas.
Tuples bigger than pairs are treated as syntax sugar for right-nested
pairs, e.g. (1,2,3) is (1,(2,3)) (and also pretty-prints as the former).

src/Swarm/Language/Parse.hs

@@ -245,8 +245,8 @@ parseTermAtom =
         <|> sDef <$> (reserved "def" *> identifier)
           <*> optional (symbol ":" *> parsePolytype)
           <*> (symbol "=" *> parseTerm <* reserved "end")
+        <|> parens (mkTuple <$> (parseTerm `sepBy` symbol ","))
     )
-    <|> parens parseTerm
     -- Potential syntax for explicitly requesting memoized delay.
     -- Perhaps we will not need this in the end; see the discussion at
     -- https://github.com/byorgey/swarm/issues/150 .
@@ -257,6 +257,11 @@ parseTermAtom =
     <|> parseLoc (SDelay SimpleDelay <$> braces parseTerm)
     <|> parseLoc (ask >>= (guard . (== AllowAntiquoting)) >> parseAntiquotation)
 
+mkTuple :: [Syntax] -> Term
+mkTuple [] = TUnit
+mkTuple [STerm x] = x
+mkTuple (x : xs) = SPair x (STerm (mkTuple xs))
+
 -- | Construct an 'SLet', automatically filling in the Boolean field
 --   indicating whether it is recursive.
 sLet :: Var -> Maybe Polytype -> Syntax -> Syntax -> Term
@@ -327,7 +332,6 @@ parseExpr = fixDefMissingSemis <$> makeExprParser parseTermAtom table
       [ Map.singleton 9 [InfixL (exprLoc2 $ SApp <$ string "")]
       , binOps
       , unOps
-      , Map.singleton 2 [InfixR (exprLoc2 $ SPair <$ symbol ",")]
       ]
 
   -- add location for ExprParser by combining all

src/Swarm/Language/Pretty.hs

@@ -121,7 +121,7 @@ instance PrettyPrec Term where
   prettyPrec _ (TBool b) = bool "false" "true" b
   prettyPrec _ (TVar s) = pretty s
   prettyPrec _ (TDelay _ t) = braces $ ppr t
-  prettyPrec _ (TPair t1 t2) = pparens True $ ppr t1 <> "," <+> ppr t2
+  prettyPrec _ t@TPair {} = prettyTuple t
   prettyPrec _ (TLam x mty body) =
     "\\" <> pretty x <> maybe "" ((":" <>) . ppr) mty <> "." <+> ppr body
   -- Special handling of infix operators - ((+) 2) 3 --> 2 + 3
@@ -163,6 +163,12 @@ instance PrettyPrec Term where
     pparens (p > 0) $
       pretty x <+> "<-" <+> prettyPrec 1 t1 <> ";" <+> prettyPrec 0 t2
 
+prettyTuple :: Term -> Doc a
+prettyTuple = pparens True . hsep . punctuate "," . map ppr . unnestTuple
+ where
+  unnestTuple (TPair t1 t2) = t1 : unnestTuple t2
+  unnestTuple t = [t]
+
 prettyPrecApp :: Int -> Term -> Term -> Doc a
 prettyPrecApp p t1 t2 =
   pparens (p > 10) $

test/Unit.hs

@@ -91,6 +91,12 @@ parser =
                 ]
             )
         )
+    , testCase
+        "Parse pair syntax #225"
+        (valid "def f : (int -> bool) * (int -> bool) = (\\x. false, \\x. true) end")
+    , testCase
+        "Nested pair syntax"
+        (valid "(1,2,3,4)")
     , testGroup
         "failure location - #268"
         [ testCase
@@ -202,6 +208,11 @@ prettyConst =
         ( equalPretty "(2 ^ 4) ^ 8" $
             mkOp' Exp (mkOp' Exp (TInt 2) (TInt 4)) (TInt 8)
         )
+    , testCase
+        "pairs #225 - nested pairs are printed right-associative"
+        ( equalPretty "(1, 2, 3)" $
+            (TPair (TInt 1) (TPair (TInt 2) (TInt 3)))
+        )
     ]
  where
   equalPretty :: String -> Term -> Assertion