80312da · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Parallel errors for desugaring steps

commit80312daf53e310821752e67987e6940cf1f93a69 authorPhil Freeman <paf31@cantab.net> dateSat 1 Nov 2014, 15:46 (12 years ago) parent9eb1965

5 files changed+8−8

compare with golang

unifiedsplit

src/Language/PureScript/Sugar/BindingGroups.hs+3−3 src/Language/PureScript/Sugar/CaseDeclarations.hs+2−2 src/Language/PureScript/Sugar/DoNotation.hs+1−1 src/Language/PureScript/Sugar/Operators.hs+1−1 src/Language/PureScript/Sugar/TypeClasses.hs+1−1

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

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

5252--

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

5454createBindingGroups moduleName ds = do

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

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

5656 let dataDecls = filter isDataDecl ds

5757 allProperNames = map getProperName dataDecls

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

59− dataBindingGroupDecls <- mapM toDataBindingGroup $ stronglyConnComp dataVerts

59+ dataBindingGroupDecls <- parU (stronglyConnComp dataVerts) toDataBindingGroup

6060 let allIdents = map getIdent values

6161 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)

6363 return $ filter isImportDecl ds ++

6464 filter isExternDataDecl ds ++

6565 filter isExternInstanceDecl ds ++

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

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

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

4444

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

46−desugarAbs = mapM f

46+desugarAbs = flip parU f

4747 where

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

4949

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

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

5858--

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

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

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

6161 where

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

6363 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

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

3434--

3535desugarDoModule :: 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

3737

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

3939desugarDo (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

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

6767rebracketModule opTable (Module mn ds exts) =

6868 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

7070

7171removeParens :: Declaration -> Declaration

7272removeParens =

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

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

5353

5454desugarModule :: Module -> Desugar Module

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

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

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

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

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

5959