mirror of
https://github.com/swarm-game/swarm.git
synced 2024-09-11 14:46:33 +03:00
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).
This commit is contained in:
parent
b1366b7c2a
commit
f6a1931b23
@ -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
|
||||
|
@ -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) $
|
||||
|
11
test/Unit.hs
11
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
|
||||
|
Loading…
Reference in New Issue
Block a user