Skip to content

Commit a178e07

Browse files
paf31paf31
committed
Reinstate -Wall, fix warnings.
1 parent 973babe commit a178e07

File tree

16 files changed

+127
-176
lines changed

16 files changed

+127
-176
lines changed

‎purescript.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,7 @@ library
7474
buildable: True
7575
hs-source-dirs: src
7676
other-modules:
77+
ghc-options: -Wall -O2
7778

7879
executable psc
7980
build-depends: base >=4 && <5, cmdtheline -any, containers -any,

‎src/Data/Generics/Extras.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@
1818
module Data.Generics.Extras where
1919

2020
import Data.Data
21-
import Data.Maybe (fromMaybe)
2221

2322
-- |
2423
-- Apply a top-down monadic transformation everywhere

‎src/Language/PureScript.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ compile opts ms = do
6464
Module moduleName' <$> typeCheckAll mainModuleIdent moduleName' decls <*> pure exps
6565
regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
6666
let entryPoints = moduleNameFromString `map` optionsModules opts
67-
let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped
67+
let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped
6868
let js = mapMaybe (flip (moduleToJs opts) env) elim
6969
let exts = intercalate "\n" . map (`moduleToPs` env) $ elim
7070
js' <- case mainModuleIdent of

‎src/Language/PureScript/CodeGen/Externs.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ import Data.List (intercalate)
3030
-- TODO: only expose items listed in "exps"
3131
--
3232
moduleToPs :: Module -> Environment -> String
33-
moduleToPs (Module mn decls exps) env =
33+
moduleToPs (Module mn decls _) env =
3434
"module " ++ runModuleName mn ++ " where\n" ++
3535
(intercalate "\n" . map (" " ++) . concatMap (declToPs mn env) $ decls)
3636

