git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Finally get indentation working
commiteec09d8dec7737f8e67354fd32987567abf4e406 authorPhil Freeman <paf31@cantab.net> dateSun 20 Oct 2013, 16:32 (13 years ago) parent3f38a6e
16 files changed+336−316
compare with golang
unifiedsplit
PureScript.cabal+2−4 examples/Arrays.ps−1 examples/Assign.ps+5−7 examples/IfThenElse.ps+24 examples/List.ps+1 examples/TypeDecl.ps+5−7 examples/TypeSynonyms.ps+4−5 src/Main.hs+2−1 src/PureScript/CodeGen/JS.hs+13−6 src/PureScript/Parser.hs+2 src/PureScript/Parser/Common.hs+83−114 src/PureScript/Parser/Declarations.hs+25−21 src/PureScript/Parser/Types.hs+20−21 src/PureScript/Parser/Values.hs+119−117 src/PureScript/TypeChecker/Types.hs+22−9 src/PureScript/Values.hs+9−3
PureScript.cabal+2−4
@@ -14,8 +14,7 @@ data-dir: ""
1414
1515library
1616 build-depends: base -any, syb -any, cmdtheline -any,
17− containers -any, mtl -any, parsec -any, utf8-string -any,
18− indents -any
17+ containers -any, mtl -any, parsec -any, utf8-string -any
1918 exposed-modules: PureScript
2019 exposed: True
2120 buildable: True
@@ -32,8 +31,7 @@ library
3231
3332executable psc
3433 build-depends: base -any, cmdtheline -any, containers -any,
35− mtl -any, parsec -any, utf8-string -any,
36− indents -any
34+ mtl -any, parsec -any, utf8-string -any
3735 main-is: Main.hs
3836 buildable: True
3937 hs-source-dirs: src
examples/Arrays.ps−1
@@ -11,4 +11,3 @@ data Tree = One Number | Some [Tree]
1111test3 = \tree, sum -> case tree of
1212 One n -> n
1313 Some [n1, n2 : rest] -> test3(n1, sum) * 10 + test3(n2, sum) * 5 + sum(rest)
14−
examples/Assign.ps+5−7
@@ -1,7 +1,5 @@
1−test = \ -> {
2− var x = [];
3− for (var i = 0; i < 10; i = i + 1) {
4− x[i] = i;
5− }
6− return x;
7− }
1+test = \ -> do
2+ var x = []
3+ for (var i = 0; i < 10; i = i + 1):
4+ x[i] = i
5+ return x
examples/IfThenElse.psnew file+24
@@ -0,0 +1,24 @@
1+testIf = do
2+ var x = 0
3+ if x == 0:
4+ x = x + 1
5+ return x
6+
7+testIfElse = do
8+ var x = 0
9+ if x == 0:
10+ x = x + 1
11+ else:
12+ x = x - 1
13+ return x
14+
15+testIfElseIf = \x -> do
16+ var y = x
17+ while y > 1:
18+ if y % 3 == 0:
19+ y = y / 3
20+ else if y % 3 == 1:
21+ y = (y - 1) % 3
22+ else:
23+ y = y * 4 + 1
24+ return y
examples/List.ps+1
@@ -19,3 +19,4 @@ concat = \l1 -> \l2 -> case l1 of
1919flatten = \xss -> case xss of
2020 Nil -> Nil
2121 Cons cons -> concat(cons.head)(flatten(cons.tail))
22+
examples/TypeDecl.ps+5−7
@@ -5,10 +5,8 @@ k :: (String) -> (Number) -> String
55k = \x -> \y -> x
66
77iterate :: forall a. (Number) -> ((a) -> a) -> (a) -> a
8−iterate = \n -> \f -> \a -> {
9− var result = a;
10− for (var i = 0; i < n; i = i + 1) {
11− result = f(result);
12− }
13− return result;
14− }
8+iterate = \n -> \f -> \a -> do
9+ var result = a
10+ for (var i = 0; i < n; i = i + 1):
11+ result = f(result)
12+ return result
examples/TypeSynonyms.ps+4−5
@@ -6,9 +6,8 @@ type Lens a b =
66composeLenses :: forall a b c. (Lens a b) -> (Lens b c) -> Lens a c
77composeLenses = \l1 -> \l2 ->
88 { get: \a -> (l2.get)((l1.get)(a))
9− , set: \a -> \c -> {
10− var b = (l1.get)(a);
11− var b1 = (l2.set)(b)(c);
12− return (l1.set)(a)(b1);
13− }
9+ , set: \a -> \c -> do
10+ var b = (l1.get)(a)
11+ var b1 = (l2.set)(b)(c)
12+ return (l1.set)(a)(b1)
1413 }
src/Main.hs+2−1
@@ -20,13 +20,14 @@ import Data.List (intercalate)
2020import System.Console.CmdTheLine
2121import Control.Applicative
2222import System.Exit (exitSuccess, exitFailure)
23+import qualified Text.Parsec as P
2324import qualified System.IO.UTF8 as U
2425import qualified Data.Map as M
2526
2627compile :: [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
2728compile inputFiles outputFile externsFile = do
2829 input <- fmap concat $ mapM U.readFile inputFiles
29− let ast = parseDeclarations input
30+ let ast = runIndentParser 0 parseDeclarations input
3031 case ast of
3132 Left err -> do
3233 U.print err
src/PureScript/CodeGen/JS.hs+13−6
@@ -48,7 +48,7 @@ declToJs _ = Nothing
4848literals :: Pattern Value String
4949literals = Pattern $ A.Kleisli match
5050 where
51− match (NumericLiteral n) = Just n
51+ match (NumericLiteral n) = Just $ either show show n
5252 match (StringLiteral s) = Just $ show s
5353 match (BooleanLiteral True) = Just "true"
5454 match (BooleanLiteral False) = Just "false"
@@ -177,7 +177,7 @@ binderToJs :: String -> String -> Binder -> Gen String
177177binderToJs varName done (StringBinder str) =
178178 return $ "if (" ++ varName ++ " === \"" ++ str ++ "\") {" ++ done ++ " }"
179179binderToJs varName done (NumberBinder num) =
180− return $ "if (" ++ varName ++ " === \"" ++ num ++ "\") {" ++ done ++ " }"
180+ return $ "if (" ++ varName ++ " === \"" ++ either show show num ++ "\") {" ++ done ++ " }"
181181binderToJs varName done (BooleanBinder True) =
182182 return $ "if (" ++ varName ++ ") {" ++ done ++ " }"
183183binderToJs varName done (BooleanBinder False) =
@@ -228,12 +228,19 @@ statementToJs (For (init, cond, done) sts) = "for (" ++
228228 ++ "; " ++ valueToJs cond
229229 ++ "; " ++ statementToJs done
230230 ++ ") {" ++ intercalate ";" (map statementToJs sts) ++ "}"
231−statementToJs (IfThenElse cond thens elses) = "if ("
231+statementToJs (If ifst) = ifStatementToJs ifst
232+statementToJs (Return value) = "return " ++ valueToJs value
233+
234+ifStatementToJs :: IfStatement -> String
235+ifStatementToJs (IfStatement cond thens elst) =
236+ "if ("
232237 ++ valueToJs cond ++ ") {"
233238 ++ intercalate ";" (map statementToJs thens) ++ "}"
234− ++ flip (maybe "") elses (\sts ->
235− " else {" ++ intercalate ";" (map statementToJs sts) ++ "}")
236−statementToJs (Return value) = "return " ++ valueToJs value
239+ ++ maybe "" elseStatementToJs elst
240+
241+elseStatementToJs :: ElseStatement -> String
242+elseStatementToJs (Else sts) = " else {" ++ intercalate ";" (map statementToJs sts) ++ "}"
243+elseStatementToJs (ElseIf ifst) = " else " ++ ifStatementToJs ifst
237244
238245assignmentTargetToJs :: AssignmentTarget -> String
239246assignmentTargetToJs (AssignVariable ident) = identToJs ident
src/PureScript/Parser.hs+2
@@ -13,11 +13,13 @@
1313-----------------------------------------------------------------------------
1414
1515module PureScript.Parser (
16+ module PureScript.Parser.Common,
1617 module PureScript.Parser.Types,
1718 module PureScript.Parser.Values,
1819 module PureScript.Parser.Declarations
1920) where
2021
22+import PureScript.Parser.Common
2123import PureScript.Parser.Types
2224import PureScript.Parser.Values
2325import PureScript.Parser.Declarations
src/PureScript/Parser/Common.hs+83−114
@@ -12,12 +12,17 @@
1212--
1313-----------------------------------------------------------------------------
1414
15+{-# LANGUAGE FlexibleContexts #-}
16+
1517module PureScript.Parser.Common where
1618
19+import Data.Char (isSpace)
1720import Control.Applicative
1821import Control.Monad
22+import Control.Monad.State
1923import qualified Text.Parsec as P
20−import qualified Text.Parsec.Indent as I
24+import qualified Text.Parsec.Pos as P
25+import qualified Text.Parsec.Token as PT
2126
2227import PureScript.Names
2328
@@ -26,6 +31,7 @@ reservedNames = [ "case"
2631 , "data"
2732 , "type"
2833 , "var"
34+ , "val"
2935 , "while"
3036 , "for"
3137 , "if"
@@ -35,134 +41,73 @@ reservedNames = [ "case"
3541 , "true"
3642 , "false"
3743 , "extern"
38− , "forall" ]
44+ , "forall"
45+ , "do" ]
3946
4047reservedOpNames :: [String]
4148reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
4249 , "==", "!=", "&", "^", "|", "&&", "||" ]
4350
44−identStart :: I.IndentParser String u Char
51+identStart :: P.Parsec String u Char
4552identStart = P.lower <|> P.oneOf "_$"
4653
47−properNameStart :: I.IndentParser String u Char
54+properNameStart :: P.Parsec String u Char
4855properNameStart = P.upper
4956
50−identLetter :: I.IndentParser String u Char
57+identLetter :: P.Parsec String u Char
5158identLetter = P.alphaNum <|> P.oneOf "_'"
5259
53−opStart :: I.IndentParser String u Char
54−opStart = P.oneOf ":!#$%&*+/<=>?@^|-~"
60+opStart :: P.Parsec String u Char
61+opStart = P.oneOf "!#$%&*+/<=>?@^|-~"
5562
56−opLetter :: I.IndentParser String u Char
63+opLetter :: P.Parsec String u Char
5764opLetter = P.oneOf ":#$%&*+./<=>?@^|"
5865
59−whiteSpace :: I.IndentParser String u ()
60−whiteSpace = P.skipMany $ P.choice
61− [ P.oneOf " \t" >> return ()
62− , P.try $ P.skipMany1 (P.oneOf " \t\r\n") >> I.indented
63− , P.try lineComment
64− , P.try blockComment ]
65−
66−unindentedBlock :: I.IndentParser String u a -> I.IndentParser String u [a]
67−unindentedBlock p = I.block $ I.withPos (p <* P.skipMany (P.oneOf "\r\n"))
68−
69−indentedBlock :: I.IndentParser String u a -> I.IndentParser String u [a]
70−indentedBlock p = I.block $ I.withPos (p <* P.skipMany (P.oneOf " \t\r\n"))
71−
72−lineComment :: I.IndentParser String u ()
73−lineComment = do
74− P.string "--"
75− P.skipMany $ P.satisfy (/= '\n')
76− return ()
77−
78−blockComment :: I.IndentParser String u ()
79−blockComment = do
80− P.string "{--"
81− P.manyTill P.anyChar $ P.try $ P.string "--}"
82− return ()
83−
84−lexeme :: I.IndentParser String u a -> I.IndentParser String u a
85−lexeme p = p <* whiteSpace
86−
87−identifier :: I.IndentParser String u String
88−identifier = lexeme $ do
89− name <- (:) <$> identStart <*> P.many identLetter
90− when (name `elem` reservedNames) $ P.unexpected ("reserved word " ++ show name)
91− return name
92−
93−properName :: I.IndentParser String u String
94−properName = lexeme $ do
95− (:) <$> properNameStart <*> many identLetter P.<?> "name"
96−
97−reserved :: String -> I.IndentParser String u String
98−reserved name = lexeme $ P.string name <* P.notFollowedBy identLetter
99−
100−reservedOp :: String -> I.IndentParser String u String
101−reservedOp name = lexeme $ P.string name <* P.notFollowedBy opLetter
102−
103−operator :: I.IndentParser String u String
104−operator = lexeme $ do
105− name <- (:) <$> opStart <*> P.many opLetter
106− when (name `elem` reservedOpNames) $ P.unexpected ("reserved operator " ++ show name)
107− return name
108−
109−stringLiteral :: I.IndentParser String u String
110−stringLiteral = lexeme $ P.between (P.char '"') (P.char '"') (P.many (P.noneOf "\""))
111−
112−number :: I.IndentParser String u String
113−number = do
114− intPart <- P.many1 P.digit
115− fracPart <- P.option "" $ (:) <$> P.char '.' <*> P.many1 P.digit
116− expPart <- P.option "" $ (:) <$> P.oneOf "eE" <*> P.many1 P.digit
117− return $ intPart ++ fracPart ++ expPart
118−
119−signedNumber :: I.IndentParser String u String
120−signedNumber = do
121− s <- P.optionMaybe $ P.oneOf "-+"
122− n <- number
123− return $ maybe id (:) s n
124−
125−unsignedNumber :: I.IndentParser String u String
126−unsignedNumber = lexeme number
127−
128−semi :: I.IndentParser String u Char
129−semi = lexeme $ P.char ';'
130−
131−comma :: I.IndentParser String u Char
132−comma = lexeme $ P.char ','
133−
134−colon :: I.IndentParser String u Char
135−colon = lexeme $ P.char ':'
136−
137−dot :: I.IndentParser String u Char
138−dot = lexeme $ P.char '.'
139−
140−tick :: I.IndentParser String u Char
66+langDef = PT.LanguageDef
67+ { PT.reservedNames = reservedNames
68+ , PT.reservedOpNames = reservedOpNames
69+ , PT.commentStart = "{-"
70+ , PT.commentEnd = "-}"
71+ , PT.commentLine = "--"
72+ , PT.nestedComments = True
73+ , PT.identStart = identStart
74+ , PT.identLetter = identLetter
75+ , PT.opStart = opStart
76+ , PT.opLetter = opLetter
77+ , PT.caseSensitive = True
78+ }
79+
80+tokenParser = PT.makeTokenParser langDef
81+
82+lexeme = PT.lexeme tokenParser
83+identifier = PT.identifier tokenParser
84+reserved = PT.reserved tokenParser
85+reservedOp = PT.reservedOp tokenParser
86+operator = PT.operator tokenParser
87+stringLiteral = PT.stringLiteral tokenParser
88+whiteSpace = PT.whiteSpace tokenParser
89+parens = PT.parens tokenParser
90+braces = PT.braces tokenParser
91+angles = PT.angles tokenParser
92+squares = PT.squares tokenParser
93+semi = PT.semi tokenParser
94+comma = PT.comma tokenParser
95+colon = PT.colon tokenParser
96+dot = PT.dot tokenParser
97+semiSep = PT.semiSep tokenParser
98+semiSep1 = PT.semiSep1 tokenParser
99+commaSep = PT.commaSep tokenParser
100+commaSep1 = PT.commaSep1 tokenParser
101+
102+tick :: P.Parsec String u Char
141103tick = lexeme $ P.char '`'
142104
143−semiSep :: I.IndentParser String u a -> I.IndentParser String u [a]
144−semiSep p = P.sepBy p semi
145−
146−semiSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
147−semiSep1 p = P.sepBy1 p semi
105+properName :: P.Parsec String u String
106+properName = lexeme $ P.try ((:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name")
148107
149−commaSep :: I.IndentParser String u a -> I.IndentParser String u [a]
150−commaSep p = P.sepBy p comma
151−
152−commaSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
153−commaSep1 p = P.sepBy1 p comma
154−
155−parens :: I.IndentParser String u a -> I.IndentParser String u a
156−parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
157−
158−braces :: I.IndentParser String u a -> I.IndentParser String u a
159−braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
160−
161−angles :: I.IndentParser String u a -> I.IndentParser String u a
162−angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
163−
164−squares :: I.IndentParser String u a -> I.IndentParser String u a
165−squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
108+integerOrFloat :: P.Parsec String u (Either Integer Double)
109+integerOrFloat = Left <$> P.try (PT.integer tokenParser) <|>
110+ Right <$> P.try (PT.float tokenParser)
166111
167112augment :: 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
168113augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
@@ -173,8 +118,32 @@ fold first more combine = do
173118 bs <- P.many more
174119 return $ foldl combine a bs
175120
176−parseIdent :: I.IndentParser String () Ident
121+parseIdent :: P.Parsec String u Ident
177122parseIdent = (Ident <$> identifier) <|> (Op <$> parens operator)
178123
179−parseIdentInfix :: I.IndentParser String () Ident
124+parseIdentInfix :: P.Parsec String u Ident
180125parseIdentInfix = (Ident <$> P.between tick tick identifier) <|> (Op <$> operator)
126+
127+mark :: P.Parsec String P.Column a -> P.Parsec String P.Column a
128+mark p = do
129+ current <- P.getState
130+ pos <- P.sourceColumn <$> P.getPosition
131+ P.putState pos
132+ a <- p
133+ P.putState current
134+ return a
135+
136+checkIndentation :: (P.Column -> P.Column -> Bool) -> P.Parsec String P.Column ()
137+checkIndentation rel = (do
138+ col <- P.sourceColumn <$> P.getPosition
139+ current <- P.getState
140+ guard $ col `rel` current) <|> P.parserFail "Indentation check"
141+
142+indented :: P.Parsec String P.Column ()
143+indented = checkIndentation (>)
144+
145+same :: P.Parsec String P.Column ()
146+same = checkIndentation (==)
147+
148+runIndentParser :: P.Column -> P.Parsec String P.Column a -> String -> Either P.ParseError a
149+runIndentParser col p = P.runParser p 0 ""
src/PureScript/Parser/Declarations.hs+25−21
@@ -26,7 +26,6 @@ import Control.Arrow (Arrow(..))
2626import Control.Monad.State
2727import qualified Text.Parsec as P
2828import qualified Text.Parsec.Pos as P
29−import qualified Text.Parsec.Indent as I
3029
3130import PureScript.Values
3231import PureScript.Types
@@ -35,28 +34,37 @@ import PureScript.Declarations
3534import PureScript.Parser.Values
3635import PureScript.Parser.Types
3736
38−parseDataDeclaration :: I.IndentParser String () Declaration
37+parseDataDeclaration :: P.Parsec String P.Column Declaration
3938parseDataDeclaration = do
4039 reserved "data"
41− name <- properName
42− tyArgs <- many identifier
43− lexeme $ P.char '='
44− ctors <- P.sepBy1 ((,) <$> properName <*> P.optionMaybe parseType) (lexeme $ P.char '|')
40+ name <- indented *> properName
41+ tyArgs <- many (indented *> identifier)
42+ lexeme $ indented *> P.char '='
43+ ctors <- P.sepBy1 ((,) <$> (indented *> properName) <*> P.optionMaybe parseType) (lexeme $ indented *> P.char '|')
4544 return $ DataDeclaration name tyArgs ctors
4645
47−parseTypeDeclaration :: I.IndentParser String () Declaration
48−parseTypeDeclaration = TypeDeclaration <$> parseIdent <*> (lexeme (P.string "::") *> parsePolyType)
46+parseTypeDeclaration :: P.Parsec String P.Column Declaration
47+parseTypeDeclaration =
48+ TypeDeclaration <$> parseIdent
49+ <*> (lexeme (indented *> P.string "::") *> parsePolyType)
4950
50−parseTypeSynonymDeclaration :: I.IndentParser String () Declaration
51−parseTypeSynonymDeclaration = TypeSynonymDeclaration <$> (reserved "type" *> properName) <*> many identifier <*> (lexeme (P.char '=') *> parseType)
51+parseTypeSynonymDeclaration :: P.Parsec String P.Column Declaration
52+parseTypeSynonymDeclaration =
53+ TypeSynonymDeclaration <$> (reserved "type" *> indented *> properName)
54+ <*> many (indented *> identifier)
55+ <*> (lexeme (indented *> P.char '=') *> parseType)
5256
53−parseValueDeclaration :: I.IndentParser String () Declaration
54−parseValueDeclaration = ValueDeclaration <$> parseIdent <*> (lexeme (P.char '=') *> parseValue)
57+parseValueDeclaration :: P.Parsec String P.Column Declaration
58+parseValueDeclaration =
59+ ValueDeclaration <$> parseIdent
60+ <*> (lexeme (indented *> P.char '=') *> parseValue)
5561
56−parseExternDeclaration :: I.IndentParser String () Declaration
57−parseExternDeclaration = ExternDeclaration <$> (reserved "extern" *> parseIdent) <*> (lexeme (P.string "::") *> parsePolyType)
62+parseExternDeclaration :: P.Parsec String P.Column Declaration
63+parseExternDeclaration =
64+ ExternDeclaration <$> (reserved "extern" *> indented *> parseIdent)
65+ <*> (lexeme (indented *> P.string "::") *> parsePolyType)
5866
59−parseDeclaration :: I.IndentParser String () Declaration
67+parseDeclaration :: P.Parsec String P.Column Declaration
6068parseDeclaration = P.choice $ map P.try
6169 [ parseDataDeclaration
6270 , parseTypeDeclaration
@@ -64,9 +72,5 @@ parseDeclaration = P.choice $ map P.try
6472 , parseValueDeclaration
6573 , parseExternDeclaration ]
6674
67−parseManyDeclarations :: I.IndentParser String () [Declaration]
68−parseManyDeclarations = I.withPos $ unindentedBlock parseDeclaration
69−
70−parseDeclarations :: String -> Either P.ParseError [Declaration]
71−parseDeclarations = flip evalState (P.initialPos "Declarations") . P.runPT (parseManyDeclarations <* P.eof) () "Declarations"
72−
75+parseDeclarations :: P.Parsec String P.Column [Declaration]
76+parseDeclarations = whiteSpace *> mark (same *> P.many parseDeclaration) <* P.eof
src/PureScript/Parser/Types.hs+20−21
@@ -22,39 +22,38 @@ import PureScript.Types
2222import PureScript.Parser.Common
2323import Control.Applicative
2424import qualified Text.Parsec as P
25−import qualified Text.Parsec.Indent as I
2625import Control.Arrow (Arrow(..))
2726
28−parseNumber :: I.IndentParser String () Type
27+parseNumber :: P.Parsec String P.Column Type
2928parseNumber = const Number <$> P.string "Number"
3029
31−parseString :: I.IndentParser String () Type
30+parseString :: P.Parsec String P.Column Type
3231parseString = const String <$> P.string "String"
3332
34−parseBoolean :: I.IndentParser String () Type
33+parseBoolean :: P.Parsec String P.Column Type
3534parseBoolean = const Boolean <$> P.string "Boolean"
3635
37−parseArray :: I.IndentParser String () Type
36+parseArray :: P.Parsec String P.Column Type
3837parseArray = squares $ Array <$> parseType
3938
40−parseObject :: I.IndentParser String () Type
39+parseObject :: P.Parsec String P.Column Type
4140parseObject = braces $ Object <$> parseRow
4241
43−parseFunction :: I.IndentParser String () Type
42+parseFunction :: P.Parsec String P.Column Type
4443parseFunction = do
4544 args <- lexeme $ parens $ commaSep parseType
4645 lexeme $ P.string "->"
4746 resultType <- parseType
4847 return $ Function args resultType
4948
50−parseTypeVariable :: I.IndentParser String () Type
49+parseTypeVariable :: P.Parsec String P.Column Type
5150parseTypeVariable = TypeVar <$> identifier
5251
53−parseTypeConstructor :: I.IndentParser String () Type
52+parseTypeConstructor :: P.Parsec String P.Column Type
5453parseTypeConstructor = TypeConstructor <$> properName
5554
56−parseTypeAtom :: I.IndentParser String () Type
57−parseTypeAtom = P.choice $ map P.try
55+parseTypeAtom :: P.Parsec String P.Column Type
56+parseTypeAtom = indented *> P.choice (map P.try
5857 [ parseNumber
5958 , parseString
6059 , parseBoolean
@@ -63,23 +62,23 @@ parseTypeAtom = P.choice $ map P.try
6362 , parseFunction
6463 , parseTypeVariable
6564 , parseTypeConstructor
66− , parens parseType ]
65+ , parens parseType ])
6766
68−parsePolyType :: I.IndentParser String () PolyType
69−parsePolyType = PolyType <$> (P.option [] (reserved "forall" *> many identifier <* dot))
67+parsePolyType :: P.Parsec String P.Column PolyType
68+parsePolyType = PolyType <$> (P.option [] (indented *> reserved "forall" *> many (indented *> identifier) <* indented <* dot))
7069 <*> parseType
7170
72−parseType :: I.IndentParser String () Type
71+parseType :: P.Parsec String P.Column Type
7372parseType = fold (lexeme parseTypeAtom) (lexeme parseTypeAtom) TypeApp
7473
75−parseNameAndType :: I.IndentParser String () (String, Type)
76−parseNameAndType = (,) <$> (identifier <* lexeme (P.string "::")) <*> parseType
74+parseNameAndType :: P.Parsec String P.Column (String, Type)
75+parseNameAndType = (,) <$> (indented *> identifier <* indented <* lexeme (P.string "::")) <*> parseType
7776
78−parseRowEnding :: I.IndentParser String () Row
79−parseRowEnding = P.option REmpty (RowVar <$> (lexeme (P.char '|') *> identifier))
77+parseRowEnding :: P.Parsec String P.Column Row
78+parseRowEnding = P.option REmpty (RowVar <$> (lexeme (indented *> P.char '|') *> indented *> identifier))
8079
81−parseRow :: I.IndentParser String () Row
82−parseRow = fromList <$> semiSep parseNameAndType <*> parseRowEnding
80+parseRow :: P.Parsec String P.Column Row
81+parseRow = fromList <$> (parseNameAndType `P.sepBy` (indented *> semi)) <*> parseRowEnding
8382 where
8483 fromList :: [(String, Type)] -> Row -> Row
8584 fromList [] r = r
src/PureScript/Parser/Values.hs+119−117
@@ -21,68 +21,67 @@ import PureScript.Values
2121import qualified PureScript.Parser.Common as C
2222import Control.Applicative
2323import qualified Text.Parsec as P
24−import qualified Text.Parsec.Indent as I
2524import Text.Parsec.Expr
2625import Control.Monad
2726import Control.Arrow (Arrow(..))
2827import PureScript.Parser.Types
2928import PureScript.Types
3029
31−booleanLiteral :: I.IndentParser String () Bool
30+booleanLiteral :: P.Parsec String P.Column Bool
3231booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
3332
34−parseNumericLiteral :: I.IndentParser String () Value
35−parseNumericLiteral = NumericLiteral <$> C.signedNumber
33+parseNumericLiteral :: P.Parsec String P.Column Value
34+parseNumericLiteral = NumericLiteral <$> C.integerOrFloat
3635
37−parseStringLiteral :: I.IndentParser String () Value
36+parseStringLiteral :: P.Parsec String P.Column Value
3837parseStringLiteral = StringLiteral <$> C.stringLiteral
3938
40−parseBooleanLiteral :: I.IndentParser String () Value
39+parseBooleanLiteral :: P.Parsec String P.Column Value
4140parseBooleanLiteral = BooleanLiteral <$> booleanLiteral
4241
43−parseArrayLiteral :: I.IndentParser String () Value
44−parseArrayLiteral = ArrayLiteral <$> (C.squares $ C.commaSep parseValue)
42+parseArrayLiteral :: P.Parsec String P.Column Value
43+parseArrayLiteral = ArrayLiteral <$> (C.squares $ parseValue `P.sepBy` (C.indented *> C.comma))
4544
46−parseObjectLiteral :: I.IndentParser String () Value
47−parseObjectLiteral = ObjectLiteral <$> (C.braces $ C.commaSep parseIdentifierAndValue)
45+parseObjectLiteral :: P.Parsec String P.Column Value
46+parseObjectLiteral = ObjectLiteral <$> (C.braces $ parseIdentifierAndValue `P.sepBy` (C.indented *> C.comma))
4847
49−parseIdentifierAndValue :: I.IndentParser String () (String, Value)
50−parseIdentifierAndValue = do
51− name <- C.lexeme C.identifier
52− C.colon
53− value <- parseValue
54− return (name, value)
48+parseIdentifierAndValue :: P.Parsec String P.Column (String, Value)
49+parseIdentifierAndValue = (,) <$> (C.indented *> C.identifier <* C.indented <* C.colon)
50+ <*> (C.indented *> parseValue)
5551
56−parseAbs :: I.IndentParser String () Value
52+parseAbs :: P.Parsec String P.Column Value
5753parseAbs = do
5854 C.lexeme $ P.char '\\'
59− args <- C.commaSep C.parseIdent
60− C.lexeme $ P.string "->"
55+ args <- (C.indented *> C.parseIdent) `P.sepBy` (C.indented *> C.comma)
56+ C.lexeme $ C.indented *> P.string "->"
6157 value <- parseValue
6258 return $ Abs args value
6359
64−parseApp :: I.IndentParser String () Value
60+parseApp :: P.Parsec String P.Column Value
6561parseApp = App <$> parseValue
66− <*> (C.parens $ C.commaSep parseValue)
62+ <*> (C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma)))
6763
68−parseVar :: I.IndentParser String () Value
64+parseVar :: P.Parsec String P.Column Value
6965parseVar = Var <$> C.parseIdent
7066
71−parseConstructor :: I.IndentParser String () Value
67+parseConstructor :: P.Parsec String P.Column Value
7268parseConstructor = Constructor <$> C.properName
7369
74−parseCase :: I.IndentParser String () Value
75−parseCase = Case <$> P.between (C.reserved "case") (C.reserved "of") parseValue
76− <*> I.withPos (C.indentedBlock parseCaseAlternative)
70+parseCase :: P.Parsec String P.Column Value
71+parseCase = Case <$> (P.between (C.reserved "case") (C.indented *> C.reserved "of") parseValue)
72+ <*> (C.indented *> C.mark (P.many (C.same *> C.mark parseCaseAlternative)))
7773
78−parseCaseAlternative :: I.IndentParser String () (Binder, Value)
74+parseCaseAlternative :: P.Parsec String P.Column (Binder, Value)
7975parseCaseAlternative = (,) <$> (parseBinder <* C.lexeme (P.string "->")) <*> parseValue
8076
81−parseBlock :: I.IndentParser String () Value
82−parseBlock = Block <$> (C.braces $ I.withPos $ C.indentedBlock $ parseStatement True)
77+parseBlock :: P.Parsec String P.Column Value
78+parseBlock = Block <$> (C.reserved "do" *> parseManyStatements)
8379
84−parseValueAtom :: I.IndentParser String () Value
85−parseValueAtom = P.choice $ map P.try
80+parseManyStatements :: P.Parsec String P.Column [Statement]
81+parseManyStatements = C.indented *> (C.mark $ P.many $ C.same *> C.mark parseStatement)
82+
83+parseValueAtom :: P.Parsec String P.Column Value
84+parseValueAtom = C.indented *> P.choice (map P.try
8685 [ parseNumericLiteral
8786 , parseStringLiteral
8887 , parseBooleanLiteral
@@ -93,125 +92,128 @@ parseValueAtom = P.choice $ map P.try
9392 , parseConstructor
9493 , parseBlock
9594 , parseCase
96− , C.parens parseValue ]
95+ , C.parens parseValue ])
9796
98−parseValue :: I.IndentParser String () Value
97+parseValue :: P.Parsec String P.Column Value
9998parseValue = buildExpressionParser operators $ C.fold (C.lexeme typedValue) (C.lexeme funArgs) App
10099 where
101100 typedValue = C.augment parseValueAtom parseTypeAnnotation TypedValue
102− funArgs = C.parens $ C.commaSep parseValue
103− parseTypeAnnotation = C.lexeme (P.string "::") *> parsePolyType
104− operators = [ [ Postfix $ Accessor <$> (C.dot *> C.identifier)
105− , Postfix $ Indexer <$> C.squares parseValue ]
106− , [ Prefix $ C.lexeme (P.try $ C.reservedOp "!") >> return (Unary Not)
107− , Prefix $ C.lexeme (P.try $ C.reservedOp "~") >> return (Unary BitwiseNot)
108− , Prefix $ C.lexeme (P.try $ C.reservedOp "-") >> return (Unary Negate) ]
109− , [ Infix (C.lexeme (P.try C.parseIdentInfix >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocRight ]
110− , [ Infix (C.lexeme (P.try $ C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
111− , Infix (C.lexeme (P.try $ C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
112− , [ Infix (C.lexeme (P.try $ C.reservedOp "<") >> return (Binary LessThan)) AssocRight
113− , Infix (C.lexeme (P.try $ C.reservedOp ">") >> return (Binary GreaterThan)) AssocRight ]
114− , [ Infix (C.lexeme (P.try $ C.reservedOp "*") >> return (Binary Multiply)) AssocRight
115− , Infix (C.lexeme (P.try $ C.reservedOp "/") >> return (Binary Divide)) AssocRight
116− , Infix (C.lexeme (P.try $ C.reservedOp "%") >> return (Binary Modulus)) AssocRight ]
117− , [ Infix (C.lexeme (P.try $ C.reservedOp "++") >> return (Binary Concat)) AssocRight
118− , Infix (C.lexeme (P.try $ C.reservedOp "+") >> return (Binary Add)) AssocRight
119− , Infix (C.lexeme (P.try $ C.reservedOp "-") >> return (Binary Subtract)) AssocRight ]
120− , [ Infix (C.lexeme (P.try $ C.reservedOp "<<") >> return (Binary ShiftLeft)) AssocRight
121− , Infix (C.lexeme (P.try $ C.reservedOp ">>>") >> return (Binary ZeroFillShiftRight)) AssocRight
122− , Infix (C.lexeme (P.try $ C.reservedOp ">>") >> return (Binary ShiftRight)) AssocRight ]
123− , [ Infix (C.lexeme (P.try $ C.reservedOp "==") >> return (Binary EqualTo)) AssocRight
124− , Infix (C.lexeme (P.try $ C.reservedOp "!=") >> return (Binary NotEqualTo)) AssocRight ]
125− , [ Infix (C.lexeme (P.try $ C.reservedOp "&") >> return (Binary BitwiseAnd)) AssocRight ]
126− , [ Infix (C.lexeme (P.try $ C.reservedOp "^") >> return (Binary BitwiseXor)) AssocRight ]
127− , [ Infix (C.lexeme (P.try $ C.reservedOp "|") >> return (Binary BitwiseOr)) AssocRight ]
128− , [ Infix (C.lexeme (P.try $ C.reservedOp "&&") >> return (Binary And)) AssocRight ]
129− , [ Infix (C.lexeme (P.try $ C.reservedOp "||") >> return (Binary Or)) AssocRight ]
101+ funArgs = C.indented *> C.parens (parseValue `P.sepBy` (C.indented *> C.comma))
102+ parseTypeAnnotation = P.try $ C.lexeme (C.indented *> P.string "::") *> parsePolyType
103+ operators = [ [ Postfix $ Accessor <$> (C.indented *> C.dot *> C.indented *> C.identifier)
104+ , Postfix $ Indexer <$> (C.indented *> C.squares parseValue) ]
105+ , [ Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "!") >> return (Unary Not)
106+ , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "~") >> return (Unary BitwiseNot)
107+ , Prefix $ C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Unary Negate) ]
108+ , [ Infix (C.lexeme (P.try (C.indented *> C.parseIdentInfix) >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocRight ]
109+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
110+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
111+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<") >> return (Binary LessThan)) AssocRight
112+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">") >> return (Binary GreaterThan)) AssocRight ]
113+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "*") >> return (Binary Multiply)) AssocRight
114+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "/") >> return (Binary Divide)) AssocRight
115+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "%") >> return (Binary Modulus)) AssocRight ]
116+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "++") >> return (Binary Concat)) AssocRight
117+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "+") >> return (Binary Add)) AssocRight
118+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "-") >> return (Binary Subtract)) AssocRight ]
119+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "<<") >> return (Binary ShiftLeft)) AssocRight
120+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">>>") >> return (Binary ZeroFillShiftRight)) AssocRight
121+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp ">>") >> return (Binary ShiftRight)) AssocRight ]
122+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "==") >> return (Binary EqualTo)) AssocRight
123+ , Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "!=") >> return (Binary NotEqualTo)) AssocRight ]
124+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "&") >> return (Binary BitwiseAnd)) AssocRight ]
125+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "^") >> return (Binary BitwiseXor)) AssocRight ]
126+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "|") >> return (Binary BitwiseOr)) AssocRight ]
127+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "&&") >> return (Binary And)) AssocRight ]
128+ , [ Infix (C.lexeme (P.try $ C.indented *> C.reservedOp "||") >> return (Binary Or)) AssocRight ]
130129 ]
131130
132−parseVariableIntroduction :: Bool -> I.IndentParser String () Statement
133−parseVariableIntroduction requireSemi = do
131+parseVariableIntroduction :: P.Parsec String P.Column Statement
132+parseVariableIntroduction = do
134133 C.reserved "var"
135− name <- C.parseIdent
136− C.lexeme $ P.char '='
134+ name <- C.indented *> C.parseIdent
135+ C.lexeme $ C.indented *> P.char '='
137136 value <- parseValue
138− when requireSemi (void C.semi)
139137 return $ VariableIntroduction name value
140138
141−parseAssignment :: Bool -> I.IndentParser String () (Statement)
142−parseAssignment requireSemi = do
139+parseAssignment :: P.Parsec String P.Column Statement
140+parseAssignment = do
143141 tgt <- parseAssignmentTarget
144− C.lexeme $ P.char '='
142+ C.lexeme $ C.indented *> P.char '='
145143 value <- parseValue
146− when requireSemi (void C.semi)
147144 return $ Assignment tgt value
148145
149−parseManyStatements :: I.IndentParser String () [Statement]
150−parseManyStatements = C.braces $ I.withPos $ C.indentedBlock $ parseStatement True
151−
152−parseWhile :: I.IndentParser String () Statement
153−parseWhile = While <$> (C.reserved "while" *> C.parens parseValue)
146+parseWhile :: P.Parsec String P.Column Statement
147+parseWhile = While <$> (C.reserved "while" *> C.indented *> parseValue <* C.indented <* C.colon)
154148 <*> parseManyStatements
155149
156−parseFor :: I.IndentParser String () Statement
157−parseFor = For <$> (C.reserved "for" *> C.parens forIntro)
150+parseFor :: P.Parsec String P.Column Statement
151+parseFor = For <$> (C.reserved "for" *> C.indented *> C.parens forIntro <* C.indented <* C.colon)
158152 <*> parseManyStatements
159153 where
160− forIntro = (,,) <$> parseStatement False
161− <*> (C.semi *> parseValue)
162− <*> (C.semi *> parseStatement False)
163−
164−parseIfThenElse :: I.IndentParser String () Statement
165−parseIfThenElse = IfThenElse
166− <$> (C.reserved "if" *> C.parens parseValue)
167− <*> parseManyStatements
168− <*> P.optionMaybe (C.reserved "else" *> parseManyStatements)
169−
170−parseReturn :: Bool -> I.IndentParser String () Statement
171−parseReturn requireSemi = Return <$> (C.reserved "return" *> parseValue <* when requireSemi (void C.semi))
172−
173−parseStatement :: Bool -> I.IndentParser String () Statement
174−parseStatement requireSemi = P.choice $ map P.try
175− [ parseVariableIntroduction requireSemi
176− , parseAssignment requireSemi
154+ forIntro = (,,) <$> (C.indented *> parseStatement)
155+ <*> (C.indented *> C.semi *> C.indented *> parseValue)
156+ <*> (C.indented *> C.semi *> C.indented *> parseStatement)
157+
158+parseIf :: P.Parsec String P.Column Statement
159+parseIf = If <$> parseIfStatement
160+
161+parseIfStatement :: P.Parsec String P.Column IfStatement
162+parseIfStatement =
163+ IfStatement <$> (C.reserved "if" *> C.indented *> parseValue <* C.indented <* C.colon)
164+ <*> parseManyStatements
165+ <*> P.optionMaybe (C.same *> parseElseStatement)
166+
167+parseElseStatement :: P.Parsec String P.Column ElseStatement
168+parseElseStatement = C.reserved "else" >> (ElseIf <$> (C.indented *> parseIfStatement)
169+ <|> Else <$> (C.indented *> C.colon *> parseManyStatements))
170+
171+parseReturn :: P.Parsec String P.Column Statement
172+parseReturn = Return <$> (C.reserved "return" *> parseValue)
173+
174+parseStatement :: P.Parsec String P.Column Statement
175+parseStatement = P.choice (map P.try
176+ [ parseVariableIntroduction
177+ , parseAssignment
177178 , parseWhile
178179 , parseFor
179− , parseIfThenElse
180− , parseReturn requireSemi ]
180+ , parseIf
181+ , parseReturn ])
181182
182−parseStringBinder :: I.IndentParser String () Binder
183+parseStringBinder :: P.Parsec String P.Column Binder
183184parseStringBinder = StringBinder <$> C.stringLiteral
184185
185−parseBooleanBinder :: I.IndentParser String () Binder
186+parseBooleanBinder :: P.Parsec String P.Column Binder
186187parseBooleanBinder = BooleanBinder <$> booleanLiteral
187188
188−parseNumberBinder :: I.IndentParser String () Binder
189−parseNumberBinder = NumberBinder <$> C.signedNumber
189+parseNumberBinder :: P.Parsec String P.Column Binder
190+parseNumberBinder = NumberBinder <$> C.integerOrFloat
190191
191−parseVarBinder :: I.IndentParser String () Binder
192+parseVarBinder :: P.Parsec String P.Column Binder
192193parseVarBinder = VarBinder <$> C.parseIdent
193194
194−parseNullaryBinder :: I.IndentParser String () Binder
195+parseNullaryBinder :: P.Parsec String P.Column Binder
195196parseNullaryBinder = NullaryBinder <$> C.lexeme C.properName
196197
197−parseUnaryBinder :: I.IndentParser String () Binder
198−parseUnaryBinder = UnaryBinder <$> C.lexeme C.properName <*> parseBinder
198+parseUnaryBinder :: P.Parsec String P.Column Binder
199+parseUnaryBinder = UnaryBinder <$> C.lexeme C.properName <*> (C.indented *> parseBinder)
199200
200−parseObjectBinder :: I.IndentParser String () Binder
201−parseObjectBinder = ObjectBinder <$> C.braces (C.commaSep parseIdentifierAndBinder)
201+parseObjectBinder :: P.Parsec String P.Column Binder
202+parseObjectBinder = ObjectBinder <$> C.braces ((C.indented *> parseIdentifierAndBinder) `P.sepBy` (C.indented *> C.comma))
202203
203−parseArrayBinder :: I.IndentParser String () Binder
204−parseArrayBinder = C.squares $ ArrayBinder <$> (C.commaSep parseBinder) <*> P.optionMaybe (C.colon *> parseBinder)
204+parseArrayBinder :: P.Parsec String P.Column Binder
205+parseArrayBinder = C.squares $ ArrayBinder <$> ((C.indented *> parseBinder) `P.sepBy` (C.indented *> C.comma))
206+ <*> P.optionMaybe (C.indented *> C.colon *> C.indented *> parseBinder)
205207
206−parseIdentifierAndBinder :: I.IndentParser String () (String, Binder)
208+parseIdentifierAndBinder :: P.Parsec String P.Column (String, Binder)
207209parseIdentifierAndBinder = do
208210 name <- C.lexeme C.identifier
209− C.lexeme $ P.char '='
210− binder <- parseBinder
211+ C.lexeme $ C.indented *> P.char '='
212+ binder <- C.indented *> parseBinder
211213 return (name, binder)
212214
213−parseBinder :: I.IndentParser String () Binder
214−parseBinder = P.choice $ map P.try
215+parseBinder :: P.Parsec String P.Column Binder
216+parseBinder = P.choice (map P.try
215217 [ parseStringBinder
216218 , parseBooleanBinder
217219 , parseNumberBinder
@@ -220,10 +222,10 @@ parseBinder = P.choice $ map P.try
220222 , parseNullaryBinder
221223 , parseObjectBinder
222224 , parseArrayBinder
223− , C.parens parseBinder ]
225+ , C.parens parseBinder ])
224226
225−parseAssignmentTarget :: I.IndentParser String () AssignmentTarget
227+parseAssignmentTarget :: P.Parsec String P.Column AssignmentTarget
226228parseAssignmentTarget = buildExpressionParser operators (AssignVariable <$> C.parseIdent)
227229 where
228− operators = [ [ Postfix $ AssignArrayIndex <$> C.squares parseValue
229− , Postfix $ AssignObjectProperty <$> (C.dot *> C.identifier) ] ]
230+ operators = [ [ Postfix $ AssignArrayIndex <$> (C.indented *> C.squares parseValue)
231+ , Postfix $ AssignObjectProperty <$> (C.indented *> C.dot *> C.indented *> C.identifier) ] ]
src/PureScript/TypeChecker/Types.hs+22−9
@@ -383,15 +383,9 @@ typeConstraintsForStatement m mass ret (While val inner) = do
383383 (cs1, n1) <- typeConstraints m val
384384 (cs2, allCodePathsReturn, _) <- typeConstraintsForBlock m mass ret inner
385385 return $ ((TypeConstraint n1 Boolean) : cs1 ++ cs2, allCodePathsReturn, mass)
386−typeConstraintsForStatement m mass ret (IfThenElse val thens Nothing) = do
387− (cs1, n1) <- typeConstraints m val
388− (cs2, allCodePathsReturn, _) <- typeConstraintsForBlock m mass ret thens
389− return $ ((TypeConstraint n1 Boolean) : cs1 ++ cs2, allCodePathsReturn, mass)
390−typeConstraintsForStatement m mass ret (IfThenElse val thens (Just elses)) = do
391− (cs1, n1) <- typeConstraints m val
392− (cs2, allCodePathsReturn1, _) <- typeConstraintsForBlock m mass ret thens
393− (cs3, allCodePathsReturn2, _) <- typeConstraintsForBlock m mass ret elses
394− return $ ((TypeConstraint n1 Boolean) : cs1 ++ cs2 ++ cs3, allCodePathsReturn1 && allCodePathsReturn2, mass)
386+typeConstraintsForStatement m mass ret (If ifst) = do
387+ (cs, allCodePathsReturn) <- typeConstraintsForIfStatement m mass ret ifst
388+ return $ (cs, allCodePathsReturn, mass)
395389typeConstraintsForStatement m mass ret (For (init, cond, cont) inner) = do
396390 (cs1, b1, mass1) <- typeConstraintsForStatement m mass ret init
397391 guardWith "Cannot return from inside for" $ not b1
@@ -404,6 +398,25 @@ typeConstraintsForStatement m mass ret (Return val) = do
404398 (cs1, n1) <- typeConstraints (m `M.union` mass) val
405399 return ((TypeConstraint n1 (TUnknown ret)) : cs1, True, mass)
406400
401+typeConstraintsForIfStatement :: M.Map Ident Int -> M.Map Ident Int -> Int -> IfStatement -> Check ([TypeConstraint], Bool)
402+typeConstraintsForIfStatement m mass ret (IfStatement val thens Nothing) = do
403+ (cs1, n1) <- typeConstraints m val
404+ (cs2, allCodePathsReturn, _) <- typeConstraintsForBlock m mass ret thens
405+ return ((TypeConstraint n1 Boolean) : cs1 ++ cs2, allCodePathsReturn)
406+typeConstraintsForIfStatement m mass ret (IfStatement val thens (Just elses)) = do
407+ (cs1, n1) <- typeConstraints m val
408+ (cs2, allCodePathsReturn1, _) <- typeConstraintsForBlock m mass ret thens
409+ (cs3, allCodePathsReturn2) <- typeConstraintsForElseStatement m mass ret elses
410+ return ((TypeConstraint n1 Boolean) : cs1 ++ cs2 ++ cs3, allCodePathsReturn1 && allCodePathsReturn2)
411+
412+typeConstraintsForElseStatement :: M.Map Ident Int -> M.Map Ident Int -> Int -> ElseStatement -> Check ([TypeConstraint], Bool)
413+typeConstraintsForElseStatement m mass ret (Else elses) = do
414+ (cs, allCodePathsReturn, _) <- typeConstraintsForBlock m mass ret elses
415+ return (cs, allCodePathsReturn)
416+typeConstraintsForElseStatement m mass ret (ElseIf ifst) = do
417+ (cs, allCodePathsReturn) <- typeConstraintsForIfStatement m mass ret ifst
418+ return (cs, allCodePathsReturn)
419+
407420typeConstraintsForAssignmentTarget :: M.Map Ident Int -> M.Map Ident Int -> Int -> AssignmentTarget -> Check [TypeConstraint]
408421typeConstraintsForAssignmentTarget m mass nval (AssignVariable var) =
409422 case M.lookup var mass of
src/PureScript/Values.hs+9−3
@@ -49,7 +49,7 @@ data BinaryOperator
4949 | Concat deriving (Show, Eq, Data, Typeable)
5050
5151data Value
52− = NumericLiteral String
52+ = NumericLiteral (Either Integer Double)
5353 | StringLiteral String
5454 | BooleanLiteral Bool
5555 | Unary UnaryOperator Value
@@ -71,13 +71,19 @@ data Statement
7171 | Assignment AssignmentTarget Value
7272 | While Value [Statement]
7373 | For (Statement, Value, Statement) [Statement]
74− | IfThenElse (Value) [Statement] (Maybe [Statement])
74+ | If IfStatement
7575 | Return Value deriving (Show, Data, Typeable)
7676
77+data IfStatement = IfStatement Value [Statement] (Maybe ElseStatement) deriving (Show, Data, Typeable)
78+
79+data ElseStatement
80+ = Else [Statement]
81+ | ElseIf IfStatement deriving (Show, Data, Typeable)
82+
7783data Binder
7884 = BooleanBinder Bool
7985 | StringBinder String
80− | NumberBinder String
86+ | NumberBinder (Either Integer Double)
8187 | VarBinder Ident
8288 | NullaryBinder String
8389 | UnaryBinder String Binder