git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
hlint
commit1b77d7e83bac4c83e57358cf6b5d8f2f9cbe7f6f authorPhil Freeman <paf31@cantab.net> dateFri 1 Nov 2013, 11:15 (13 years ago) parent6c11112
19 files changed+211−198
compare with golang
unifiedsplit
PureScript.cabal+18−17 src/Main.hs+3−2 src/PureScript.hs+11−18 src/PureScript/CodeGen/Common.hs+4−4 src/PureScript/CodeGen/Common/Gen.hs+1−1 src/PureScript/CodeGen/Externs.hs+1−1 src/PureScript/CodeGen/JS.hs+30−29 src/PureScript/CodeGen/Pretty/Kinds.hs+2−2 src/PureScript/CodeGen/Pretty/Types.hs+6−6 src/PureScript/CodeGen/Pretty/Values.hs+30−30 src/PureScript/Parser.hs+7−11 src/PureScript/Parser/Common.hs+1−1 src/PureScript/Parser/Types.hs+1−1 src/PureScript/Parser/Values.hs+14−11 src/PureScript/Pretty.hs+22 src/PureScript/TypeChecker.hs+11−14 src/PureScript/TypeChecker/Kinds.hs+10−11 src/PureScript/TypeChecker/Monad.hs+3−3 src/PureScript/TypeChecker/Types.hs+36−36
PureScript.cabal+18−17
@@ -1,5 +1,5 @@
11name: purescript
2−version: 0.0.1
2+version: 0.1.0
33cabal-version: >=1.8
44build-type: Simple
55license: MIT
@@ -11,9 +11,9 @@ synopsis: PureScript Programming Language Compiler
1111description: A small compile-to-JS language with extensible records and type-safe blocks
1212author: Phil Freeman <paf31@cantab.net>
1313data-dir: ""
14−
14+
1515library
16− build-depends: base -any, syb -any, cmdtheline -any,
16+ build-depends: base >=4 && <5, syb -any, cmdtheline -any,
1717 containers -any, mtl -any, transformers -any, parsec -any,
1818 utf8-string -any
1919 exposed-modules: PureScript.CodeGen.Pretty.Values
@@ -31,21 +31,22 @@ library
3131 exposed: True
3232 buildable: True
3333 hs-source-dirs: src
34− other-modules:
35−
36−Test-Suite tests
37− type: exitcode-stdio-1.0
38− main-is: Main.hs
39− hs-source-dirs: tests
40− build-depends: base -any, syb -any, directory -any, filepath -any,
41− containers -any, mtl -any, transformers -any, parsec -any,
42− utf8-string -any, purescript -any
43−
34+ other-modules: PureScript.Pretty
35+
4436executable psc
45− build-depends: base -any, cmdtheline -any, containers -any,
46− mtl -any, transformers -any, parsec -any, utf8-string -any, syb -any
37+ build-depends: base >=4 && <5, cmdtheline -any, containers -any,
38+ mtl -any, transformers -any, parsec -any, utf8-string -any,
39+ syb -any
4740 main-is: Main.hs
4841 buildable: True
4942 hs-source-dirs: src
50− other-modules:
51−
43+ other-modules: PureScript.Pretty
44+
45+test-suite tests
46+ build-depends: base >=4 && <5, syb -any, directory -any,
47+ filepath -any, containers -any, mtl -any, transformers -any,
48+ parsec -any, utf8-string -any, purescript -any
49+ type: exitcode-stdio-1.0
50+ main-is: Main.hs
51+ buildable: True
52+ hs-source-dirs: tests
src/Main.hs+3−2
@@ -19,6 +19,7 @@ import Data.Maybe (mapMaybe)
1919import Data.List (intercalate)
2020import System.Console.CmdTheLine
2121import Control.Applicative
22+import Control.Monad (forM)
2223import System.Exit (exitSuccess, exitFailure)
2324import qualified Text.Parsec as P
2425import qualified System.IO.UTF8 as U
@@ -26,14 +27,14 @@ import qualified Data.Map as M
2627
2728compile :: [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
2829compile inputFiles outputFile externsFile = do
29− asts <- fmap (fmap concat . sequence) $ flip mapM inputFiles $ \inputFile -> do
30+ asts <- fmap (fmap concat . sequence) $ forM inputFiles $ \inputFile -> do
3031 text <- U.readFile inputFile
3132 return $ runIndentParser parseDeclarations text
3233 case asts of
3334 Left err -> do
3435 U.print err
3536 exitFailure
36− Right decls -> do
37+ Right decls ->
3738 case check (typeCheckAll decls) of
3839 Left typeError -> do
3940 U.putStrLn typeError
src/PureScript.hs+11−18
@@ -12,22 +12,15 @@
1212--
1313-----------------------------------------------------------------------------
1414
15−module PureScript (
16− module PureScript.Values,
17− module PureScript.Types,
18− module PureScript.Kinds,
19− module PureScript.Declarations,
20− module PureScript.Names,
21− module PureScript.Parser,
22− module PureScript.CodeGen,
23− module PureScript.TypeChecker
24−) where
15+module PureScript (module P) where
16+
17+import PureScript.Values as P
18+import PureScript.Types as P
19+import PureScript.Kinds as P
20+import PureScript.Declarations as P
21+import PureScript.Names as P
22+import PureScript.Parser as P
23+import PureScript.CodeGen as P
24+import PureScript.TypeChecker as P
25+import PureScript.Pretty as P
2526
26−import PureScript.Values
27−import PureScript.Types
28−import PureScript.Kinds
29−import PureScript.Declarations
30−import PureScript.Names
31−import PureScript.Parser
32−import PureScript.CodeGen
33−import PureScript.TypeChecker
src/PureScript/CodeGen/Common.hs+4−4
@@ -51,16 +51,16 @@ parens :: String -> String
5151parens s = ('(':s) ++ ")"
5252
5353chainl :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r
54−chainl split f p = fix $ \c -> (split >>> ((c <+> p) *** p) >>> A.arr (uncurry f))
54+chainl split f p = fix $ \c -> split >>> ((c <+> p) *** p) >>> A.arr (uncurry f)
5555
5656chainr :: Pattern a (a, a) -> (r -> r -> r) -> Pattern a r -> Pattern a r
57−chainr split f p = fix $ \c -> (split >>> (p *** (c <+> p)) >>> A.arr (uncurry f))
57+chainr split f p = fix $ \c -> split >>> (p *** (c <+> p)) >>> A.arr (uncurry f)
5858
5959wrap :: Pattern a (s, a) -> (s -> r -> r) -> Pattern a r -> Pattern a r
60−wrap split f p = fix $ \c -> (split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f))
60+wrap split f p = fix $ \c -> split >>> (C.id *** (c <+> p)) >>> A.arr (uncurry f)
6161
6262split :: Pattern a (s, t) -> (s -> t -> r) -> Pattern a r -> Pattern a r
63−split s f p = (s >>> A.arr (uncurry f))
63+split s f p = s >>> A.arr (uncurry f)
6464
6565data OperatorTable a r = OperatorTable { runOperatorTable :: [ [Operator a r] ] }
6666
src/PureScript/CodeGen/Common/Gen.hs+1−1
@@ -28,4 +28,4 @@ fresh :: Gen String
2828fresh = do
2929 n <- get
3030 modify (+ 1)
31− return $ "_" ++ show n
31+ return $ '_' : show n
src/PureScript/CodeGen/Externs.hs+1−1
@@ -32,5 +32,5 @@ externToPs env (ExternDeclaration name ty) =
3232externToPs env (ExternDataDeclaration name kind) =
3333 return $ "extern data " ++ name ++ " :: " ++ prettyPrintKind kind
3434externToPs env (TypeSynonymDeclaration name args ty) =
35− return $ "type " ++ name ++ " " ++ intercalate " " args ++ " = " ++ prettyPrintType ty
35+ return $ "type " ++ name ++ " " ++ unwords args ++ " = " ++ prettyPrintType ty
3636externToPs _ _ = Nothing
src/PureScript/CodeGen/JS.hs+30−29
@@ -21,6 +21,7 @@ import Data.Maybe (fromMaybe)
2121import Data.List (intercalate)
2222import qualified Control.Arrow as A
2323import Control.Arrow ((<+>))
24+import Control.Monad (forM)
2425import Control.Applicative
2526
2627import PureScript.Types
@@ -59,7 +60,7 @@ literals = Pattern $ A.Kleisli match
5960 bindersToJs :: [(Binder, Value)] -> Gen String
6061 bindersToJs binders = do
6162 valName <- fresh
62− jss <- flip mapM binders $ \(binder, result) -> do
63+ jss <- forM binders $ \(binder, result) -> do
6364 let js = valueToJs result
6465 binderToJs valName ("return " ++ js ++ ";") binder
6566 return $ "function (" ++ valName ++ ") {" ++ concat jss ++ "throw \"Failed pattern match\"; }"
@@ -121,34 +122,34 @@ valueToJs = fromMaybe (error "Incomplete pattern") . pattern matchValue
121122 matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)
122123 operators :: OperatorTable Value String
123124 operators =
124− OperatorTable $ [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
125− , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
126− , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]
127− , [ Split lam $ \args val -> "function (" ++ intercalate "," args ++ ") { return " ++ valueToJs val ++ "; }" ]
128− , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ valueToJs th ++ " : " ++ valueToJs el ]
129− , [ binary LessThan "<" ]
130− , [ binary LessThanOrEqualTo "<=" ]
131− , [ binary GreaterThan ">" ]
132− , [ binary GreaterThanOrEqualTo ">=" ]
133− , [ unary Not "!" ]
134− , [ unary BitwiseNot "~" ]
135− , [ unary Negate "-" ]
136− , [ binary Multiply "*" ]
137− , [ binary Divide "/" ]
138− , [ binary Modulus "%" ]
139− , [ binary Concat "+" ]
140− , [ binary Add "+" ]
141− , [ binary Subtract "-" ]
142− , [ binary ShiftLeft "<<" ]
143− , [ binary ShiftRight ">>" ]
144− , [ binary ZeroFillShiftRight ">>>" ]
145− , [ binary EqualTo "===" ]
146− , [ binary NotEqualTo "!==" ]
147− , [ binary BitwiseAnd "&" ]
148− , [ binary BitwiseXor "^" ]
149− , [ binary BitwiseOr "|" ]
150− , [ binary And "&&" ]
151− , [ binary Or "||" ]
125+ OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
126+ , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
127+ , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]
128+ , [ Split lam $ \args val -> "function (" ++ intercalate "," args ++ ") { return " ++ valueToJs val ++ "; }" ]
129+ , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ valueToJs th ++ " : " ++ valueToJs el ]
130+ , [ binary LessThan "<" ]
131+ , [ binary LessThanOrEqualTo "<=" ]
132+ , [ binary GreaterThan ">" ]
133+ , [ binary GreaterThanOrEqualTo ">=" ]
134+ , [ unary Not "!" ]
135+ , [ unary BitwiseNot "~" ]
136+ , [ unary Negate "-" ]
137+ , [ binary Multiply "*" ]
138+ , [ binary Divide "/" ]
139+ , [ binary Modulus "%" ]
140+ , [ binary Concat "+" ]
141+ , [ binary Add "+" ]
142+ , [ binary Subtract "-" ]
143+ , [ binary ShiftLeft "<<" ]
144+ , [ binary ShiftRight ">>" ]
145+ , [ binary ZeroFillShiftRight ">>>" ]
146+ , [ binary EqualTo "===" ]
147+ , [ binary NotEqualTo "!==" ]
148+ , [ binary BitwiseAnd "&" ]
149+ , [ binary BitwiseXor "^" ]
150+ , [ binary BitwiseOr "|" ]
151+ , [ binary And "&&" ]
152+ , [ binary Or "||" ]
152153 ]
153154
154155binderToJs :: String -> String -> Binder -> Gen String
src/PureScript/CodeGen/Pretty/Kinds.hs+2−2
@@ -31,7 +31,7 @@ typeLiterals = Pattern $ A.Kleisli match
3131 where
3232 match Star = Just "*"
3333 match Row = Just "#"
34− match (KUnknown u) = Just $ "u" ++ show u
34+ match (KUnknown u) = Just $ 'u' : show u
3535 match _ = Nothing
3636
3737funKind :: Pattern Kind (Kind, Kind)
@@ -47,4 +47,4 @@ prettyPrintKind = fromMaybe (error "Incomplete pattern") . pattern matchKind
4747 matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchKind)
4848 operators :: OperatorTable Kind String
4949 operators =
50− OperatorTable $ [ [ AssocR funKind $ \arg ret -> arg ++ " -> " ++ ret ] ]
50+ OperatorTable [ [ AssocR funKind $ \arg ret -> arg ++ " -> " ++ ret ] ]
src/PureScript/CodeGen/Pretty/Types.hs+6−6
@@ -42,7 +42,7 @@ typeLiterals = Pattern $ A.Kleisli match
4242 match (Object row) = Just $ "{ " ++ prettyPrintRow row ++ " }"
4343 match (TypeVar var) = Just var
4444 match (TypeConstructor ctor) = Just ctor
45− match (TUnknown u) = Just $ "u" ++ show u
45+ match (TUnknown u) = Just $ 'u' : show u
4646 match (SaturatedTypeSynonym name args) = Just $ name ++ "<" ++ intercalate "," (map prettyPrintType args) ++ ">"
4747 match _ = Nothing
4848
@@ -84,12 +84,12 @@ prettyPrintType = fromMaybe (error "Incomplete pattern") . pattern matchType
8484 matchType = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchType)
8585 operators :: OperatorTable Type String
8686 operators =
87− OperatorTable $ [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]
88− , [ AssocR singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret
89− , Wrap function $ \args ret -> "(" ++ intercalate ", " (map prettyPrintType args) ++ ") -> " ++ ret
90− ]
87+ OperatorTable [ [ AssocL typeApp $ \f x -> f ++ " " ++ x ]
88+ , [ AssocR singleArgumentFunction $ \arg ret -> arg ++ " -> " ++ ret
89+ , Wrap function $ \args ret -> "(" ++ intercalate ", " (map prettyPrintType args) ++ ") -> " ++ ret
9190 ]
91+ ]
9292
9393prettyPrintPolyType :: PolyType -> String
9494prettyPrintPolyType (PolyType [] ty) = prettyPrintType ty
95−prettyPrintPolyType (PolyType idents ty) = "forall " ++ intercalate " " idents ++ ". " ++ prettyPrintType ty
95+prettyPrintPolyType (PolyType idents ty) = "forall " ++ unwords idents ++ ". " ++ prettyPrintType ty
src/PureScript/CodeGen/Pretty/Values.hs+30−30
@@ -108,36 +108,36 @@ prettyPrintValue = fromMaybe (error "Incomplete pattern") . pattern matchValue
108108 matchValue = buildPrettyPrinter operators (literals <+> fmap parens matchValue)
109109 operators :: OperatorTable Value String
110110 operators =
111− OperatorTable $ [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
112− , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
113− , [ Wrap objectUpdate $ \ps val -> val ++ "{ " ++ intercalate ", " ps ++ " }" ]
114− , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]
115− , [ Split lam $ \args val -> "function (" ++ intercalate "," args ++ ") { return " ++ prettyPrintValue val ++ "; }" ]
116− , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintValue th ++ " : " ++ prettyPrintValue el ]
117− , [ binary LessThan "<" ]
118− , [ binary LessThanOrEqualTo "<=" ]
119− , [ binary GreaterThan ">" ]
120− , [ binary GreaterThanOrEqualTo ">=" ]
121− , [ unary Not "!" ]
122− , [ unary BitwiseNot "~" ]
123− , [ unary Negate "-" ]
124− , [ binary Multiply "*" ]
125− , [ binary Divide "/" ]
126− , [ binary Modulus "%" ]
127− , [ binary Concat "++" ]
128− , [ binary Add "+" ]
129− , [ binary Subtract "-" ]
130− , [ binary ShiftLeft "<<" ]
131− , [ binary ShiftRight ">>" ]
132− , [ binary ZeroFillShiftRight ">>>" ]
133− , [ binary EqualTo "==" ]
134− , [ binary NotEqualTo "!=" ]
135− , [ binary BitwiseAnd "&" ]
136− , [ binary BitwiseXor "^" ]
137− , [ binary BitwiseOr "|" ]
138− , [ binary And "&&" ]
139− , [ binary Or "||" ]
140− ]
111+ OperatorTable [ [ Wrap accessor $ \prop val -> val ++ "." ++ prop ]
112+ , [ Wrap indexer $ \index val -> val ++ "[" ++ index ++ "]" ]
113+ , [ Wrap objectUpdate $ \ps val -> val ++ "{ " ++ intercalate ", " ps ++ " }" ]
114+ , [ Wrap app $ \args val -> val ++ "(" ++ args ++ ")" ]
115+ , [ Split lam $ \args val -> "function (" ++ intercalate "," args ++ ") { return " ++ prettyPrintValue val ++ "; }" ]
116+ , [ Wrap ifThenElse $ \(th, el) cond -> cond ++ " ? " ++ prettyPrintValue th ++ " : " ++ prettyPrintValue el ]
117+ , [ binary LessThan "<" ]
118+ , [ binary LessThanOrEqualTo "<=" ]
119+ , [ binary GreaterThan ">" ]
120+ , [ binary GreaterThanOrEqualTo ">=" ]
121+ , [ unary Not "!" ]
122+ , [ unary BitwiseNot "~" ]
123+ , [ unary Negate "-" ]
124+ , [ binary Multiply "*" ]
125+ , [ binary Divide "/" ]
126+ , [ binary Modulus "%" ]
127+ , [ binary Concat "++" ]
128+ , [ binary Add "+" ]
129+ , [ binary Subtract "-" ]
130+ , [ binary ShiftLeft "<<" ]
131+ , [ binary ShiftRight ">>" ]
132+ , [ binary ZeroFillShiftRight ">>>" ]
133+ , [ binary EqualTo "==" ]
134+ , [ binary NotEqualTo "!=" ]
135+ , [ binary BitwiseAnd "&" ]
136+ , [ binary BitwiseXor "^" ]
137+ , [ binary BitwiseOr "|" ]
138+ , [ binary And "&&" ]
139+ , [ binary Or "||" ]
140+ ]
141141
142142prettyPrintBinder :: Binder -> String
143143prettyPrintBinder NullBinder = "_"
src/PureScript/Parser.hs+7−11
@@ -12,15 +12,11 @@
1212--
1313-----------------------------------------------------------------------------
1414
15−module PureScript.Parser (
16− module PureScript.Parser.Common,
17− module PureScript.Parser.Types,
18− module PureScript.Parser.Values,
19− module PureScript.Parser.Declarations
20−) where
21−
22−import PureScript.Parser.Common
23−import PureScript.Parser.Types
24−import PureScript.Parser.Values
25−import PureScript.Parser.Declarations
15+module PureScript.Parser (module P) where
2616
17+import PureScript.Parser.Common as P
18+import PureScript.Parser.Types as P
19+import PureScript.Parser.Values as P
20+import PureScript.Parser.State as P
21+import PureScript.Parser.Kinds as P
22+import PureScript.Parser.Declarations as P
src/PureScript/Parser/Common.hs+1−1
@@ -139,7 +139,7 @@ integerOrFloat = (Left <$> P.try (PT.natural tokenParser) <|>
139139 Right <$> P.try (PT.float tokenParser)) P.<?> "number"
140140
141141augment :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
142−augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
142+augment p q f = flip (maybe id $ flip f) <$> p <*> P.optionMaybe q
143143
144144fold :: P.Stream s m t => P.ParsecT s u m a -> P.ParsecT s u m b -> (a -> b -> a) -> P.ParsecT s u m a
145145fold first more combine = do
src/PureScript/Parser/Types.hs+1−1
@@ -67,7 +67,7 @@ parseTypeAtom = indented *> P.choice (map P.try
6767 , parens parseType ])
6868
6969parsePolyType :: P.Parsec String ParseState PolyType
70−parsePolyType = (PolyType <$> (P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot))
70+parsePolyType = (PolyType <$> P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot)
7171 <*> parseType) P.<?> "polymorphic type"
7272
7373parseType :: P.Parsec String ParseState Type
src/PureScript/Parser/Values.hs+14−11
@@ -47,10 +47,10 @@ parseBooleanLiteral :: P.Parsec String ParseState Value
4747parseBooleanLiteral = BooleanLiteral <$> booleanLiteral
4848
4949parseArrayLiteral :: P.Parsec String ParseState Value
50−parseArrayLiteral = ArrayLiteral <$> (C.squares $ parseValue `P.sepBy` (C.indented *> C.comma))
50+parseArrayLiteral = ArrayLiteral <$> C.squares (parseValue `P.sepBy` (C.indented *> C.comma))
5151
5252parseObjectLiteral :: P.Parsec String ParseState Value
53−parseObjectLiteral = ObjectLiteral <$> (C.braces $ parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))
53+parseObjectLiteral = ObjectLiteral <$> C.braces (parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))
5454
5555parseIdentifierAndValue :: P.Parsec String ParseState (String, Value)
5656parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)
@@ -75,7 +75,7 @@ parseConstructor :: P.Parsec String ParseState Value
7575parseConstructor = Constructor <$> C.properName
7676
7777parseCase :: P.Parsec String ParseState Value
78−parseCase = Case <$> (P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue)
78+parseCase = Case <$> P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue
7979 <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
8080
8181parseCaseAlternative :: P.Parsec String ParseState (Binder, Value)
@@ -92,7 +92,7 @@ parseBlock :: P.Parsec String ParseState Value
9292parseBlock = Block <$> (C.reserved "do" *> parseManyStatements)
9393
9494parseManyStatements :: P.Parsec String ParseState [Statement]
95−parseManyStatements = C.indented *> (C.mark $ P.many $ C.same *> C.mark parseStatement) P.<?> "block"
95+parseManyStatements = C.indented *> C.mark (P.many (C.same *> C.mark parseStatement)) P.<?> "block"
9696
9797parseValueAtom :: P.Parsec String ParseState Value
9898parseValueAtom = C.indented *> P.choice (map P.try
@@ -123,13 +123,13 @@ parseValue = do
123123 . C.buildPostfixParser postfixTable2
124124 $ indexersAndAccessors) P.<?> "expression"
125125 where
126− indexersAndAccessors = C.buildPostfixParser postfixTable1 $ parseValueAtom
126+ indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
127127 postfixTable1 = [ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)
128128 , Indexer <$> (C.indented *> C.squares parseValue)
129129 , flip ObjectUpdate <$> (C.indented *> C.braces ((C.indented *> parsePropertyUpdate) `P.sepBy1` (C.indented *> C.comma))) ]
130130 postfixTable2 = [ C.indented *> indexersAndAccessors >>= \t2 -> return (\t1 -> App t1 [t2])
131131 , flip App <$> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
132− , flip TypedValue <$> (P.try $ C.lexeme (C.indented *> P.string "::") *> parsePolyType) ]
132+ , flip TypedValue <$> (P.try (C.lexeme (C.indented *> P.string "::")) *> parsePolyType) ]
133133 operators user =
134134 [ [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
135135 , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
@@ -166,11 +166,14 @@ customOperatorTable fixities =
166166 sorted = sortBy (compare `on` (snd . snd)) ops
167167 levels = groupBy ((==) `on` (snd . snd)) sorted
168168 in
169− flip map levels (map (\(name, (a, _)) -> flip Infix (toAssoc a) $ do
170− C.lexeme $ P.try $ do
171− C.indented
172− C.reservedOp name P.<?> "operator"
173− return $ \t1 t2 -> App (App (Var (Op name)) [t1]) [t2]))
169+ map (map $ \(name, (a, _)) ->
170+ flip Infix (toAssoc a) $
171+ C.lexeme $ P.try $ do
172+ C.indented
173+ C.reservedOp name P.<?> "operator"
174+ return $ \t1 t2 -> App (App (Var (Op name)) [t1]) [t2])
175+ levels
176+
174177
175178toAssoc :: Associativity -> Assoc
176179toAssoc Infixl = AssocLeft
src/PureScript/Pretty.hsnew file+22
@@ -0,0 +1,22 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : PureScript.Pretty
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module PureScript.Pretty (module P) where
16+
17+import PureScript.CodeGen.Pretty.Kinds as P
18+import PureScript.CodeGen.Pretty.Values as P
19+import PureScript.CodeGen.Pretty.Types as P
20+
21+
22+
src/PureScript/TypeChecker.hs+11−14
@@ -12,19 +12,17 @@
1212--
1313-----------------------------------------------------------------------------
1414
15−{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-}
15+{-# LANGUAGE FlexibleInstances #-}
1616
1717module PureScript.TypeChecker (
18− module PureScript.TypeChecker.Monad,
19− module PureScript.TypeChecker.Kinds,
20− module PureScript.TypeChecker.Types,
21− typeCheckAll,
18+module T,
19+ typeCheckAll
2220) where
2321
24−import PureScript.TypeChecker.Monad
25−import PureScript.TypeChecker.Kinds
26−import PureScript.TypeChecker.Types
27−import PureScript.TypeChecker.Synonyms
22+import PureScript.TypeChecker.Monad as T
23+import PureScript.TypeChecker.Kinds as T
24+import PureScript.TypeChecker.Types as T
25+import PureScript.TypeChecker.Synonyms as T
2826
2927import Data.List
3028import Data.Maybe
@@ -37,23 +35,22 @@ import PureScript.Names
3735import PureScript.Kinds
3836import PureScript.Declarations
3937
38+import Control.Monad (forM_)
4039import Control.Monad.State
4140import Control.Monad.Error
4241
43−import qualified Data.Map as M
44−
4542typeCheckAll :: [Declaration] -> Check ()
4643typeCheckAll [] = return ()
4744typeCheckAll (DataDeclaration name args dctors : rest) = do
4845 rethrow (("Error in type constructor " ++ name ++ ": ") ++) $ do
4946 env <- getEnv
5047 guardWith (name ++ " is already defined") $ not $ M.member name (types env)
51− ctorKind <- kindsOf (Just name) args (catMaybes $ map snd dctors)
48+ ctorKind <- kindsOf (Just name) args (mapMaybe snd dctors)
5249 putEnv $ env { types = M.insert name (ctorKind, Data) (types env) }
53− flip mapM_ dctors $ \(dctor, maybeTy) ->
50+ forM_ dctors $ \(dctor, maybeTy) ->
5451 rethrow (("Error in data constructor " ++ name ++ ": ") ++) $ do
5552 env' <- getEnv
56− guardWith (dctor ++ " is already defined") $ not $ flip M.member (dataConstructors env') dctor
53+ guardWith (dctor ++ " is already defined") $ not $ M.member dctor (dataConstructors env')
5754 let retTy = foldl TypeApp (TypeConstructor name) (map TypeVar args)
5855 let dctorTy = maybe retTy (\ty -> Function [ty] retTy) maybeTy
5956 let polyType = PolyType args dctorTy
src/PureScript/TypeChecker/Kinds.hs+10−11
@@ -70,9 +70,9 @@ kindsOf :: Maybe String -> [String] -> [Type] -> Check Kind
7070kindsOf name args ts = do
7171 tyCon <- fresh
7272 nargs <- replicateM (length args) fresh
73− (cs, ns, m) <- kindConstraintsAll (maybe id (flip M.insert tyCon) name $ M.fromList (zipWith (,) args nargs)) ts
73+ (cs, ns, m) <- kindConstraintsAll (maybe id (`M.insert` tyCon) name $ M.fromList (zip args nargs)) ts
7474 let extraConstraints =
75− KindConstraint tyCon (foldr FunKind Star (map KUnknown nargs)) DataDeclOrigin
75+ KindConstraint tyCon (foldr (FunKind . KUnknown) Star nargs) DataDeclOrigin
7676 : zipWith (\n arg -> KindConstraint n Star (TypeOrigin arg)) ns ts
7777 solution <- solveKindConstraints (extraConstraints ++ cs) emptyKindSolution
7878 return $ starIfUnknown $ runKindSolution solution tyCon
@@ -87,23 +87,23 @@ kindConstraintsAll m [] = return ([], [], m)
8787kindConstraintsAll m (t:ts) = do
8888 (cs, n1, m') <- kindConstraints m t
8989 (cs', ns, m'') <- kindConstraintsAll m' ts
90− return ((KindConstraint n1 Star (TypeOrigin t)) : cs ++ cs', n1:ns, m'')
90+ return (KindConstraint n1 Star (TypeOrigin t) : cs ++ cs', n1:ns, m'')
9191
9292kindConstraints :: M.Map String Int -> Type -> Check ([KindConstraint], Int, M.Map String Int)
9393kindConstraints m a@(Array t) = do
9494 me <- fresh
9595 (cs, n1, m') <- kindConstraints m t
96− return ((KindConstraint n1 Star (TypeOrigin t)) : (KindConstraint me Star (TypeOrigin a)) : cs, me, m')
96+ return (KindConstraint n1 Star (TypeOrigin t) : KindConstraint me Star (TypeOrigin a) : cs, me, m')
9797kindConstraints m o@(Object row) = do
9898 me <- fresh
9999 (cs, r, m') <- kindConstraintsForRow m row
100− return ((KindConstraint me Star (TypeOrigin o)) : (KindConstraint r Row (RowOrigin row)) : cs, me, m')
100+ return (KindConstraint me Star (TypeOrigin o) : KindConstraint r Row (RowOrigin row) : cs, me, m')
101101kindConstraints m f@(Function args ret) = do
102102 me <- fresh
103103 (cs, ns, m') <- kindConstraintsAll m args
104104 (cs', retN, m'') <- kindConstraints m' ret
105− return ((KindConstraint retN Star (TypeOrigin ret)) : (KindConstraint me Star (TypeOrigin f)) : (zipWith (\n arg -> KindConstraint n Star (TypeOrigin arg)) ns args) ++ cs ++ cs', me, m'')
106−kindConstraints m (TypeVar v) = do
105+ return (KindConstraint retN Star (TypeOrigin ret) : KindConstraint me Star (TypeOrigin f) : zipWith (\n arg -> KindConstraint n Star (TypeOrigin arg)) ns args ++ cs ++ cs', me, m'')
106+kindConstraints m (TypeVar v) =
107107 case M.lookup v m of
108108 Just u -> return ([], u, m)
109109 Nothing -> throwError $ "Unbound type variable " ++ v
@@ -114,13 +114,12 @@ kindConstraints m c@(TypeConstructor v) = do
114114 Nothing -> case M.lookup v (types env) of
115115 Nothing -> throwError $ "Unknown type constructor '" ++ v ++ "'"
116116 Just (kind, _) -> return ([KindConstraint me kind (TypeOrigin c)], me, m)
117− Just u -> do
118− return ([KindConstraint me (KUnknown u) (TypeOrigin c)], me, m)
117+ Just u -> return ([KindConstraint me (KUnknown u) (TypeOrigin c)], me, m)
119118kindConstraints m a@(TypeApp t1 t2) = do
120119 me <- fresh
121120 (cs1, n1, m1) <- kindConstraints m t1
122121 (cs2, n2, m2) <- kindConstraints m1 t2
123− return ((KindConstraint n1 (FunKind (KUnknown n2) (KUnknown me)) (TypeOrigin a)) : cs1 ++ cs2, me, m2)
122+ return (KindConstraint n1 (FunKind (KUnknown n2) (KUnknown me)) (TypeOrigin a) : cs1 ++ cs2, me, m2)
124123kindConstraints m t = do
125124 me <- fresh
126125 return ([KindConstraint me Star (TypeOrigin t)], me, m)
@@ -138,7 +137,7 @@ kindConstraintsForRow m r@(RCons _ ty row) = do
138137 me <- fresh
139138 (cs1, n1, m1) <- kindConstraints m ty
140139 (cs2, n2, m2) <- kindConstraintsForRow m1 row
141− return ((KindConstraint me Row (RowOrigin r)) : (KindConstraint n1 Star (TypeOrigin ty)) : (KindConstraint n2 Row (RowOrigin r)) : cs1 ++ cs2, me, m2)
140+ return (KindConstraint me Row (RowOrigin r) : KindConstraint n1 Star (TypeOrigin ty) : KindConstraint n2 Row (RowOrigin r) : cs1 ++ cs2, me, m2)
142141
143142solveKindConstraints :: [KindConstraint] -> KindSolution -> Check KindSolution
144143solveKindConstraints [] s = return s
src/PureScript/TypeChecker/Monad.hs+3−3
@@ -24,7 +24,7 @@ import Control.Applicative
2424import Control.Monad.State
2525import Control.Monad.Error
2626
27−import Control.Arrow ((***))
27+import Control.Arrow ((***), first, second)
2828
2929import qualified Data.Map as M
3030
@@ -48,7 +48,7 @@ getEnv :: Check Environment
4848getEnv = fmap fst get
4949
5050putEnv :: Environment -> Check ()
51−putEnv env = fmap (const env *** id) get >>= put
51+putEnv env = fmap (first (const env)) get >>= put
5252
5353fresh :: Check Int
5454fresh = do
@@ -57,7 +57,7 @@ fresh = do
5757 return n
5858
5959check :: Check a -> Either String (a, Environment)
60−check = fmap (id *** fst) . flip runStateT (emptyEnvironment, 0) . unCheck
60+check = fmap (second fst) . flip runStateT (emptyEnvironment, 0) . unCheck
6161
6262guardWith :: (MonadError e m) => e -> Bool -> m ()
6363guardWith _ True = return ()
src/PureScript/TypeChecker/Types.hs+36−36
@@ -42,7 +42,7 @@ import Control.Monad.State
4242import Control.Monad.Error
4343
4444import Control.Applicative
45−import Control.Arrow (Kleisli(..), (***), (&&&))
45+import Control.Arrow (Kleisli(..), (***), (&&&), first)
4646import qualified Control.Category as C
4747
4848import qualified Data.Map as M
@@ -105,7 +105,7 @@ allUnknownsBecameQuantified cs solution ty = do
105105 guardWith "Unsolved row variable" $ null $ unsolvedRows \\ rowsMentioned
106106
107107setify :: Row -> Row
108−setify = rowFromList . (M.toList . M.fromList *** id) . rowToList
108+setify = rowFromList . first (M.toList . M.fromList) . rowToList
109109
110110setifyAll :: (D.Data d) => d -> d
111111setifyAll = everywhere (mkT setify)
@@ -143,7 +143,7 @@ varIfUnknown ty =
143143 m <- get
144144 case M.lookup n m of
145145 Nothing -> do
146− let name = "t" ++ show (M.size m)
146+ let name = 't' : show (M.size m)
147147 put $ M.insert n name m
148148 return $ TypeVar name
149149 Just name -> return $ TypeVar name
@@ -153,7 +153,7 @@ varIfUnknown ty =
153153 m <- get
154154 case M.lookup n m of
155155 Nothing -> do
156− let name = "r" ++ show (M.size m)
156+ let name = 'r' : show (M.size m)
157157 put $ M.insert n name m
158158 return $ RowVar name
159159 Just name -> return $ RowVar name
@@ -198,9 +198,9 @@ replaceAllTypeSynonyms d = do
198198 either throwError return $ saturateAllTypeSynonyms syns d
199199
200200desaturateAllTypeSynonyms :: (D.Data d) => d -> d
201−desaturateAllTypeSynonyms = everywhere (mkT $ replace)
201+desaturateAllTypeSynonyms = everywhere (mkT replace)
202202 where
203− replace (SaturatedTypeSynonym name args) = foldl (\t arg -> TypeApp t arg) (TypeConstructor name) args
203+ replace (SaturatedTypeSynonym name args) = foldl TypeApp (TypeConstructor name) args
204204 replace t = t
205205
206206replaceType :: (D.Data d) => Int -> Type -> d -> d
@@ -259,7 +259,7 @@ typeConstraints _ v@(BooleanLiteral _) = do
259259 return ([TypeConstraint me Boolean (ValueOrigin v)], me)
260260typeConstraints m v@(ArrayLiteral vals) = do
261261 all <- mapM (typeConstraints m) vals
262− let (cs, ns) = (concat . map fst &&& map snd) all
262+ let (cs, ns) = (concatMap fst &&& map snd) all
263263 me <- fresh
264264 return (cs ++ zipWith (\n el -> TypeConstraint me (Array $ TUnknown n) (ValueOrigin el)) ns vals, me)
265265typeConstraints m u@(Unary op val) = do
@@ -274,15 +274,15 @@ typeConstraints m b@(Binary op left right) = do
274274typeConstraints m v@(ObjectLiteral ps) = do
275275 ensureNoDuplicateProperties ps
276276 all <- mapM (typeConstraints m . snd) ps
277− let (cs, ns) = (concat . map fst &&& map snd) all
277+ let (cs, ns) = (concatMap fst &&& map snd) all
278278 me <- fresh
279279 let tys = zipWith (\(name, _) u -> (name, TUnknown u)) ps ns
280− return ((TypeConstraint me (Object (typesToRow tys)) (ValueOrigin v)) : cs, me)
280+ return (TypeConstraint me (Object (typesToRow tys)) (ValueOrigin v) : cs, me)
281281typeConstraints m v@(ObjectUpdate o ps) = do
282282 ensureNoDuplicateProperties ps
283283 (cs1, n1) <- typeConstraints m o
284284 all <- mapM (typeConstraints m . snd) ps
285− let (cs2, ns) = (concat . map fst &&& map snd) all
285+ let (cs2, ns) = (concatMap fst &&& map snd) all
286286 row <- fresh
287287 let tys = zipWith (\(name, _) u -> (name, TUnknown u)) ps ns
288288 return (TypeConstraint n1 (Object (rowFromList (tys, RUnknown row))) (ValueOrigin v) : cs1 ++ cs2, n1)
@@ -290,24 +290,24 @@ typeConstraints m v@(Indexer index val) = do
290290 (cs1, n1) <- typeConstraints m index
291291 (cs2, n2) <- typeConstraints m val
292292 me <- fresh
293− return ((TypeConstraint n1 Number (ValueOrigin index)) : (TypeConstraint n2 (Array (TUnknown me)) (ValueOrigin v)) : cs1 ++ cs2, me)
293+ return (TypeConstraint n1 Number (ValueOrigin index) : TypeConstraint n2 (Array (TUnknown me)) (ValueOrigin v) : cs1 ++ cs2, me)
294294typeConstraints m v@(Accessor prop val) = do
295295 (cs, n1) <- typeConstraints m val
296296 me <- fresh
297297 rest <- fresh
298− return ((TypeConstraint n1 (Object (RCons prop (TUnknown me) (RUnknown rest))) (ValueOrigin v)) : cs, me)
298+ return (TypeConstraint n1 (Object (RCons prop (TUnknown me) (RUnknown rest))) (ValueOrigin v) : cs, me)
299299typeConstraints m v@(Abs args ret) = do
300300 ns <- replicateM (length args) fresh
301− let m' = m `M.union` M.fromList (zipWith (,) args ns)
301+ let m' = m `M.union` M.fromList (zip args ns)
302302 (cs, n') <- typeConstraints m' ret
303303 me <- fresh
304− return ((TypeConstraint me (Function (map TUnknown ns) (TUnknown n')) (ValueOrigin v)) : cs, me)
304+ return (TypeConstraint me (Function (map TUnknown ns) (TUnknown n')) (ValueOrigin v) : cs, me)
305305typeConstraints m v@(App f xs) = do
306306 (cs1, n1) <- typeConstraints m f
307307 all <- mapM (typeConstraints m) xs
308− let (cs2, ns) = (concat . map fst &&& map snd) all
308+ let (cs2, ns) = (concatMap fst &&& map snd) all
309309 me <- fresh
310− return ((TypeConstraint n1 (Function (map TUnknown ns) (TUnknown me)) (ValueOrigin v)) : cs1 ++ cs2, me)
310+ return (TypeConstraint n1 (Function (map TUnknown ns) (TUnknown me)) (ValueOrigin v) : cs1 ++ cs2, me)
311311typeConstraints m v@(Var var) =
312312 case M.lookup var m of
313313 Nothing -> do
@@ -381,7 +381,7 @@ equalityBinOpConstraints :: Value -> Int -> Int -> Int -> [TypeConstraint]
381381equalityBinOpConstraints v left right result = [TypeConstraint left (TUnknown right) (ValueOrigin v), TypeConstraint result Boolean (ValueOrigin v)]
382382
383383symBinOpConstraints :: Value -> Type -> Int -> Int -> Int -> [TypeConstraint]
384−symBinOpConstraints v ty left right result = asymBinOpConstraints v ty ty left right result
384+symBinOpConstraints v ty = asymBinOpConstraints v ty ty
385385
386386asymBinOpConstraints :: Value -> Type -> Type -> Int -> Int -> Int -> [TypeConstraint]
387387asymBinOpConstraints v ty res left right result = [TypeConstraint left ty (ValueOrigin v), TypeConstraint right ty (ValueOrigin v), TypeConstraint result res (ValueOrigin v)]
@@ -408,14 +408,14 @@ typeConstraintsForBinder val b@(UnaryBinder ctor binder) = do
408408 obj <- fresh
409409 (Function [ty] ret) <- replaceVarsWithUnknowns idents f
410410 (cs, m1) <- typeConstraintsForBinder obj binder
411− return ((TypeConstraint val ret (BinderOrigin b)) : (TypeConstraint obj ty (BinderOrigin b)) : cs, m1)
411+ return (TypeConstraint val ret (BinderOrigin b) : TypeConstraint obj ty (BinderOrigin b) : cs, m1)
412412 Just _ -> throwError $ ctor ++ " is not a unary constructor"
413413 _ -> throwError $ "Constructor " ++ ctor ++ " is not defined"
414414typeConstraintsForBinder val b@(ObjectBinder props) = do
415415 row <- fresh
416416 rest <- fresh
417417 (cs, m1) <- typeConstraintsForProperties row (RUnknown rest) props
418− return ((TypeConstraint val (Object (RUnknown row)) (BinderOrigin b)) : cs, m1)
418+ return (TypeConstraint val (Object (RUnknown row)) (BinderOrigin b) : cs, m1)
419419 where
420420 typeConstraintsForProperties :: Int -> Row -> [(String, Binder)] -> Check ([TypeConstraint], M.Map Ident Int)
421421 typeConstraintsForProperties nrow row [] = return ([RowConstraint nrow row (BinderOrigin b)], M.empty)
@@ -423,17 +423,17 @@ typeConstraintsForBinder val b@(ObjectBinder props) = do
423423 propTy <- fresh
424424 (cs1, m1) <- typeConstraintsForBinder propTy binder
425425 (cs2, m2) <- typeConstraintsForProperties nrow (RCons name (TUnknown propTy) row) binders
426− return (cs1 ++ cs2, M.union m1 m2)
426+ return (cs1 ++ cs2, m1 `M.union` m2)
427427typeConstraintsForBinder val b@(ArrayBinder binders rest) = do
428428 el <- fresh
429429 all <- mapM (typeConstraintsForBinder el) binders
430− let (cs1, m1) = (concat . map fst &&& M.unions . map snd) all
430+ let (cs1, m1) = (concatMap fst &&& M.unions . map snd) all
431431 let arrayConstraint = TypeConstraint val (Array (TUnknown el)) (BinderOrigin b)
432432 case rest of
433433 Nothing -> return (arrayConstraint : cs1, m1)
434434 Just binder -> do
435435 (cs2, m2) <- typeConstraintsForBinder val binder
436− return (arrayConstraint : cs1 ++ cs2, M.union m1 m2)
436+ return (arrayConstraint : cs1 ++ cs2, m1 `M.union` m2)
437437typeConstraintsForBinder val b@(NamedBinder name binder) = do
438438 me <- fresh
439439 (cs, m) <- typeConstraintsForBinder val binder
@@ -450,9 +450,9 @@ typeConstraintsForBinders :: M.Map Ident Int -> Int -> Int -> [(Binder, Value)]
450450typeConstraintsForBinders _ _ _ [] = return []
451451typeConstraintsForBinders m nval ret ((binder, val):bs) = do
452452 (cs1, m1) <- typeConstraintsForBinder nval binder
453− (cs2, n2) <- typeConstraints (M.union m m1) val
453+ (cs2, n2) <- typeConstraints (m `M.union` m1) val
454454 cs3 <- typeConstraintsForBinders m nval ret bs
455− return ((TypeConstraint n2 (TUnknown ret) (BinderOrigin binder)) : cs1 ++ cs2 ++ cs3)
455+ return (TypeConstraint n2 (TUnknown ret) (BinderOrigin binder) : cs1 ++ cs2 ++ cs3)
456456
457457assignVariable :: Ident -> M.Map Ident Int -> Check ()
458458assignVariable name m =
@@ -464,27 +464,27 @@ typeConstraintsForStatement :: M.Map Ident Int -> M.Map Ident Int -> Int -> Stat
464464typeConstraintsForStatement m mass ret (VariableIntroduction name val) = do
465465 assignVariable name (m `M.union` mass)
466466 (cs1, n1) <- typeConstraints m val
467− return $ (cs1, False, M.insert name n1 mass)
467+ return (cs1, False, M.insert name n1 mass)
468468typeConstraintsForStatement m mass ret (Assignment ident val) = do
469469 (cs1, n1) <- typeConstraints m val
470470 case M.lookup ident mass of
471471 Nothing -> throwError $ "No local variable with name " ++ show ident
472− Just ty -> do
472+ Just ty ->
473473 return (TypeConstraint n1 (TUnknown ty) (AssignmentTargetOrigin ident) : cs1, False, mass)
474474typeConstraintsForStatement m mass ret (While val inner) = do
475475 (cs1, n1) <- typeConstraints m val
476476 (cs2, allCodePathsReturn, _) <- typeConstraintsForBlock m mass ret inner
477− return $ ((TypeConstraint n1 Boolean (ValueOrigin val)) : cs1 ++ cs2, allCodePathsReturn, mass)
477+ return (TypeConstraint n1 Boolean (ValueOrigin val) : cs1 ++ cs2, allCodePathsReturn, mass)
478478typeConstraintsForStatement m mass ret (If ifst) = do
479479 (cs, allCodePathsReturn) <- typeConstraintsForIfStatement m mass ret ifst
480− return $ (cs, allCodePathsReturn, mass)
480+ return (cs, allCodePathsReturn, mass)
481481typeConstraintsForStatement m mass ret (For ident start end inner) = do
482482 assignVariable ident (m `M.union` mass)
483483 (cs1, n1) <- typeConstraints (m `M.union` mass) start
484484 (cs2, n2) <- typeConstraints (m `M.union` mass) end
485485 let mass1 = M.insert ident n1 mass
486486 (cs3, allCodePathsReturn, _) <- typeConstraintsForBlock (m `M.union` mass1) mass1 ret inner
487− return $ ((TypeConstraint n1 Number (ValueOrigin start)) : (TypeConstraint n2 Number (ValueOrigin end)) : cs1 ++ cs2 ++ cs3, allCodePathsReturn, mass)
487+ return (TypeConstraint n1 Number (ValueOrigin start) : TypeConstraint n2 Number (ValueOrigin end) : cs1 ++ cs2 ++ cs3, allCodePathsReturn, mass)
488488typeConstraintsForStatement m mass ret (ForEach ident vals inner) = do
489489 assignVariable ident (m `M.union` mass)
490490 val <- fresh
@@ -492,21 +492,21 @@ typeConstraintsForStatement m mass ret (ForEach ident vals inner) = do
492492 let mass1 = M.insert ident val mass
493493 (cs2, allCodePathsReturn, _) <- typeConstraintsForBlock (m `M.union` mass1) mass1 ret inner
494494 guardWith "Cannot return from within a foreach block" $ not allCodePathsReturn
495− return $ ((TypeConstraint n1 (Array (TUnknown val)) (ValueOrigin vals)) : cs1 ++ cs2, False, mass)
495+ return (TypeConstraint n1 (Array (TUnknown val)) (ValueOrigin vals) : cs1 ++ cs2, False, mass)
496496typeConstraintsForStatement m mass ret (Return val) = do
497497 (cs1, n1) <- typeConstraints (m `M.union` mass) val
498− return ((TypeConstraint n1 (TUnknown ret) (ValueOrigin val)) : cs1, True, mass)
498+ return (TypeConstraint n1 (TUnknown ret) (ValueOrigin val) : cs1, True, mass)
499499
500500typeConstraintsForIfStatement :: M.Map Ident Int -> M.Map Ident Int -> Int -> IfStatement -> Check ([TypeConstraint], Bool)
501501typeConstraintsForIfStatement m mass ret (IfStatement val thens Nothing) = do
502502 (cs1, n1) <- typeConstraints m val
503503 (cs2, _, _) <- typeConstraintsForBlock m mass ret thens
504− return ((TypeConstraint n1 Boolean (ValueOrigin val)) : cs1 ++ cs2, False)
504+ return (TypeConstraint n1 Boolean (ValueOrigin val) : cs1 ++ cs2, False)
505505typeConstraintsForIfStatement m mass ret (IfStatement val thens (Just elses)) = do
506506 (cs1, n1) <- typeConstraints m val
507507 (cs2, allCodePathsReturn1, _) <- typeConstraintsForBlock m mass ret thens
508508 (cs3, allCodePathsReturn2) <- typeConstraintsForElseStatement m mass ret elses
509− return ((TypeConstraint n1 Boolean (ValueOrigin val)) : cs1 ++ cs2 ++ cs3, allCodePathsReturn1 && allCodePathsReturn2)
509+ return (TypeConstraint n1 Boolean (ValueOrigin val) : cs1 ++ cs2 ++ cs3, allCodePathsReturn1 && allCodePathsReturn2)
510510
511511typeConstraintsForElseStatement :: M.Map Ident Int -> M.Map Ident Int -> Int -> ElseStatement -> Check ([TypeConstraint], Bool)
512512typeConstraintsForElseStatement m mass ret (Else elses) = do
@@ -541,7 +541,7 @@ solveTypeConstraints (RowConstraint n r o:cs) s = do
541541 (cs', s') <- rethrow (\err -> "Error in " ++ prettyPrintOrigin o ++ ": " ++ err) $ do
542542 rowOccursCheck n r
543543 let s' = let (f, g) = runTypeSolution s
544− in TypeSolution $ (replaceRow n r . f, replaceRow n r . g)
544+ in TypeSolution (replaceRow n r . f, replaceRow n r . g)
545545 cs' <- fmap concat $ mapM (substituteRowInConstraint n r) cs
546546 return (cs', s')
547547 solveTypeConstraints cs' s'
@@ -603,8 +603,8 @@ unifyRows o r1 r2 =
603603 (s1, r1') = rowToList r1
604604 (s2, r2') = rowToList r2
605605 int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]
606− sd1 = [ (name, t1) | (name, t1) <- s1, not (elem name (map fst s2)) ]
607− sd2 = [ (name, t2) | (name, t2) <- s2, not (elem name (map fst s1)) ]
606+ sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]
607+ sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]
608608 in do
609609 cs1 <- fmap concat $ mapM (uncurry $ unifyTypes o) int
610610 cs2 <- unifyRows' o sd1 r1' sd2 r2'