‎src/Language/PureScript/CodeGen/JS.hs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,8 +24,6 @@ module Language.PureScript.CodeGen.JS (
2424

2525
import Data.Maybe (fromMaybe, mapMaybe)
2626
import Data.Function (on)
27-
import Data.Data (Data)
28-
import Data.Generics (mkQ, everything)
2927

3028
import Control.Arrow (second)
3129
import Control.Monad (replicateM, forM)
@@ -50,7 +48,7 @@ import Language.PureScript.Prim
5048
-- module.
5149
--
5250
moduleToJs :: Options -> Module -> Environment -> Maybe JS
53-
moduleToJs opts (Module name decls exps) env =
51+
moduleToJs opts (Module name decls _) env =
5452
case jsDecls of
5553
[] -> Nothing
5654
_ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar "_ps")) $
@@ -73,6 +71,7 @@ declToJs _ mp (DataDeclaration _ _ ctors) _ =
7371
Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
7472
export (Escaped ctor) $ JSVariableIntroduction ctor (Just (go pn 0 tys []))
7573
where
74+
go :: ProperName -> Integer -> [Type] -> [JS] -> JS
7675
go pn _ [] values =
7776
JSObjectLiteral [ ("ctor", JSStringLiteral (show (Qualified (Just mp) pn))), ("values", JSArrayLiteral $ reverse values) ]
7877
go pn index (_ : tys') values =

‎src/Language/PureScript/CodeGen/Optimize.hs‎

Lines changed: 37 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -46,8 +46,6 @@ import Language.PureScript.Names
4646
import Language.PureScript.CodeGen.JS.AST
4747
import Language.PureScript.Options
4848
import Language.PureScript.CodeGen.Common (identToJs)
49-
import Language.PureScript.Types
50-
import Language.PureScript.Prim
5149

5250
-- |
5351
-- Apply a series of optimizer passes to simplified Javascript code
@@ -311,9 +309,6 @@ magicDo' = everywhere (mkT undo) . everywhere' (mkT convert)
311309
-- Check if an expression represents a function in the Ef module
312310
isEffFunc name (JSAccessor name' (JSAccessor "Control_Monad_Eff" (JSVar "_ps"))) | name == name' = True
313311
isEffFunc _ _ = False
314-
-- Module names
315-
prelude = ModuleName [ProperName "Prelude"]
316-
effModule = ModuleName [ProperName "Control", ProperName "Monad", ProperName "Eff"]
317312
-- The name of the type class dictionary for the Monad Eff instance
318313
effDictName = "monadEff"
319314
-- Check if an expression represents the Monad Eff dictionary
@@ -402,62 +397,62 @@ inlineOperator op f = everywhere (mkT convert)
402397

403398
inlineCommonOperators :: JS -> JS
404399
inlineCommonOperators = applyAll
405-
[ binary "numNumber" "+" "Num" tyNumber Add
406-
, binary "numNumber" "-" "Num" tyNumber Subtract
407-
, binary "numNumber" "*" "Num" tyNumber Multiply
408-
, binary "numNumber" "/" "Num" tyNumber Divide
409-
, binary "numNumber" "%" "Num" tyNumber Modulus
410-
, unary "numNumber" "negate" "Num" tyNumber Negate
400+
[ binary "numNumber" "+" Add
401+
, binary "numNumber" "-" Subtract
402+
, binary "numNumber" "*" Multiply
403+
, binary "numNumber" "/" Divide
404+
, binary "numNumber" "%" Modulus
405+
, unary "numNumber" "negate" Negate
411406

412-
, binary "ordNumber" "<" "Ord" tyNumber LessThan
413-
, binary "ordNumber" ">" "Ord" tyNumber GreaterThan
414-
, binary "ordNumber" "<=" "Ord" tyNumber LessThanOrEqualTo
415-
, binary "ordNumber" ">=" "Ord" tyNumber GreaterThanOrEqualTo
407+
, binary "ordNumber" "<" LessThan
408+
, binary "ordNumber" ">" GreaterThan
409+
, binary "ordNumber" "<=" LessThanOrEqualTo
410+
, binary "ordNumber" ">=" GreaterThanOrEqualTo
416411

417-
, binary "eqNumber" "==" "Eq" tyNumber EqualTo
418-
, binary "eqNumber" "/=" "Eq" tyNumber NotEqualTo
419-
, binary "eqString" "==" "Eq" tyString EqualTo
420-
, binary "eqString" "/=" "Eq" tyString NotEqualTo
421-
, binary "eqBoolean" "==" "Eq" tyBoolean EqualTo
422-
, binary "eqBoolean" "/=" "Eq" tyBoolean NotEqualTo
412+
, binary "eqNumber" "==" EqualTo
413+
, binary "eqNumber" "/=" NotEqualTo
414+
, binary "eqString" "==" EqualTo
415+
, binary "eqString" "/=" NotEqualTo
416+
, binary "eqBoolean" "==" EqualTo
417+
, binary "eqBoolean" "/=" NotEqualTo
423418

424-
, binaryFunction "bitsNumber" "shl" "Bits" tyNumber ShiftLeft
425-
, binaryFunction "bitsNumber" "shr" "Bits" tyNumber ShiftRight
426-
, binaryFunction "bitsNumber" "zshr" "Bits" tyNumber ZeroFillShiftRight
427-
, binary "bitsNumber" "&" "Bits" tyNumber BitwiseAnd
428-
, binary "bitsNumber" "|" "Bits" tyNumber BitwiseOr
429-
, binary "bitsNumber" "^" "Bits" tyNumber BitwiseXor
430-
, unary "bitsNumber" "complement" "Bits" tyNumber BitwiseNot
419+
, binaryFunction "bitsNumber" "shl" ShiftLeft
420+
, binaryFunction "bitsNumber" "shr" ShiftRight
421+
, binaryFunction "bitsNumber" "zshr" ZeroFillShiftRight
422+
, binary "bitsNumber" "&" BitwiseAnd
423+
, binary "bitsNumber" "|" BitwiseOr
424+
, binary "bitsNumber" "^" BitwiseXor
425+
, unary "bitsNumber" "complement" BitwiseNot
431426

432-
, binary "boolLikeBoolean" "&&" "BoolLike" tyBoolean And
433-
, binary "boolLikeBoolean" "||" "BoolLike" tyBoolean Or
434-
, unary "boolLikeBoolean" "not" "BoolLike" tyBoolean Not
427+
, binary "boolLikeBoolean" "&&" And
428+
, binary "boolLikeBoolean" "||" Or
429+
, unary "boolLikeBoolean" "not" Not
435430
]
436431
where
437-
binary :: String -> String -> String -> Type -> BinaryOperator -> JS -> JS
438-
binary dictName opString className classTy op = everywhere (mkT convert)
432+
binary :: String -> String -> BinaryOperator -> JS -> JS
433+
binary dictName opString op = everywhere (mkT convert)
439434
where
440435
convert :: JS -> JS
441-
convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName className classTy dict = JSBinary op x y
436+
convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
442437
convert other = other
443438
isOp (JSAccessor longForm (JSAccessor "Prelude" (JSVar _))) | longForm == identToJs (Op opString) = True
444439
isOp (JSIndexer (JSStringLiteral op') (JSAccessor "Prelude" (JSVar "_ps"))) | opString == op' = True
445440
isOp _ = False
446-
binaryFunction :: String -> String -> String -> Type -> BinaryOperator -> JS -> JS
447-
binaryFunction dictName fnName className classTy op = everywhere (mkT convert)
441+
binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
442+
binaryFunction dictName fnName op = everywhere (mkT convert)
448443
where
449444
convert :: JS -> JS
450-
convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName className classTy dict = JSBinary op x y
445+
convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isOp fn && isOpDict dictName dict = JSBinary op x y
451446
convert other = other
452447
isOp (JSAccessor fnName' (JSAccessor "Prelude" (JSVar "_ps"))) | fnName == fnName' = True
453448
isOp _ = False
454-
unary :: String -> String -> String -> Type -> UnaryOperator -> JS -> JS
455-
unary dictName fnName className classTy op = everywhere (mkT convert)
449+
unary :: String -> String -> UnaryOperator -> JS -> JS
450+
unary dictName fnName op = everywhere (mkT convert)
456451
where
457452
convert :: JS -> JS
458-
convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName className classTy dict = JSUnary op x
453+
convert (JSApp (JSApp fn [dict]) [x]) | isOp fn && isOpDict dictName dict = JSUnary op x
459454
convert other = other
460455
isOp (JSAccessor fnName' (JSAccessor "Prelude" (JSVar "_ps"))) | fnName' == fnName = True
461456
isOp _ = False
462-
isOpDict dictName className ty (JSApp (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == dictName = True
463-
isOpDict _ _ _ _ = False
457+
isOpDict dictName (JSApp (JSAccessor prop (JSAccessor "Prelude" (JSVar "_ps"))) [JSObjectLiteral []]) | prop == dictName = True
458+
isOpDict _ _ = False

‎src/Language/PureScript/DeadCodeElimination.hs‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -25,22 +25,21 @@ import Data.Maybe (mapMaybe)
2525
import Language.PureScript.Names
2626
import Language.PureScript.Values
2727
import Language.PureScript.Declarations
28-
import Language.PureScript.TypeChecker.Monad
2928

3029
-- |
3130
-- Eliminate all declarations which are not a transitive dependency of the entry point module
3231
--
33-
eliminateDeadCode :: Environment -> [ModuleName] -> [Module] -> [Module]
34-
eliminateDeadCode env entryPoints ms =
35-
let declarations = concatMap (declarationsByModule env) ms
32+
eliminateDeadCode :: [ModuleName] -> [Module] -> [Module]
33+
eliminateDeadCode entryPoints ms =
34+
let declarations = concatMap declarationsByModule ms
3635
(graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
3736
entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
3837
in flip map ms $ \(Module moduleName ds exps) -> Module moduleName (filter (isUsed moduleName graph vertexFor entryPointVertices) ds) exps
3938

4039
type Key = (ModuleName, Either Ident ProperName)
4140

42-
declarationsByModule :: Environment -> Module -> [(Key, [Key])]
43-
declarationsByModule env (Module moduleName ds _) = concatMap go ds
41+
declarationsByModule :: Module -> [(Key, [Key])]
42+
declarationsByModule (Module moduleName ds _) = concatMap go ds
4443
where
4544
go :: Declaration -> [(Key, [Key])]
4645
go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies moduleName d)]

‎src/Language/PureScript/Sugar/DoNotation.hs‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,8 +34,6 @@ desugarDo = everywhereM (mkM replace)
3434
where
3535
prelude :: ModuleName
3636
prelude = ModuleName [ProperName "Prelude"]
37-
ret :: Value
38-
ret = Var (Qualified (Just prelude) (Ident "ret"))
3937
bind :: Value
4038
bind = Var (Qualified (Just prelude) (Op ">>="))
4139
replace :: Value -> Either String Value

0 commit comments

Comments
 (0)