anoma/juvix
1
1
Fork 0
mirror of https://github.com/anoma/juvix.git synced 2024-12-11 08:25:46 +03:00
Code Issues Projects Releases Wiki Activity

run ormolu 4

Browse Source
This commit is contained in:
Jan Mas Rovira 2022-04-11 13:27:57 +02:00
parent 48aadbcf3b
commit bcc18dd204
6 changed files with 47 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lab/Termination/CallGraphOld.hs
View File

@ -119,7 +119,7 @@ reflexiveEdges (CompleteCallGraph es) = mapMaybe reflexive (toList es)
reflexive :: Edge -> Maybe ReflexiveEdge
reflexive e
| e ^. edgeFrom == e ^. edgeTo =
Just $ ReflexiveEdge (e ^. edgeFrom) (e ^. edgeMatrices)
Just $ ReflexiveEdge (e ^. edgeFrom) (e ^. edgeMatrices)
| otherwise = Nothing
callMatrixDiag :: CallMatrix -> [Rel]
@ -164,7 +164,7 @@ findOrder rb = LexOrder <$> listToMaybe (mapMaybe (isLexOrder >=> nonEmpty) allP
| Just r <- find (isLess . snd . (!! p0)) b,
all (notNothing . snd . (!! p0)) b,
Just perm' <- go (b' p0) (map pred ptail) ->
Just (fst (r !! p0) : perm')
Just (fst (r !! p0) : perm')
| otherwise -> Nothing
where
b' i = map r' (filter (not . isLess . snd . (!! i)) b)

4
src/MiniJuvix/Syntax/Abstract/Language/Extra.hs
View File

@ -37,8 +37,8 @@ viewExpressionAsPattern :: Expression -> Maybe Pattern
viewExpressionAsPattern e = case viewApp e of
(f, args)
| Just c <- getConstructor f -> do
args' <- mapM viewExpressionAsPattern args
Just $ PatternConstructorApp (ConstructorApp c args')
args' <- mapM viewExpressionAsPattern args
Just $ PatternConstructorApp (ConstructorApp c args')
(f, [])
| Just v <- getVariable f -> Just (PatternVariable v)
_ -> Nothing

4
src/MiniJuvix/Syntax/Concrete/Scoped/Name.hs
View File

@ -40,8 +40,8 @@ isChildOf :: AbsModulePath -> AbsModulePath -> Bool
isChildOf child parent
| null (absLocalPath child) = False
| otherwise =
init (absLocalPath child) == absLocalPath parent
&& absTopModulePath child == absTopModulePath parent
init (absLocalPath child) == absLocalPath parent
&& absTopModulePath child == absTopModulePath parent
-- | Appends a local path to the absolute path
-- e.g. TopMod.Local <.> Inner == TopMod.Local.Inner

64
src/MiniJuvix/Syntax/Concrete/Scoped/Scoper.hs
View File

@ -103,7 +103,7 @@ freshSymbol _nameKind _nameConcrete = do
fixity :: Sem r (Maybe Fixity)
fixity
| S.canHaveFixity _nameKind =
fmap opFixity . HashMap.lookup _nameConcrete <$> gets _scopeFixities
fmap opFixity . HashMap.lookup _nameConcrete <$> gets _scopeFixities
| otherwise = return Nothing
reserveSymbolOf ::
@ -1119,22 +1119,22 @@ makeExpressionTable2 (ExpressionAtoms atoms) = [appOp] : operators ++ [[function
mkOperator :: ScopedIden -> Maybe (Precedence, P.Operator Parse Expression)
mkOperator iden
| Just Fixity {..} <- _nameFixity = Just $
case fixityArity of
Unary u -> (fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
where
unaryApp :: ScopedIden -> Expression -> Expression
unaryApp funName arg = case u of
AssocPostfix -> ExpressionPostfixApplication (PostfixApplication arg funName)
Binary b -> (fixityPrecedence, infixLRN (binaryApp <$> parseSymbolId _nameId))
where
binaryApp :: ScopedIden -> Expression -> Expression -> Expression
binaryApp infixAppOperator infixAppLeft infixAppRight =
ExpressionInfixApplication InfixApplication {..}
infixLRN :: Parse (Expression -> Expression -> Expression) -> P.Operator Parse Expression
infixLRN = case b of
AssocLeft -> P.InfixL
AssocRight -> P.InfixR
AssocNone -> P.InfixN
case fixityArity of
Unary u -> (fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
where
unaryApp :: ScopedIden -> Expression -> Expression
unaryApp funName arg = case u of
AssocPostfix -> ExpressionPostfixApplication (PostfixApplication arg funName)
Binary b -> (fixityPrecedence, infixLRN (binaryApp <$> parseSymbolId _nameId))
where
binaryApp :: ScopedIden -> Expression -> Expression -> Expression
binaryApp infixAppOperator infixAppLeft infixAppRight =
ExpressionInfixApplication InfixApplication {..}
infixLRN :: Parse (Expression -> Expression -> Expression) -> P.Operator Parse Expression
infixLRN = case b of
AssocLeft -> P.InfixL
AssocRight -> P.InfixR
AssocNone -> P.InfixN
| otherwise = Nothing
where
S.Name' {..} = identifierName iden
@ -1312,21 +1312,21 @@ makePatternTable atom = [appOp] : operators
unqualifiedSymbolOp (ConstructorRef' S.Name' {..})
| Just Fixity {..} <- _nameFixity,
_nameKind == S.KNameConstructor = Just $
case fixityArity of
Unary u -> (fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
where
unaryApp :: ConstructorRef -> Pattern -> Pattern
unaryApp funName = case u of
AssocPostfix -> PatternPostfixApplication . (`PatternPostfixApp` funName)
Binary b -> (fixityPrecedence, infixLRN (binaryInfixApp <$> parseSymbolId _nameId))
where
binaryInfixApp :: ConstructorRef -> Pattern -> Pattern -> Pattern
binaryInfixApp name argLeft = PatternInfixApplication . PatternInfixApp argLeft name
infixLRN :: ParsePat (Pattern -> Pattern -> Pattern) -> P.Operator ParsePat Pattern
infixLRN = case b of
AssocLeft -> P.InfixL
AssocRight -> P.InfixR
AssocNone -> P.InfixN
case fixityArity of
Unary u -> (fixityPrecedence, P.Postfix (unaryApp <$> parseSymbolId _nameId))
where
unaryApp :: ConstructorRef -> Pattern -> Pattern
unaryApp funName = case u of
AssocPostfix -> PatternPostfixApplication . (`PatternPostfixApp` funName)
Binary b -> (fixityPrecedence, infixLRN (binaryInfixApp <$> parseSymbolId _nameId))
where
binaryInfixApp :: ConstructorRef -> Pattern -> Pattern -> Pattern
binaryInfixApp name argLeft = PatternInfixApplication . PatternInfixApp argLeft name
infixLRN :: ParsePat (Pattern -> Pattern -> Pattern) -> P.Operator ParsePat Pattern
infixLRN = case b of
AssocLeft -> P.InfixL
AssocRight -> P.InfixR
AssocNone -> P.InfixN
| otherwise = Nothing
parseSymbolId :: S.NameId -> ParsePat ConstructorRef
parseSymbolId uid = P.token getConstructorRefWithId mempty

12
src/MiniJuvix/Termination/CallGraph.hs
View File

@ -121,10 +121,10 @@ completeCallGraph cm = CompleteCallGraph (go startingEdges)
edgeUnion a b
| a ^. edgeFrom == b ^. edgeFrom,
a ^. edgeTo == b ^. edgeTo =
Edge
(a ^. edgeFrom)
(a ^. edgeTo)
(HashSet.union (a ^. edgeMatrices) (b ^. edgeMatrices))
Edge
(a ^. edgeFrom)
(a ^. edgeTo)
(HashSet.union (a ^. edgeMatrices) (b ^. edgeMatrices))
| otherwise = impossible
edgesUnion :: Edges -> Edges -> Edges
@ -139,7 +139,7 @@ reflexiveEdges (CompleteCallGraph es) = mapMaybe reflexive (toList es)
reflexive :: Edge -> Maybe ReflexiveEdge
reflexive e
| e ^. edgeFrom == e ^. edgeTo =
Just $ ReflexiveEdge (e ^. edgeFrom) (e ^. edgeMatrices)
Just $ ReflexiveEdge (e ^. edgeFrom) (e ^. edgeMatrices)
| otherwise = Nothing
callMatrixDiag :: CallMatrix -> [Rel]
@ -184,7 +184,7 @@ findOrder rb = LexOrder <$> listToMaybe (mapMaybe (isLexOrder >=> nonEmpty) allP
| Just r <- find (isLess . snd . (!! p0)) b,
all (notNothing . snd . (!! p0)) b,
Just perm' <- go (b' p0) (map pred ptail) ->
Just (fst (r !! p0) : perm')
Just (fst (r !! p0) : perm')
| otherwise -> Nothing
where
b' i = map r' (filter (not . isLess . snd . (!! i)) b)

6
test/Scope/Positive.hs
View File

@ -79,9 +79,9 @@ assertEqDiff :: (Eq a, Show a) => String -> a -> a -> Assertion
assertEqDiff msg a b
| a == b = return ()
| otherwise = do
putStrLn (pack $ ppDiff (getGroupedDiff pa pb))
putStrLn "End diff"
fail msg
putStrLn (pack $ ppDiff (getGroupedDiff pa pb))
putStrLn "End diff"
fail msg
where
pa = lines $ ppShow a
pb = lines $ ppShow b