80312da · rowtype-yoga/purescript-native

src/Language/PureScript/Sugar/BindingGroups.hs+3−3

compare with golang

unifiedsplit

@@ -52,14 +52,14 @@ collapseBindingGroupsModule = map $ \(Module name ds exps) -> Module name (colla

52--

53createBindingGroups :: ModuleName -> [Declaration] -> Either ErrorStack [Declaration]

54createBindingGroups moduleName ds = do

55− values <- mapM (createBindingGroupsForValue moduleName) $ filter isValueDecl ds

55+ values <- parU (filter isValueDecl ds) (createBindingGroupsForValue moduleName)

56 let dataDecls = filter isDataDecl ds

57 allProperNames = map getProperName dataDecls

58 dataVerts = map (\d -> (d, getProperName d, usedProperNames moduleName d `intersect` allProperNames)) dataDecls

59− dataBindingGroupDecls <- mapM toDataBindingGroup $ stronglyConnComp dataVerts

59+ dataBindingGroupDecls <- parU (stronglyConnComp dataVerts) toDataBindingGroup

60 let allIdents = map getIdent values

61 valueVerts = map (\d -> (d, getIdent d, usedIdents moduleName d `intersect` allIdents)) values

62− bindingGroupDecls <- mapM (toBindingGroup moduleName) $ stronglyConnComp valueVerts

62+ bindingGroupDecls <- parU (stronglyConnComp valueVerts) (toBindingGroup moduleName)

63 return $ filter isImportDecl ds ++

64 filter isExternDataDecl ds ++

65 filter isExternInstanceDecl ds ++

src/Language/PureScript/Sugar/CaseDeclarations.hs+2−2

@@ -43,7 +43,7 @@ desugarCasesModule ms = forM ms $ \(Module name ds exps) ->

43 Module name <$> (desugarCases <=< desugarAbs $ ds) <*> pure exps

44

45desugarAbs :: [Declaration] -> SupplyT (Either ErrorStack) [Declaration]

46−desugarAbs = mapM f

46+desugarAbs = flip parU f

47 where

48 (f, _, _) = everywhereOnValuesM return replace return

49

@@ -57,7 +57,7 @@ desugarAbs = mapM f

57-- Replace all top-level binders with case expressions.

58--

59desugarCases :: [Declaration] -> SupplyT (Either ErrorStack) [Declaration]

60−desugarCases = desugarRest <=< fmap join . mapM toDecls . groupBy inSameGroup

60+desugarCases = desugarRest <=< fmap join . flip parU toDecls . groupBy inSameGroup

61 where

62 desugarRest :: [Declaration] -> SupplyT (Either ErrorStack) [Declaration]

63 desugarRest (TypeInstanceDeclaration name constraints className tys ds : rest) =

src/Language/PureScript/Sugar/DoNotation.hs+1−1

@@ -33,7 +33,7 @@ import Control.Monad.Trans.Class

33-- and all @DoNotationLet@ constructors with let expressions.

34--

35desugarDoModule :: Module -> SupplyT (Either ErrorStack) Module

36−desugarDoModule (Module mn ds exts) = Module mn <$> mapM desugarDo ds <*> pure exts

36+desugarDoModule (Module mn ds exts) = Module mn <$> parU ds desugarDo <*> pure exts

37

38desugarDo :: Declaration -> SupplyT (Either ErrorStack) Declaration

39desugarDo (PositionedDeclaration pos d) = (PositionedDeclaration pos) <$> (rethrowWithPosition pos $ desugarDo d)

src/Language/PureScript/Sugar/Operators.hs+1−1

@@ -66,7 +66,7 @@ removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts

66rebracketModule :: [[(Qualified Ident, Expr -> Expr -> Expr, Associativity)]] -> Module -> Either ErrorStack Module

67rebracketModule opTable (Module mn ds exts) =

68 let (f, _, _) = everywhereOnValuesTopDownM return (matchOperators opTable) return

69− in Module mn <$> (map removeParens <$> mapM f ds) <*> pure exts

69+ in Module mn <$> (map removeParens <$> parU ds f) <*> pure exts

70

71removeParens :: Declaration -> Declaration

72removeParens =

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -53,7 +53,7 @@ desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

53

54desugarModule :: Module -> Desugar Module

55desugarModule (Module name decls (Just exps)) = do

56− (newExpss, declss) <- unzip <$> mapM (desugarDecl name exps) decls

56+ (newExpss, declss) <- unzip <$> parU decls (desugarDecl name exps)

57 return $ Module name (concat declss) $ Just (exps ++ catMaybes newExpss)

58desugarModule _ = error "Exports should have been elaborated in name desugaring"

59