git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Whitespace sensitive syntax using indents package
d6ab2e7Phil Freeman
PureScript.cabal+2−1
compare with golang
unifiedsplit
@@ -32,7 +32,8 @@ library
32
32
33executable psc
33executable psc
34 build-depends: base -any, cmdtheline -any, containers -any,
34 build-depends: base -any, cmdtheline -any, containers -any,
35− mtl -any, parsec -any, utf8-string -any, indents -any
35+ mtl -any, parsec -any, utf8-string -any,
36+ indents -any
36 main-is: Main.hs
37 main-is: Main.hs
37 buildable: True
38 buildable: True
38 hs-source-dirs: src
39 hs-source-dirs: src
src/PureScript/CodeGen/JS.hs+2−2
@@ -48,7 +48,7 @@ declToJs _ = Nothing
48literals :: Pattern Value String
48literals :: Pattern Value String
49literals = Pattern $ A.Kleisli match
49literals = Pattern $ A.Kleisli match
50 where
50 where
51− match (NumericLiteral n) = Just $ either show show n
51+ match (NumericLiteral n) = Just n
52 match (StringLiteral s) = Just $ show s
52 match (StringLiteral s) = Just $ show s
53 match (BooleanLiteral True) = Just "true"
53 match (BooleanLiteral True) = Just "true"
54 match (BooleanLiteral False) = Just "false"
54 match (BooleanLiteral False) = Just "false"
@@ -177,7 +177,7 @@ binderToJs :: String -> String -> Binder -> Gen String
177binderToJs varName done (StringBinder str) =
177binderToJs varName done (StringBinder str) =
178 return $ "if (" ++ varName ++ " === \"" ++ str ++ "\") {" ++ done ++ " }"
178 return $ "if (" ++ varName ++ " === \"" ++ str ++ "\") {" ++ done ++ " }"
179binderToJs varName done (NumberBinder num) =
179binderToJs varName done (NumberBinder num) =
180− return $ "if (" ++ varName ++ " === \"" ++ either show show num ++ "\") {" ++ done ++ " }"
180+ return $ "if (" ++ varName ++ " === \"" ++ num ++ "\") {" ++ done ++ " }"
181binderToJs varName done (BooleanBinder True) =
181binderToJs varName done (BooleanBinder True) =
182 return $ "if (" ++ varName ++ ") {" ++ done ++ " }"
182 return $ "if (" ++ varName ++ ") {" ++ done ++ " }"
183binderToJs varName done (BooleanBinder False) =
183binderToJs varName done (BooleanBinder False) =
src/PureScript/Parser/Common.hs+126−62
@@ -15,84 +15,148 @@
15module PureScript.Parser.Common where
15module PureScript.Parser.Common where
16
16
17import Control.Applicative
17import Control.Applicative
18+import Control.Monad
18import qualified Text.Parsec as P
19import qualified Text.Parsec as P
19import qualified Text.Parsec.Indent as I
20import qualified Text.Parsec.Indent as I
20−import qualified Text.Parsec.Token as PT
21−import qualified Text.Parsec.Language as PL
22
21
23import PureScript.Names
22import PureScript.Names
24
23
25−langDef = PT.LanguageDef
24+reservedNames :: [String]
26− { PT.reservedNames = [ "case"
25+reservedNames = [ "case"
27− , "data"
26+ , "data"
28− , "type"
27+ , "type"
29− , "var"
28+ , "var"
30− , "while"
29+ , "while"
31− , "for"
30+ , "for"
32− , "if"
31+ , "if"
33− , "then"
32+ , "then"
34− , "else"
33+ , "else"
35− , "return"
34+ , "return"
36− , "true"
35+ , "true"
37− , "false"
36+ , "false"
38− , "extern"
37+ , "extern"
39− , "forall" ]
38+ , "forall" ]
39+
40+reservedOpNames :: [String]
40− , PT.reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
41+reservedOpNames = [ "!", "~", "-", "<=", ">=", "<", ">", "*", "/", "%", "++", "+", "<<", ">>>", ">>"
41− , "==", "!=", "&", "^", "|", "&&", "||" ]
42+ , "==", "!=", "&", "^", "|", "&&", "||" ]
42− , PT.commentStart = "{-"
43+
43− , PT.commentEnd = "-}"
44+identStart :: I.IndentParser String u Char
44− , PT.commentLine = "--"
45− , PT.nestedComments = True
46− , PT.identStart = P.lower <|> P.oneOf "_$"
45+identStart = P.lower <|> P.oneOf "_$"
46+
47+properNameStart :: I.IndentParser String u Char
48+properNameStart = P.upper
49+
50+identLetter :: I.IndentParser String u Char
47− , PT.identLetter = P.alphaNum <|> P.oneOf "_'"
51+identLetter = P.alphaNum <|> P.oneOf "_'"
48− , PT.opStart = P.oneOf ":#?@\\"
52+
53+opStart :: I.IndentParser String u Char
49− , PT.opLetter = P.oneOf ":!#$%&*+./<=>?@\\^|-~"
54+opStart = P.oneOf ":!#$%&*+/<=>?@^|-~"
50− , PT.caseSensitive = True
55+
51− }
56+opLetter :: I.IndentParser String u Char
52−
57+opLetter = P.oneOf ":#$%&*+./<=>?@^|"
53−tokenParser = PT.makeTokenParser langDef
58+
54−
59+whiteSpace :: I.IndentParser String u ()
60+whiteSpace = P.skipMany $ P.choice
61+ [ P.oneOf " \t" >> return ()
55−whiteSpace = P.skipMany $ (P.oneOf " \t" >> return ()) <|> P.try (P.skipMany1 (P.oneOf "\r\n")) >> I.indented <|> P.try lineComment <|> P.try blockComment
62+ , P.try $ P.skipMany1 (P.oneOf "\r\n") >> P.skipMany1 (P.oneOf " \t") >> I.indented
56−
63+ , P.try lineComment
64+ , P.try blockComment ]
65+
66+lineComment :: I.IndentParser String u ()
57lineComment = do
67lineComment = do
58− P.string $ PT.commentLine langDef
68+ P.string "--"
59 P.skipMany $ P.satisfy (/= '\n')
69 P.skipMany $ P.satisfy (/= '\n')
60− I.indented
70+ return ()
61
71
72+blockComment :: I.IndentParser String u ()
62blockComment = do
73blockComment = do
63− P.string $ PT.commentStart langDef
74+ P.string "{--"
64− P.manyTill P.anyChar $ P.try $ P.string $ PT.commentEnd langDef
75+ P.manyTill P.anyChar $ P.try $ P.string "--}"
65 return ()
76 return ()
66
77
78+lexeme :: I.IndentParser String u a -> I.IndentParser String u a
67−lexeme p = p <* whiteSpace
79+lexeme p = p <* whiteSpace
68−identifier = lexeme $ PT.identifier tokenParser
80+
69−reserved s = lexeme $ PT.reserved tokenParser s
81+identifier :: I.IndentParser String u String
70−operator = lexeme $ PT.operator tokenParser
82+identifier = lexeme $ do
71−stringLiteral = lexeme $ PT.stringLiteral tokenParser
83+ name <- (:) <$> identStart <*> P.many identLetter
72−natural = lexeme $ PT.natural tokenParser
84+ when (name `elem` reservedNames) $ P.unexpected ("reserved word " ++ show name)
73−naturalOrFloat = lexeme $ PT.naturalOrFloat tokenParser
85+ return name
74
86
75−semi = lexeme $ PT.semi tokenParser
87+properName :: I.IndentParser String u String
76−comma = lexeme $ PT.comma tokenParser
88+properName = lexeme $ do
77−colon = lexeme $ PT.colon tokenParser
89+ (:) <$> properNameStart <*> many identLetter P.<?> "name"
78−dot = lexeme $ PT.dot tokenParser
79
90
80−semiSep p = P.sepBy p semi
91+reserved :: String -> I.IndentParser String u String
81−semiSep1 p = P.sepBy1 p semi
92+reserved name = lexeme $ P.string name <* P.notFollowedBy identLetter
82−commaSep p = P.sepBy p comma
83−commaSep1 p = P.sepBy1 p comma
84
93
85−parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
94+reservedOp :: String -> I.IndentParser String u String
86−braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
95+reservedOp name = lexeme $ P.string name <* P.notFollowedBy opLetter
87−angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
88−squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
89
96
90−tick = lexeme (P.char '`')
97+operator :: I.IndentParser String u String
98+operator = lexeme $ do
99+ name <- (:) <$> opStart <*> P.many opLetter
100+ when (name `elem` reservedOpNames) $ P.unexpected ("reserved operator " ++ show name)
101+ return name
91
102
92−properName :: I.IndentParser String u String
103+stringLiteral :: I.IndentParser String u String
93−properName = lexeme $ P.try properName'
104+stringLiteral = lexeme $ P.between (P.char '"') (P.char '"') (P.many (P.noneOf "\""))
94− where
105+
95− properName' = (:) <$> P.upper <*> many (PT.identLetter langDef) P.<?> "name"
106+number :: I.IndentParser String u String
107+number = do
108+ intPart <- P.many1 P.digit
109+ fracPart <- P.option "" $ (:) <$> P.char '.' <*> P.many1 P.digit
110+ expPart <- P.option "" $ (:) <$> P.oneOf "eE" <*> P.many1 P.digit
111+ return $ intPart ++ fracPart ++ expPart
112+
113+signedNumber :: I.IndentParser String u String
114+signedNumber = do
115+ s <- P.optionMaybe $ P.oneOf "-+"
116+ n <- number
117+ return $ maybe id (:) s n
118+
119+unsignedNumber :: I.IndentParser String u String
120+unsignedNumber = lexeme number
121+
122+semi :: I.IndentParser String u Char
123+semi = lexeme $ P.char ';'
124+
125+comma :: I.IndentParser String u Char
126+comma = lexeme $ P.char ','
127+
128+colon :: I.IndentParser String u Char
129+colon = lexeme $ P.char ':'
130+
131+dot :: I.IndentParser String u Char
132+dot = lexeme $ P.char '.'
133+
134+tick :: I.IndentParser String u Char
135+tick = lexeme $ P.char '`'
136+
137+semiSep :: I.IndentParser String u a -> I.IndentParser String u [a]
138+semiSep p = P.sepBy p semi
139+
140+semiSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
141+semiSep1 p = P.sepBy1 p semi
142+
143+commaSep :: I.IndentParser String u a -> I.IndentParser String u [a]
144+commaSep p = P.sepBy p comma
145+
146+commaSep1 :: I.IndentParser String u a -> I.IndentParser String u [a]
147+commaSep1 p = P.sepBy1 p comma
148+
149+parens :: I.IndentParser String u a -> I.IndentParser String u a
150+parens p = lexeme (P.char '(') *> lexeme p <* lexeme (P.char ')')
151+
152+braces :: I.IndentParser String u a -> I.IndentParser String u a
153+braces p = lexeme (P.char '{') *> lexeme p <* lexeme (P.char '}')
154+
155+angles :: I.IndentParser String u a -> I.IndentParser String u a
156+angles p = lexeme (P.char '<') *> lexeme p <* lexeme (P.char '>')
157+
158+squares :: I.IndentParser String u a -> I.IndentParser String u a
159+squares p = lexeme (P.char '[') *> lexeme p <* lexeme (P.char ']')
96
160
97augment :: 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
161augment :: 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
98augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
162augment p q f = (flip $ maybe id $ flip f) <$> p <*> P.optionMaybe q
src/PureScript/Parser/Declarations.hs+2−2
@@ -65,8 +65,8 @@ parseDeclaration = P.choice $ map P.try
65 , parseExternDeclaration ]
65 , parseExternDeclaration ]
66
66
67parseManyDeclarations :: I.IndentParser String () [Declaration]
67parseManyDeclarations :: I.IndentParser String () [Declaration]
68−parseManyDeclarations = I.block $ I.withPos parseDeclaration
68+parseManyDeclarations = I.block $ I.withPos (parseDeclaration <* P.skipMany (P.oneOf "\r\n"))
69
69
70parseDeclarations :: String -> Either P.ParseError [Declaration]
70parseDeclarations :: String -> Either P.ParseError [Declaration]
71−parseDeclarations = flip evalState (P.initialPos "Declarations") . P.runPT parseManyDeclarations () "Declarations"
71+parseDeclarations = flip evalState (P.initialPos "Declarations") . P.runPT (parseManyDeclarations <* P.eof) () "Declarations"
72
72
src/PureScript/Parser/Values.hs+26−26
@@ -32,7 +32,7 @@ booleanLiteral :: I.IndentParser String () Bool
32booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
32booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
33
33
34parseNumericLiteral :: I.IndentParser String () Value
34parseNumericLiteral :: I.IndentParser String () Value
35−parseNumericLiteral = NumericLiteral <$> C.naturalOrFloat
35+parseNumericLiteral = NumericLiteral <$> C.signedNumber
36
36
37parseStringLiteral :: I.IndentParser String () Value
37parseStringLiteral :: I.IndentParser String () Value
38parseStringLiteral = StringLiteral <$> C.stringLiteral
38parseStringLiteral = StringLiteral <$> C.stringLiteral
@@ -103,30 +103,30 @@ parseValue = buildExpressionParser operators $ C.fold (C.lexeme typedValue) (C.l
103 parseTypeAnnotation = C.lexeme (P.string "::") *> parsePolyType
103 parseTypeAnnotation = C.lexeme (P.string "::") *> parsePolyType
104 operators = [ [ Postfix $ Accessor <$> (C.dot *> C.identifier)
104 operators = [ [ Postfix $ Accessor <$> (C.dot *> C.identifier)
105 , Postfix $ Indexer <$> C.squares parseValue ]
105 , Postfix $ Indexer <$> C.squares parseValue ]
106− , [ Prefix $ C.lexeme (P.char '!') >> return (Unary Not)
106+ , [ Prefix $ C.lexeme (P.try $ C.reservedOp "!") >> return (Unary Not)
107− , Prefix $ C.lexeme (P.char '~') >> return (Unary BitwiseNot)
107+ , Prefix $ C.lexeme (P.try $ C.reservedOp "~") >> return (Unary BitwiseNot)
108− , Prefix $ C.lexeme (P.char '-') >> return (Unary Negate) ]
108+ , Prefix $ C.lexeme (P.try $ C.reservedOp "-") >> return (Unary Negate) ]
109− , [ Infix (C.lexeme (C.parseIdentInfix >>= \ident -> return $ \t1 t2 -> App (App (Var ident) [t1]) [t2])) AssocRight ]
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 (P.string "<=")) >> return (Binary LessThanOrEqualTo)) AssocRight
110+ , [ Infix (C.lexeme (P.try $ C.reservedOp "<=") >> return (Binary LessThanOrEqualTo)) AssocRight
111− , Infix (C.lexeme (P.try (P.string ">=")) >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
111+ , Infix (C.lexeme (P.try $ C.reservedOp ">=") >> return (Binary GreaterThanOrEqualTo)) AssocRight ]
112− , [ Infix (C.lexeme (P.try (P.char '<' <* P.notFollowedBy (P.char '<'))) >> return (Binary LessThan)) AssocRight
112+ , [ Infix (C.lexeme (P.try $ C.reservedOp "<") >> return (Binary LessThan)) AssocRight
113− , Infix (C.lexeme (P.try (P.char '>' <* P.notFollowedBy (P.char '>'))) >> return (Binary GreaterThan)) AssocRight ]
113+ , Infix (C.lexeme (P.try $ C.reservedOp ">") >> return (Binary GreaterThan)) AssocRight ]
114− , [ Infix (C.lexeme (P.char '*') >> return (Binary Multiply)) AssocRight
114+ , [ Infix (C.lexeme (P.try $ C.reservedOp "*") >> return (Binary Multiply)) AssocRight
115− , Infix (C.lexeme (P.char '/') >> return (Binary Divide)) AssocRight
115+ , Infix (C.lexeme (P.try $ C.reservedOp "/") >> return (Binary Divide)) AssocRight
116− , Infix (C.lexeme (P.char '%') >> return (Binary Modulus)) AssocRight ]
116+ , Infix (C.lexeme (P.try $ C.reservedOp "%") >> return (Binary Modulus)) AssocRight ]
117− , [ Infix (C.lexeme (P.try (P.string "++")) >> return (Binary Concat)) AssocRight
117+ , [ Infix (C.lexeme (P.try $ C.reservedOp "++") >> return (Binary Concat)) AssocRight
118− , Infix (C.lexeme (P.char '+') >> return (Binary Add)) AssocRight
118+ , Infix (C.lexeme (P.try $ C.reservedOp "+") >> return (Binary Add)) AssocRight
119− , Infix (C.lexeme (P.char '-') >> return (Binary Subtract)) AssocRight ]
119+ , Infix (C.lexeme (P.try $ C.reservedOp "-") >> return (Binary Subtract)) AssocRight ]
120− , [ Infix (C.lexeme (P.string "<<") >> return (Binary ShiftLeft)) AssocRight
120+ , [ Infix (C.lexeme (P.try $ C.reservedOp "<<") >> return (Binary ShiftLeft)) AssocRight
121− , Infix (C.lexeme (P.try (P.string ">>>")) >> return (Binary ZeroFillShiftRight)) AssocRight
121+ , Infix (C.lexeme (P.try $ C.reservedOp ">>>") >> return (Binary ZeroFillShiftRight)) AssocRight
122− , Infix (C.lexeme (P.string ">>") >> return (Binary ShiftRight)) AssocRight ]
122+ , Infix (C.lexeme (P.try $ C.reservedOp ">>") >> return (Binary ShiftRight)) AssocRight ]
123− , [ Infix (C.lexeme (P.string "==") >> return (Binary EqualTo)) AssocRight
123+ , [ Infix (C.lexeme (P.try $ C.reservedOp "==") >> return (Binary EqualTo)) AssocRight
124− , Infix (C.lexeme (P.try (P.string "!=")) >> return (Binary NotEqualTo)) AssocRight ]
124+ , Infix (C.lexeme (P.try $ C.reservedOp "!=") >> return (Binary NotEqualTo)) AssocRight ]
125− , [ Infix (C.lexeme (P.try (P.char '&' <* P.notFollowedBy (P.char '&'))) >> return (Binary BitwiseAnd)) AssocRight ]
125+ , [ Infix (C.lexeme (P.try $ C.reservedOp "&") >> return (Binary BitwiseAnd)) AssocRight ]
126− , [ Infix (C.lexeme (P.char '^') >> return (Binary BitwiseXor)) AssocRight ]
126+ , [ Infix (C.lexeme (P.try $ C.reservedOp "^") >> return (Binary BitwiseXor)) AssocRight ]
127− , [ Infix (C.lexeme (P.try (P.char '|' <* P.notFollowedBy (P.char '|'))) >> return (Binary BitwiseOr)) AssocRight ]
127+ , [ Infix (C.lexeme (P.try $ C.reservedOp "|") >> return (Binary BitwiseOr)) AssocRight ]
128− , [ Infix (C.lexeme (P.string "&&") >> return (Binary And)) AssocRight ]
128+ , [ Infix (C.lexeme (P.try $ C.reservedOp "&&") >> return (Binary And)) AssocRight ]
129− , [ Infix (C.lexeme (P.string "||") >> return (Binary Or)) AssocRight ]
129+ , [ Infix (C.lexeme (P.try $ C.reservedOp "||") >> return (Binary Or)) AssocRight ]
130 ]
130 ]
131
131
132parseVariableIntroduction :: Bool -> I.IndentParser String () Statement
132parseVariableIntroduction :: Bool -> I.IndentParser String () Statement
@@ -186,7 +186,7 @@ parseBooleanBinder :: I.IndentParser String () Binder
186parseBooleanBinder = BooleanBinder <$> booleanLiteral
186parseBooleanBinder = BooleanBinder <$> booleanLiteral
187
187
188parseNumberBinder :: I.IndentParser String () Binder
188parseNumberBinder :: I.IndentParser String () Binder
189−parseNumberBinder = NumberBinder <$> C.naturalOrFloat
189+parseNumberBinder = NumberBinder <$> C.signedNumber
190
190
191parseVarBinder :: I.IndentParser String () Binder
191parseVarBinder :: I.IndentParser String () Binder
192parseVarBinder = VarBinder <$> C.parseIdent
192parseVarBinder = VarBinder <$> C.parseIdent
src/PureScript/Values.hs+2−2
@@ -49,7 +49,7 @@ data BinaryOperator
49 | Concat deriving (Show, Eq, Data, Typeable)
49 | Concat deriving (Show, Eq, Data, Typeable)
50
50
51data Value
51data Value
52− = NumericLiteral (Either Integer Double)
52+ = NumericLiteral String
53 | StringLiteral String
53 | StringLiteral String
54 | BooleanLiteral Bool
54 | BooleanLiteral Bool
55 | Unary UnaryOperator Value
55 | Unary UnaryOperator Value
@@ -77,7 +77,7 @@ data Statement
77data Binder
77data Binder
78 = BooleanBinder Bool
78 = BooleanBinder Bool
79 | StringBinder String
79 | StringBinder String
80− | NumberBinder (Either Integer Double)
80+ | NumberBinder String
81 | VarBinder Ident
81 | VarBinder Ident
82 | NullaryBinder String
82 | NullaryBinder String
83 | UnaryBinder String Binder
83 | UnaryBinder String Binder