git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
More work on removing syb
commit556b9459b43fb33d340aa760278a8e7dac69cab2 authorPhil Freeman <paf31@cantab.net> dateTue 15 Apr 2014, 18:22 (13 years ago) parent5c51fb8
4 files changed+14−11
compare with golang
unifiedsplit
src/Language/PureScript/CodeGen/JS.hs+3−2 src/Language/PureScript/Sugar.hs+1−1 src/Language/PureScript/Sugar/DoNotation.hs+5−3 src/Language/PureScript/Sugar/Operators.hs+5−5
src/Language/PureScript/CodeGen/JS.hs+3−2
@@ -26,7 +26,6 @@ module Language.PureScript.CodeGen.JS (
2626import Data.Maybe (fromJust, fromMaybe, mapMaybe)
2727import Data.Function (on)
2828import Data.List (nub, (\\))
29−import Data.Generics (mkQ, everything)
3029
3130import Control.Arrow (second)
3231import Control.Monad (replicateM, forM)
@@ -78,7 +77,9 @@ importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleB
7877 Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))
7978
8079imports :: Declaration -> [ModuleName]
81−imports = everything (++) (mkQ [] collect)
80+imports =
81+ let (f, _, _, _, _) = everythingOnValues (++) (const []) collect (const []) (const []) (const [])
82+ in f
8283 where
8384 collect :: Value -> [ModuleName]
8485 collect (Var (Qualified (Just mn) _)) = [mn]
src/Language/PureScript/Sugar.hs+1−1
@@ -49,7 +49,7 @@ import Control.Category ((>>>))
4949--
5050desugar :: [Module] -> Either ErrorStack [Module]
5151desugar = map removeSignedLiterals
52− >>> desugarDo
52+ >>> mapM desugarDoModule
5353 >=> desugarCasesModule
5454 >=> desugarTypeDeclarationsModule
5555 >=> desugarImports
src/Language/PureScript/Sugar/DoNotation.hs+5−3
@@ -15,10 +15,9 @@
1515-----------------------------------------------------------------------------
1616
1717module Language.PureScript.Sugar.DoNotation (
18− desugarDo
18+ desugarDoModule
1919) where
2020
21−import Data.Data
2221import Data.Generics
2322
2423import Language.PureScript.Names
@@ -34,7 +33,10 @@ import Control.Applicative
3433-- Replace all @DoNotationBind@ and @DoNotationValue@ constructors with applications of the Prelude.(>>=) function,
3534-- and all @DoNotationLet@ constructors with let expressions.
3635--
37−desugarDo :: (Data d) => d -> Either ErrorStack d
36+desugarDoModule :: Module -> Either ErrorStack Module
37+desugarDoModule (Module mn ds exts) = Module mn <$> mapM desugarDo ds <*> pure exts
38+
39+desugarDo :: Declaration -> Either ErrorStack Declaration
3840desugarDo = everywhereM (mkM replace)
3941 where
4042 prelude :: ModuleName
src/Language/PureScript/Sugar/Operators.hs+5−5
@@ -37,7 +37,6 @@ import Data.Function (on)
3737import Data.Functor.Identity
3838import Data.List (groupBy, sortBy)
3939
40−import qualified Data.Data as D
4140import qualified Data.Generics as G
4241import qualified Data.Generics.Extras as G
4342
@@ -57,7 +56,6 @@ rebracket ms = do
5756 let opTable = customOperatorTable $ map (\(i, _, f) -> (i, f)) fixities
5857 mapM (rebracketModule opTable) ms
5958
60−
6159removeSignedLiterals :: Module -> Module
6260removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts
6361 where
@@ -69,10 +67,12 @@ removeSignedLiterals (Module mn ds exts) = Module mn (map f' ds) exts
6967 go other = other
7068
7169rebracketModule :: [[(Qualified Ident, Value -> Value -> Value, Associativity)]] -> Module -> Either ErrorStack Module
72−rebracketModule opTable (Module mn ds exts) = Module mn <$> (removeParens <$> G.everywhereM' (G.mkM (matchOperators opTable)) ds) <*> pure exts
70+rebracketModule opTable (Module mn ds exts) = Module mn <$> (map removeParens <$> G.everywhereM' (G.mkM (matchOperators opTable)) ds) <*> pure exts
7371
74−removeParens :: (D.Data d) => d -> d
75−removeParens = G.everywhere (G.mkT go)
72+removeParens :: Declaration -> Declaration
73+removeParens =
74+ let (f, _, _) = everywhereOnValues id go id
75+ in f
7676 where
7777 go (Parens val) = val
7878 go val = val