343dcf2 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Add support for unary negation with the '-' symbol. Makes the use of

343dcf2Evan Czaplicki13 years ago

compiler/Parse/Expression.hs+15−5

compare with master

unifiedsplit

@@ -39,6 +39,14 @@ accessor = do

39 let loc e = Location.add ("." ++ lbl) (Location.at start end e)

40 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))

42+negative :: IParser (Expr t v)

43+negative = do

44+ start <- getPosition

45+ nTerm <- try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term

46+ end <- getPosition

47+ let loc e = Location.at start end e

48+ return (Binop "-" (loc $ Literal (Literal.IntNum 0)) nTerm)

49+

43-------- Complex Terms --------

51-------- Complex Terms --------

@@ -113,7 +121,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

113

121

114

122

115term :: IParser (LExpr t v)

123term :: IParser (LExpr t v)

116−term = addLocation (choice [ Literal <$> literal, listTerm, accessor ])

124+term = addLocation (choice [ Literal <$> literal, listTerm, accessor, negative ])

117 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

125 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

118 <?> "basic term (4, x, 'c', etc.)"

126 <?> "basic term (4, x, 'c', etc.)"

119

127

@@ -121,10 +129,12 @@ term = addLocation (choice [ Literal <$> literal, listTerm, accessor ])

121

129

122appExpr :: IParser (LExpr t v)

130appExpr :: IParser (LExpr t v)

123appExpr = do

131appExpr = do

124− tlist <- spaceSep1 term

132+ t <- term

133+ ts <- constrainedSpacePrefix term $ \str ->

134+ if null str then notFollowedBy (char '-') else return ()

125− return $ case tlist of

135+ return $ case ts of

126− t:[] -> t

136+ [] -> t

127− t:ts -> foldl' (\f x -> Location.merge f x $ App f x) t ts

137+ _ -> foldl' (\f x -> Location.merge f x $ App f x) t ts

128

138

129-------- Normal Expressions --------

139-------- Normal Expressions --------

130

140

compiler/Parse/Helpers.hs+26−14

@@ -103,7 +103,14 @@ dotSep1 p = (:) <$> p <*> many (try (char '.') >> p)

103spaceSep1 :: IParser a -> IParser [a]

104spaceSep1 p = (:) <$> p <*> spacePrefix p

105

106+spacePrefix p = constrainedSpacePrefix p (\_ -> return ())

107+

108+constrainedSpacePrefix p constraint =

109+ many . try $ do

106−spacePrefix p = many (try (whitespace >> indented >> p))

110+ n <- whitespace

111+ constraint n

112+ indented

113+ p

107

114

108followedBy a b = do x <- a ; b ; return x

115followedBy a b = do x <- a ; b ; return x

109

116

@@ -150,38 +157,43 @@ accessible expr = do

150

157

151

158

152spaces :: IParser String

159spaces :: IParser String

153−spaces = many1 ((multiComment <|> string " " <?> "") >> return ' ') <?> "spaces"

160+spaces = concat <$> many1 (multiComment <|> string " ") <?> "spaces"

154

161

155−forcedWS :: IParser [String]

162+forcedWS :: IParser String

156−forcedWS = try (do { spaces; many nl_space }) <|> try (many1 nl_space)

163+forcedWS = choice [ try $ (++) <$> spaces <*> (concat <$> many nl_space)

164+ , try $ concat <$> many1 nl_space ]

157− where nl_space = try $ many1 newline >> spaces

165+ where nl_space = try ((++) <$> (concat <$> many1 newline) <*> spaces)

158

166

159-- Just eats whitespace until the next meaningful character.

167-- Just eats whitespace until the next meaningful character.

160−dumbWhitespace :: IParser ()

168+dumbWhitespace :: IParser String

161−dumbWhitespace = many (spaces <|> newline) >> return ()

169+dumbWhitespace = concat <$> many (spaces <|> newline)

162

170

163−whitespace :: IParser ()

171+whitespace :: IParser String

164−whitespace = optional forcedWS <?> ""

172+whitespace = option "" forcedWS <?> "whitespace"

165

173

166freshLine :: IParser [[String]]

174freshLine :: IParser [[String]]

167freshLine = try (many1 newline >> many space_nl) <|> try (many1 space_nl) <?> ""

175freshLine = try (many1 newline >> many space_nl) <|> try (many1 space_nl) <?> ""

168 where space_nl = try $ spaces >> many1 newline

176 where space_nl = try $ spaces >> many1 newline

169

177

170newline :: IParser String

178newline :: IParser String

171−newline = simpleNewline <|> lineComment <?> ""

179+newline = simpleNewline <|> lineComment <?> "newline"

172

180

173simpleNewline :: IParser String

181simpleNewline :: IParser String

174simpleNewline = try (string "\r\n") <|> string "\n"

182simpleNewline = try (string "\r\n") <|> string "\n"

175

183

176lineComment :: IParser String

184lineComment :: IParser String

177−lineComment = do try (string "--")

185+lineComment = do

186+ try (string "--")

178− manyTill anyChar $ simpleNewline <|> (eof >> return "\n")

187+ comment <- manyTill anyChar $ simpleNewline <|> (eof >> return "\n")

188+ return ("--" ++ comment)

179

189

180multiComment :: IParser String

190multiComment :: IParser String

181multiComment = do { try (string "{-"); closeComment }

191multiComment = do { try (string "{-"); closeComment }

182

192

183closeComment :: IParser String

193closeComment :: IParser String

194+closeComment = do

184−closeComment = manyTill anyChar . choice $

195+ comment <- manyTill anyChar . choice $

185 [ try (string "-}") <?> "close comment"

196 [ try (string "-}") <?> "close comment"

186 , do { try $ string "{-"; closeComment; closeComment }

197 , do { try $ string "{-"; closeComment; closeComment }

187− ]

198+ ]

199+ return ("{-" ++ comment ++ "-}")

compiler/Parse/Parser.hs+1−1

@@ -46,7 +46,7 @@ parseDependencies =

47parseInfix :: String -> Either String OpTable

48parseInfix = setupParser . many $ do

49− manyTill (whitespace <|> (anyChar >> return ())) freshLine

49+ manyTill ((whitespace >> return ' ') <|> anyChar) freshLine

50 infixStmt

52setupParser p source =